MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - Code Archiv
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 15.01.2010, 13:42   #1
ios707
MOF Profi
MOF Profi
Standard Codebeispiel - Export nach Excel von Formular mit CopyFromRecordset-Methode

Hallo zusammen,

so was habe ich hier vor ein paar Tagen mal gesucht, es aber nie wirklich ausführlich beschrieben gesehen. Also dachte ich mir, stelle ich es ein ... nach so etwas ähnlichem haben schon viele Leute hier gefragt.

Der Code ist für einen Button gedacht, der auf einem Hauptformular liegt. Das Hauptformular enthält ein Unterformular, in dem die Daten angezeigt werden. Der Code muss nur an einer Stelle angepasst werden, nämlich der Name des Steuerelements, das das Unterformular enthält.

Ich hoffe es hilft dem einen oder anderen ...

Code:

Private Sub cmdXLSExport_Click()
' Export aller Daten des Unterformulars nach Excel mit CopyFromRecordset-Methode
Dim iCols As Integer
Dim rs As Recordset
Dim ws As Object
Dim wb As Object
Dim ExcelApp As Object

    ' Neue Excel Datei, Arbeitsmappe und Worksheet erstellen
    Set ExcelApp = CreateObject("Excel.Application")
    Set wb = ExcelApp.Workbooks.Add
    Set ws = ExcelApp.Worksheets.Add
    ' Recordset des Unterformulars kopieren,
    ' hier muss der Name des Steuerelements, das das Unterformular enthält, angepasst werden
    '---------------
    Set rs = Me!NameSteuerelement.Form.RecordsetClone
    '---------------
    ' Nur was machen, wenn Daten vorhanden sind
    If Not rs.EOF Then
    	rs.MoveFirst
        ' Daten nach Excel kopieren
        For iCols = 0 To rs.Fields.Count - 1
            ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
        Next
        ws.Range(ws.Cells(1, 1), _
            ws.Cells(1, rs.Fields.Count)).Font.Bold = True
        ws.Range("A2").CopyFromRecordset rs
    End If
    ' Excel sichtbar machen
    ExcelApp.Visible = True
    
    ' Alles resetten
    Set ws = Nothing
    Set wb = Nothing
    Set ExcelApp = Nothing
End Sub

__________________

--Dave
(Office365|Win10)
ios707 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.01.2010, 18:47   #2
ios707
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Ich hatte wohl nicht gründlich genug gesucht, Josef hat nämlich auch schon mal was ähnliches geschrieben, nur noch besser

http://www.ms-office-forum.net/forum...2&postcount=14

__________________

--Dave
(Office365|Win10)
ios707 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.02.2010, 12:06   #3
ios707
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Hier ein kleines Update. Die Spaltenbreite in Excel wird jetzt auch noch automatisch angepasst und die Handhabung ist viel leichter nach Anlehnung an die Ideen von Josef.

Der Code kommt nun bspw. in ein Modul:

Code:

Public Sub XLSExportRS(rs As Recordset)
' Export aller Daten des Unterformulars nach Excel mit CopyFromRecordset-Methode
' David Niegisch, 10.02.2010
Dim iCols As Integer
Dim ws As Object
Dim wb As Object
Dim ExcelApp As Object
    ' Neue Excel Datei, Arbeitsmappe und Worksheet erstellen
    Set ExcelApp = CreateObject("Excel.Application")
    Set wb = ExcelApp.Workbooks.Add
    Set ws = ExcelApp.Worksheets.Add
    ' Nur ausführen wenn Daten vorhanden sind
    If Not rs.EOF Then
        rs.MoveFirst
        ' Daten nach Excel kopieren
        For iCols = 0 To rs.Fields.Count - 1
            ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
        Next
        ws.Range(ws.Cells(1, 1), _
            ws.Cells(1, rs.Fields.Count)).Font.Bold = True
        ws.Range("A2").CopyFromRecordset rs
    End If
    ws.Columns.AutoFit
    ' Excel sichtbar machen und alles resetten
    ExcelApp.Visible = True
    Set ws = Nothing
    Set wb = Nothing
    Set ExcelApp = Nothing
End Sub
Und der Aufruf erfolgt mit:

Code:

XLSExportRS Me!Unterformular.Form.RecordsetClone

__________________

--Dave
(Office365|Win10)
ios707 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 25.02.2010, 09:04   #4
ios707
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Noch ein Update:

- Bugfix: der Code konnte bislang nicht mehrmals hintereinander ausgeführt werden, weil nach der ersten Ausführung der DS-Marker des Recordsets am Ende steht. Ein MoveFirst an der richtigen Stelle schafft Abhilfe.
- Ergänzung: Meldung, wenn keine Daten für den Export vorliegen und in diesem Fall auch kein unnötiges Anlegen von Excel-Instanzen.

Der Code kommt nach wie vor in ein Modul:
Code:

Public Sub XLSExportRS(rs As Recordset)
' Export aller Daten des Unterformulars nach Excel mit CopyFromRecordset-Methode
' David Niegisch, 25.02.2010
Dim gsMsgAntw As Integer
Dim iCols As Integer
Dim ws As Object ' falls Verweise auf die Excel-Bibl. gesetzt sind, kann man sich late binding sparen, Excel.Worksheet
Dim wb As Object ' falls Verweise auf die Excel-Bibl. gesetzt sind, kann man sich late binding sparen, Excel.Workbook
Dim ExcelApp As Object ' falls Verweise auf die Excel-Bibl. gesetzt sind, kann man sich late binding sparen, Excel.Application

    ' MoveFirst sorgt dafür, dass die gleichen Daten auch mehrmals hintereinander exportiert werden können
    rs.MoveFirst
    
    ' Nur ausführen wenn Daten vorhanden sind
    If rs.EOF Then
        gsMsgAntw = MsgBox("Es sind keine Ergebnisse für einen Export vorhanden!", vbInformation, "Export nicht moeglich")
    Else
        ' Neue Excel Datei, Arbeitsmappe und Worksheet erstellen
        Set ExcelApp = CreateObject("Excel.Application")
        Set wb = ExcelApp.Workbooks.Add
        Set ws = ExcelApp.Worksheets.Add
        ' Daten nach Excel kopieren
        ' Feld- bzw. Spaltennamen
        For iCols = 0 To rs.Fields.Count - 1
            ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
        Next
        ' Daten
        ws.Range(ws.Cells(1, 1), _
            ws.Cells(1, rs.Fields.Count)).Font.Bold = True
        ws.Range("A2").CopyFromRecordset rs
        ' Spaltenbreite anpassen
        ws.Columns.AutoFit
        ' Excel sichtbar machen und alles resetten
        ExcelApp.Visible = True
        Set ws = Nothing
        Set wb = Nothing
        Set ExcelApp = Nothing
    End If
    
End Sub
Wenn der Code von einem Hauptformular aus die Daten eines Unterformulars exportieren soll, dann erfolgt der Aufruf mit:
Code:

XLSExportRS Me!Unterformular.Form.RecordsetClone
"Unterformular" ist dabei der Name des Steuerelements auf dem Hauptformular, in dem das Unterformular steckt.

__________________

--Dave
(Office365|Win10)
ios707 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.03.2010, 12:09   #5
swati
MOF User
MOF User
Standard

sehr schöner Code!

und funktioniert prima
swati ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 30.03.2010, 15:59   #6
cpac
MOF User
MOF User
Hinweis CopyFromRecordset und Memo-Felder

Falls sich ein Feld vom Datentyp Memo im Recordset befindet, kommt es bei Verwendung von CopyFromRecordset zu einem Fehler, wenn sich mehr als 910 Zeichen in dem Memo-Feld befinden. Dies als Information (aus leidvoller Erfahrung...).

In einem solchen Fall ist dann DoCmd.TransferSpreadsheet eine funktionierende Lösung.

__________________

Gruß Carsten

Access 2003-2016 · SQL Server 20xx · Windows XP/Vista/7/8/10 · Excel 2003-2016
cpac ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 31.03.2010, 15:33   #7
ios707
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Danke für den Hinweis Carsten. Habe mal etwas nachgeforscht und eine Lösung für das Problem mit den Memo-Feldern gefunden, die ich selbst noch nicht ausprobiert habe.

Anscheinend ist es kein Problem, das Memo-Feld erst mal an eine Variable zu übergeben und dann den Inhalt der Variablen weiterzuverwenden, bspw. so
Code:

foo = rstcheck![Field Memo]
objsheet2.cells(4,2).value = foo
Quelle: http://www.utteraccess.com/forum/Cop...81#entry648781

Wie gesagt, nicht selber getestet und werde es in naher Zukunft wohl auch nicht machen, da ich das nicht brauche und genug andere Sachen zu tun habe

__________________

--Dave
(Office365|Win10)
ios707 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.07.2013, 12:44   #8
HO2013
MOF User
MOF User
Standard

super code.

vielen dank. funktioniert einwandfrei.
HO2013 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.03.2014, 00:11   #9
JonnyMM
Neuer Benutzer
Neuer Benutzer
Standard Export funktioniert nur einmal !?

Vielen Dank für das tolle Forum, wo man als Anfänger immer wieder Hilfestellung findet. Ich hatte das Problem, dass der Export einer Abfrage mit einem ähnlichen Code wie oben mitgeilt nur einmal funktionierte. Jetzt habe ich auch für das Problem die Lösung gefunden
Beste Grüße, JonnyMM

Geändert von JonnyMM (02.03.2014 um 00:17 Uhr).
JonnyMM ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.10.2014, 12:04   #10
Donnervogel
Neuer Benutzer
Neuer Benutzer
Standard

Moin,

wie funktioniert das jetzt genau? Ich kopiere den Code in ein neues Modul.
Wie kann ich das dann Asuführen? Will da so eine Schaltfläche haben, dass der Export ausgeführt wird, wenn ich draufklicke.
Kann mir da jemand helfen?
Donnervogel ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.04.2015, 09:56   #11
uthterii
Neuer Benutzer
Neuer Benutzer
Standard

Bugfix: der Code konnte bislang nicht mehrmals hintereinander ausgeführt werden, weil nach der ersten Ausführung der DS-Marker des Recordsets am Ende steht. Ein MoveFirst an der richtigen Stelle schafft Abhilfe.????
uthterii ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.05.2015, 14:02   #12
ios707
Threadstarter Threadstarter
MOF Profi
MOF Profi
Standard

Zitat: von uthterii Beitrag anzeigen

Bugfix: der Code konnte bislang nicht mehrmals hintereinander ausgeführt werden, weil nach der ersten Ausführung der DS-Marker des Recordsets am Ende steht. Ein MoveFirst an der richtigen Stelle schafft Abhilfe.????

Einfach den Code vom 25.02.2010 verwenden, das ist das MoveFirst bereits eingebaut (erste Zeile nach der Variablendeklaration)

__________________

--Dave
(Office365|Win10)
ios707 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 08:30 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.