MS-Office-Forum

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

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 23.05.2018, 09:12   #1
MRE59
MOF User
MOF User
Standard Acc2013 - Abfrage über Kombinationsfeld und Export in EXCEL

Hallo,
ich bräuchte Hilfe.
Ich habe ein PopUp-Formular "Abfrage" mit einem Kombinationsfeld "Auswahl".

Mein Ziel ist, wenn ich die "Auswahl" getroffen habe, mit der Schaltfläche "EXCEL Export" auch Excel geöffnet wird und die gefilterten Daten habe.
Code:

Private Sub EXCEL_Export_Click()

End Sub
Wäre echt super, wenn mir jemand den passenden Code erstellen könnte?

Eine Testdatenbank habe ich schon vorbereitet.

Schon mal vielen Dank für Eure Mithilfe.
Angehängte Dateien
Dateityp: zip Test.zip (23,0 KB, 2x aufgerufen)
MRE59 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.05.2018, 14:01   #2
MRE59
Threadstarter Threadstarter
MOF User
MOF User
Standard

Habe selber schon mal etwas gefunden.

Code:

Private Sub EXCEL_Export_Click()
   Dim oExcel As Object
   Dim rs As DAO.Recordset
   Dim ExcelWarGeoeffnet As Boolean
   Dim i As Long

   On Error Resume Next
   Set oExcel = GetObject(, "Excel.Application ")
   If Err.Number <> 0 Then
      Set oExcel = CreateObject("Excel.Application")
   Else
      ExcelWarGeoeffnet = True
   End If
   On Error GoTo 0

   With oExcel
      .Visible = True

       With .Workbooks.Add

         With .ActiveSheet
            .Name = Me.Auswahl
            
        End With
    End With
End With

End Sub
Der erste Schritt funktioniert schon einmal.

Durch Taste klicken wird EXCEL geöffnet und die Mappe umbenannt.

Nur wie bring ich die Daten z.B. Auswahl "Stuttgart" noch da rein?
MRE59 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.05.2018, 14:10   #3
maikek
MOF Guru
MOF Guru
Standard

Moin,
guck dir, je nachdem wo die Daten herkommen, den Befehl TransferSpreadsheet bzw. die Methode CopyFromRecordset an.
maike

__________________

Bitte dein Thema auf erledigt setzen, wenn's durch ist!
MOF Access Stammtisch in Bremen
maikek ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.05.2018, 17:16   #4
MRE59
Threadstarter Threadstarter
MOF User
MOF User
Standard

Bin wieder ein Stück weiter!
Code:

Private Sub EXCEL_Export_Click()
   Dim oExcel As Object
   Dim RS As DAO.Recordset
   Dim ExcelWarGeoeffnet As Boolean
   
   Dim I As Long

   On Error Resume Next
   Set oExcel = GetObject(, "Excel.Application ")
   If Err.Number <> 0 Then
      Set oExcel = CreateObject("Excel.Application")
   Else
      ExcelWarGeoeffnet = True
   End If
   On Error GoTo 0

   With oExcel
      .Visible = True

      With .Workbooks.Add

         With .ActiveSheet
            .Name = Me.Auswahl
    
    Set DB = CurrentDb
    Set RS = DB.OpenRecordset("Abfrage1", dbOpenSnapshot)
      
      For I = 0 To RS.Fields.Count - 1
        .Cells(1, I + 1) = RS.Fields(I).Name
      Next I
      .Range("A2").Select
      .Range("A1").Select
    
        End With
    End With
End With

End Sub
Beim klicken öffnet sich EXCEL und die Feldnamen stehen in der ersten Zeile!

Mir fehlen nur noch die Werte!

Und jetzt brauch ich Hilfe.

Kann sich jemand mal die Test_Version_2.zip anschauen?
Vermutlich ist es nur noch eine Kleinigkeit!
Angehängte Dateien
Dateityp: zip Test_Version_2.zip (82,9 KB, 1x aufgerufen)
MRE59 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.05.2018, 18:09   #5
drambeldier
MOF Koryphäe
MOF Koryphäe
Standard

Moin,

ich baue eine Abfrage Q_Auswahl:
Code:

SELECT *
FROM Kontakt
WHERE Kontakt.Ort=Forms!Abfrage.auswahl
und schreibe ins Ereignis
Code:

Private Sub EXCEL_Export_Click()

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "Q_Auswahl", "AuswahlX"
End Sub
Damit ist der Export schonmal erledigt, die Anzeige der Excel-Datei kennst Du ja.

__________________

Gruß
Ralf
drambeldier ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.05.2018, 20:02   #6
MRE59
Threadstarter Threadstarter
MOF User
MOF User
Standard

Danke schon mal für die Info.

Wo soll ich den Befehl
Code:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "Q_Auswahl", "AuswahlX"
denn einsetzen?

Ich hab den hier eingesetzt.
Code:

Private Sub EXCEL_Export_Click()
   Dim oExcel As Object
   Dim RS As DAO.Recordset
   Dim ExcelWarGeoeffnet As Boolean
   
   Dim I As Long
   
   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "Q_Auswahl", "AuswahlX"
   
   On Error Resume Next
   Set oExcel = GetObject(, "Excel.Application ")
   If Err.Number <> 0 Then
      Set oExcel = CreateObject("Excel.Application")
   
  
   Else
      ExcelWarGeoeffnet = True
   End If
   
   On Error GoTo 0
   With oExcel
      .Visible = True

      With .Workbooks.Add

         With .ActiveSheet
            .Name = Me.Auswahl
    
    Set DB = CurrentDb
    
    'Set RS = DB.OpenRecordset("Abfrage1", dbOpenSnapshot)
    Set RS = DB.OpenRecordset("Q_Auswahl", dbOpenSnapshot)
      For I = 0 To RS.Fields.Count - 1
        .Cells(1, I + 1) = RS.Fields(I).Name
      Next I
      .Range("A2").Select
      .Range("A1").Select

        End With
    End With
End With

End Sub
Leider funktioniert es nicht. Kannst du mir da weiterhelfen?
MRE59 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.05.2018, 21:47   #7
maikek
MOF Guru
MOF Guru
Standard

Die Syntax des Befehls lautet:
Code:

DoCmd.TransferSpreadsheet (TransferType, SpreadsheetType, TableName, FileName, HasFieldNames, Range, UseOA)
Übersetzt:
Code:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Q_Auswahl", "DeinPfad/Dateiname.xlsx", true
acSpreadsheetTypeExcel12 gilt ab Office 2010.

Den ganzen restlichen Kram außer der Versorgung der Abfrage mit dem Parameter brauchst du dann nicht mehr.

Siehe auch hier: https://msdn.microsoft.com/de-de/vba...-method-access

maike

__________________

Bitte dein Thema auf erledigt setzen, wenn's durch ist!
MOF Access Stammtisch in Bremen
maikek ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 23.05.2018, 22:29   #8
MRE59
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Maikek,
ich habe es versucht, doch komm ich mit dem Code leider nicht mehr weiter.
Zwischenzeitlich weis ich nicht mehr was in den Code gehört und was nicht.

Sorry, mir fehlt halt die Erfahrung mit VBA.

Könntest du mir hier nochmals helfen?
Das wäre echt super!
MRE59 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.05.2018, 08:49   #9
Steffen0815
MOF Meister
MOF Meister
Standard

Hallo,
versuche es so:
Code:

Option Compare Database
Option Explicit

Private Sub EXCEL_Export_Click()
Dim xlApp As Object, xlWB As Object, xlSheet As Object
Dim rs As DAO.Recordset, i As Integer, sOrt As String
    Set xlApp = CreateObject("Excel.Application") ' Excel Application erstellen
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add ' Workbook erstellen
    Set xlSheet = xlWB.ActiveSheet ' Tabelle zuweisen
    xlSheet.Name = Me.Auswahl

    sOrt = Forms!Abfrage.Auswahl
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM Kontakt WHERE Kontakt.Ort='" & sOrt & "'", dbOpenSnapshot)
    ' Überschriften schreibben
    For i = 0 To rs.Fields.Count - 1
      xlSheet.cells(1, i + 1) = rs.Fields(i).Name
    Next i
    ' Daten schreiben
    xlSheet.range("A2").copyfromrecordset rs
End Sub

__________________

Gruß Steffen

Geändert von Steffen0815 (24.05.2018 um 08:53 Uhr).
Steffen0815 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.05.2018, 09:50   #10
MRE59
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Steffen,
der Code passt. Vielen vielen Dank!!!

Kleines Problem habe ich noch:
Wenn in Auswahl leer ist und ich EXCEL_Export klicke, bekomme ich die Fehlermeldung Laufzeitfehler '13' Typen unverträglich

Wie kann man das Beheben?

z.B. durch eine Meldung "Bitte zuerst einen Ort auswählen"

Vorab nochmals Danke!

Gruß Martin
MRE59 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.05.2018, 10:24   #11
drambeldier
MOF Koryphäe
MOF Koryphäe
Standard

Hi,

ohne Gewurschtel mit Überschriften etc:
Code:

Private Sub EXCEL_Export_Click()

    Dim xlApp       As Excel.Application
    Dim DSN         As String
    Dim wb          As Excel.workbook
                                                        ' Datei erstellen
    DSN = "d:DatenAuswahlX.xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7, "Q_Auswahl", DSN
    
                                                        ' Excel öffnen
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    End If
                                                        ' Datei zeigen
    xlApp.Visible = True
    Set wb = xlApp.Workbooks.Open(DSN)
End Sub

__________________

Gruß
Ralf
drambeldier ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.05.2018, 10:38   #12
maikek
MOF Guru
MOF Guru
Standard

Zitat:

Wenn in Auswahl leer ist und ich EXCEL_Export klicke, bekomme ich die Fehlermeldung Laufzeitfehler '13' Typen unverträglich

Das prüfst du dann vorher:
Code:

Private Sub EXCEL_Export_Click()
Dim xlApp As Object, xlWB As Object, xlSheet As Object
Dim rs As DAO.Recordset, i As Integer, sOrt As String

If not isNull(Forms!Abfrage.Auswahl) then

    Set xlApp = CreateObject("Excel.Application") ' Excel Application erstellen
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add ' Workbook erstellen
    Set xlSheet = xlWB.ActiveSheet ' Tabelle zuweisen
    xlSheet.Name = Me.Auswahl

    sOrt = Forms!Abfrage.Auswahl
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM Kontakt WHERE Kontakt.Ort='" & sOrt & "'", dbOpenSnapshot)
    ' Überschriften schreibben
    For i = 0 To rs.Fields.Count - 1
      xlSheet.cells(1, i + 1) = rs.Fields(i).Name
    Next i
    ' Daten schreiben
    xlSheet.range("A2").copyfromrecordset rs

Else
    MsgBox "Bitte Ort auswählen."
End If

End Sub
maike

__________________

Bitte dein Thema auf erledigt setzen, wenn's durch ist!
MOF Access Stammtisch in Bremen
maikek ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 24.05.2018, 12:44   #13
MRE59
Threadstarter Threadstarter
MOF User
MOF User
Standard

Vielen Dank für eure Mithilfe

So habe ich mir die ACCESS-Anwendung vorgestellt.

Für die Nachwelt habe ich nun meine "Test_Version3" zum Download!

Einen Schönheitsfehler habe ich noch drin!
Wenn die Abfrage ausgeführt wurde, ist EXCEL manchmal nur in der Taskleiste aktiv und die Tabelle kommt nicht automatisch in den Vordergrund.

Wäre schön, wenn das auch noch funktionieren würde.

Hier nochmals der funktionierende Code:
Code:

Private Sub EXCEL_Export_Click()
Dim xlApp As Object, xlWB As Object, xlSheet As Object
Dim rs As DAO.Recordset, i As Integer

If Not IsNull(Forms!Abfrage.Auswahl) Then
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    Set xlSheet = xlWB.ActiveSheet
    xlSheet.Name = Me.Auswahl

    Set rs = CurrentDb.OpenRecordset("SELECT * FROM Ort WHERE Kontakt.Ort='" & Forms!Abfrage.Auswahl & "'", dbOpenSnapshot)
    For i = 0 To rs.Fields.Count - 1
      xlSheet.cells(1, i + 1) = rs.Fields(i).Name
    Next i
    xlSheet.range("A2").copyfromrecordset rs

Else
    MsgBox "Bitte zuerst einen Ort auswählen!", vbInformation
End If

End Sub
Gruß Martin
Angehängte Dateien
Dateityp: zip Test_Version_3.zip (24,4 KB, 1x aufgerufen)
MRE59 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 10:56 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.