PDA

Vollständige Version anzeigen : Excel Export mit Formatierung Fehler


Axel Foley2
12.07.2006, 09:58
Hallo,
mein Problem ist folgendes: Ich exportiere aus Acc in Excel inkl. Fomatierung. Das funktioniert auch soweit, bis ich 2 Dateien hintereinander in einem Code exportieren will. Dann kommt folgende Meldung: Die Methode Range für das Objekt _Global ist fehlgeschlagen. Die 1.Datei wird exportiert inkl. Formatierung in Excel, die 2.Datei wird exportiert und bricht dann bei der Formatierung ab.

Hier ist mal mein Code:

Public Function fct_Export_Test()

Dim strFileName As String
Dim strQuery As String



strFileName = CurrentPath & "UPL_NA_" & Format(Date, "yymmdd") & ".xls"
strQuery = "qry_Excel_Export_NA"

On Error Resume Next
Kill strFileName
On Error GoTo 0

'Export Excel1
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strQuery, strFileName, True

Set xlapp = CreateObject("Excel.Application")
xlapp.Workbooks.Open (strFileName)
Set xlbook = xlapp.Workbooks("UPL_NA_" & Format(Date, "yymmdd") & ".xls")
Set xlSheet = xlbook.Worksheets(strQuery)
xlSheet.Activate
Range(("A1"), Range("A1").End(xlToRight)).Select
Selection.AutoFilter
Selection.EntireColumn.AutoFit
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
xlSheet.PageSetup.PrintTitleRows = "$1:$1"
xlSheet.PageSetup.CenterHeader = ""
xlSheet.PageSetup.LeftFooter = "&7Ersteller: " & DLookup("UserDB", "tc_config") & Chr(10) & "Erstellungsdatum: " & Date & ", gültig bis: " & DLookup("Gueltig_bis", "tc_config") & Chr(10) & "&7Dateibezeichnung: " & DLookup("Aktuellpath", "tc_config")
xlSheet.PageSetup.CenterFooter = "&7Stand Daten: " & DLookup("letzter_Stand", "tc_config") & " &7Version: " & DLookup("Wurzel_5_P", "tc_config")
xlSheet.PageSetup.RightFooter = "&7 Seite: &7&P von &N"
xlSheet.Name = strFileName
xlbook.Save
xlbook.Close
xlapp.CutCopyMode = False
xlapp.Quit
Set xlapp = Nothing

'Export Excel2
strFileName = CurrentPath & "UPL_NB_" & Format(Date, "yymmdd") & ".xls"
strQuery = "qry_Excel_Export_NB"

On Error Resume Next
Kill strFileName
On Error GoTo 0

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strQuery, strFileName, True

Set xlapp = CreateObject("Excel.Application")
xlapp.Workbooks.Open (strFileName)
Set xlbook = xlapp.Workbooks("UPL_NB_" & Format(Date, "yymmdd") & ".xls")
Set xlSheet = xlbook.Worksheets(strQuery)
xlSheet.Activate
Range(("A1"), Range("A1").End(xlToRight)).Select
Selection.AutoFilter
Selection.EntireColumn.AutoFit
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
xlSheet.PageSetup.PrintTitleRows = "$1:$1"
xlSheet.PageSetup.CenterHeader = ""
xlSheet.PageSetup.LeftFooter = "&7Ersteller: " & DLookup("UserDB", "tc_config") & Chr(10) & "Erstellungsdatum: " & Date & ", gültig bis: " & DLookup("Gueltig_bis", "tc_config") & Chr(10) & "&7Dateibezeichnung: " & DLookup("Aktuellpath", "tc_config")
xlSheet.PageSetup.CenterFooter = "&7Stand Daten: " & DLookup("letzter_Stand", "tc_config") & " &7Version: " & DLookup("Wurzel_5_P", "tc_config")
xlSheet.PageSetup.RightFooter = "&7 Seite: &7&P von &N"
xlSheet.Name = strFileName
xlbook.Save
xlbook.Close
xlapp.CutCopyMode = False
xlapp.Quit
Set xlapp = Nothing

End
End Function

Hat einer einen Tipp?
Danke im voraus
Axel

Anne Berg
12.07.2006, 10:37
Der alte Fehler: du kannst da nicht einfach Methoden anwenden ohne das Objekt zu nennen, auf die sich beziehen! Set xlapp = CreateObject("Excel.Application")
xlapp.Workbooks.Open (strFileName)
Set xlbook = xlapp.Workbooks("UPL_NA_" & Format(Date, "yymmdd") & ".xls")
Set xlSheet = xlbook.Worksheets(strQuery)
xlSheet.Activate
?.Range(("A1"), ?.Range("A1").End(xlToRight)).Select
?.Selection.AutoFilter
?.Selection.EntireColumn.AutoFit
With ?.Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
?.Range("A2").Select
?.ActiveWindow.FreezePanes = True
xlSheet.PageSetup.PrintTitleRows = "$1:$1"
xlSheet.PageSetup.CenterHeader = ""
xlSheet.PageSetup.LeftFooter = "&7Ersteller: " & DLookup("UserDB", "tc_config") & Chr(10) & "Erstellungsdatum: " & Date & ", gültig bis: " & DLookup("Gueltig_bis", "tc_config") & Chr(10) & "&7Dateibezeichnung: " & DLookup("Aktuellpath", "tc_config")
xlSheet.PageSetup.CenterFooter = "&7Stand Daten: " & DLookup("letzter_Stand", "tc_config") & " &7Version: " & DLookup("Wurzel_5_P", "tc_config")
xlSheet.PageSetup.RightFooter = "&7 Seite: &7&P von &N"
xlSheet.Name = strFileName
xlbook.Save
xlbook.Close
xlapp.CutCopyMode = False
xlapp.Quit
Set xlapp = Nothing

Nachtrag:
Wozu überhaupt die Code-Wiederholung? Schreibe eine allgemein taugliche Prozedur, die du beliebig oft aufrufen kannst. (Den Fehler musst du aber trotzdem bereinigen!)

Axel Foley2
12.07.2006, 10:40
ok, irgendwie steh ich auf der Leitung :( , kannst Du mir auf die Sprünge helfen?

Anne Berg
12.07.2006, 11:56
Du hast da bereits drei Objekte zur Auswahl: xlApp, xlBook und xlSheet - das sollte genügen. ;)

Ich könnte jetzt die Excel-Hilfe aufsuchen und nachsehen, zu welchem Objekt die benutzten Methoden oder Eigenschaften gehören, aber ich finde, das kannst du ebensogut selbst machen. :p

Axel Foley2
12.07.2006, 12:08
Hallo Anne,

klar ich Hirn....jetzt funkts Danke :)

thx Axel