Hallo zusammen,
Situation:
ich habe eine Access Datenbank mit einer Tabelle sowie einer Abfrage um auswählen zu können welche Spalten und welche Zeilen der Tabelle exportiert werden sollen.
Auf einem Formular kann man nun die gewünschten Spalten auswählen und mit einem Drop-Down Menü die Auswahl begrenzen.
Drückt man auf den Button „Exportieren“ wird ein Excel Export erstellt. (mittels eines VBA Codes über den Code Generator)
Soweit funktioniert auch alles.
Der Code wurde durch einen ehemaligen Kollegen erstellt und ich bin noch nicht wirklich fit in VBA daher nun
zu meiner Frage:
Wie kann ich den Code anpassen damit die exportierte Excel Tabelle mit Formatierung exportiert wird?
Schön wäre wenn die Spaltenbreite direkt auf die Textlänge angepasst und die erste Zeile z.B. grau hinterlegt wird.
Hier der komplette Code, da ich nicht genau weiß, welche Zeilen alle für den Export verantwortlich sind
Ich hoffe ihr könnt mir helfen
Option Compare Database
Private strColumnString As String
Private Sub Befehl3_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim lngVal1 As Long
Dim strVal2 As String
strSQL = "SELECT Spaltenname FROM RTG_Plan_Abfrage"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
Dim intCounter As Integer
intCounter = 0
Do While Not rs.EOF
If Not rs.EOF Then
'Ist das der erste Datensatz?
If intCounter = 0 Then
strColumnString = "[" & rs.Fields("Spaltenname").Value & "]"
Else
'Erweitere den String um eine Spalte
strColumnString = strColumnString & "," & "[" & rs.Fields("Spaltenname").Value & "]"
End If
'MsgBox (rs.Fields("Spaltenname").Value)
rs.MoveNext
intCounter = intCounter + 1
End If
Loop
'MsgBox (strColumnString)
rs.Close
Set rs = Nothing
Set db = Nothing
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
’ ===================================
’ Verweis auf Microsoft DAO setzen
’ ===================================
Const ExcelDateiName = „C:\TEMP\my.xls“ ’ zu erzeugende Exceldatei
Const tmpAbfrage = „qrytemp“ ’ Abfrage wird automatisch erzeugt und gelöscht
Dim sSQL As String
Dim qdf As DAO.QueryDef
sSQL = "SELECT " & strColumnString & " FROM RTG_Plan_Abfrage2;"
If Len(sSQL) = 0 Then
MsgBox "Keine Datenherkunft"
Exit Sub
End If
Debug.Print sSQL
' evtl. alte Abfrage löschen
On Error Resume Next
DoCmd.DeleteObject acQuery, tmpAbfrage
On Error GoTo 0
Set qdf = CurrentDb.CreateQueryDef(tmpAbfrage, sSQL)
DoCmd.TransferSpreadsheet acExport, 8, tmpAbfrage, ExcelDateiName, True
DoCmd.DeleteObject acQuery, tmpAbfrage
'Aufruf
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Open ExcelDateiName, True, False
Set xlApp = Nothing
'MsgBox ("Abgeschlossen")
End Sub