Export nach Excel: Function zur Formatierung

Moderator: ModerationP

Export nach Excel: Function zur Formatierung

Beitragvon paintitblack3k » 13. Aug 2019, 21:50

Hallo,

ich möchte mehrere Abfragen in jeweils ein separates Tabellennblatt in einer Excel-Tabelle exportieren und anschließend die einzelnen Tabellenblätter formatieren. Damit ich den Formatierungs-Code nicht für jede neue Abfrage komplett kopieren muss, wollte ich nach dem kopieren in das Tabellenblatt in einer eigenen Function alle Formatierungsanweisungen "sammeln".

Mit "Export_test" starte ich Excel und kopiere die einzelnen Abfragen. In der Funktion "FormatSheet" wollte ich Formatierungsbefehle hinterlegen und erhalte leider die Meldung "Objekt erforderlich".

Wie kann ich das "Objekt" übergeben, damit ich die Fomatierung zentral mit der Funktion "FormatSheet" steuern kann? Bzw. kennt ihr bessere Möglichkeiten?

Code: Alles auswählen
Option Compare Database

Public Sub Export_test()
    StartTime = Timer
   
    Dim db As Database
    Dim AnzahlZeilen As Double
    Dim intSpalte As Integer
   
    Dim appExcel As Excel.Application
    Dim wbkExcel As Excel.Workbook
    Dim wksExcel As Excel.Worksheet
    Dim rngExcel As Excel.Range
   
    Dim rcsExport As Recordset
    Dim fldExport As Field
   
    Set appExcel = holeAnwendung("Excel.Application")
    If appExcel Is Nothing Then
        Debug.Print "no Excel found"
    Else
        appExcel.Visible = True
       
        sql = "SELECT * FROM query1"
        Set rcsExport = CurrentDb.OpenRecordset(sql)
       
        Set wbkExcel = appExcel.Workbooks.Add()
        Set wksExcel = wbkExcel.Worksheets(1)
        wksExcel.Name = "Sheet1"
        Startzeile = 3
       
        ' Spaltennamen
        For intSpalte = 1 To rcsExport.Fields.Count
            With wksExcel.Cells(Startzeile, intSpalte)
                .Value = rcsExport.Fields(intSpalte - 1).Name
               '.Interior.Color = vbGreen
            End With
        Next
       
        ' Kopiert Abfrage in Tabellenblatt
        Set rngExcel = wksExcel.Range("A" & (Startzeile + 1))
        rngExcel.CopyFromRecordset rcsExport
       
        FormatSheet (wksExcel.Name)     

        Set wksExcel = Worksheets.Add(After:=Worksheets(1))
        wksExcel.Name = "Sheet2"
       
        sql = "SELECT * FROM query2;"
        Set rcsExport = CurrentDb.OpenRecordset(sql)
       
        ' Spaltennamen
        For intSpalte = 1 To rcsExport.Fields.Count
            With wksExcel.Cells(Startzeile, intSpalte)
                .Value = rcsExport.Fields(intSpalte - 1).Name
               '.Interior.Color = vbGreen
            End With
        Next
       
        ' Kopiert Abfrage in Tabellenblatt
        Set rngExcel = wksExcel.Range("A" & (Startzeile + 1))
        rngExcel.CopyFromRecordset rcsExport
       
        FormatSheet (wksExcel.Name)
       
        appExcel.DisplayAlerts = False
        wksExcel.SaveAs fileName:=CurrentProject.Path & "\test123.xlsx", _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        'appExcel.Quit
        appExcel.DisplayAlerts = True
       
        Set appExcel = Nothing
    End If
End Sub

Public Function FormatSheet(sheet As String)
    Debug.Print sheet
   
    wbkExcel.Sheets(sheet).Rows("1:1").Font.Bold = True
End Function


Vielen Dank

pib
paintitblack3k
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 78
Registriert: 01. Aug 2018, 16:06

Re: Export nach Excel: Function zur Formatierung

Beitragvon Gast » 14. Aug 2019, 08:31

Hallo,

Derzeit übergibts Du kein Objekt sondern nur den Namen des Excelsheets

Code: Alles auswählen
FormatSheet (wksExcel.Name)


Entweder Du übergibst das Objekt
Code: Alles auswählen
FormatSheet (wksExcel)

Public Function FormatSheet(wksExcel As Excel.Worksheet)
    Debug.Print wksExcel.Name
       
    wksExcel.Rows("1:1").Font.Bold = True
End Function


oder Du musst Dein Excel Worksheet global zur Verfügung stellen

Code: Alles auswählen
Option Compare Database

Public appExcel As Excel.Application
Public wbkExcel As Excel.Workbook
Public wksExcel As Excel.Worksheet
Public rngExcel As Excel.Range

Public Sub Export_test()
    StartTime = Timer
   
    Dim db As Database
    Dim AnzahlZeilen As Double
    Dim intSpalte As Integer
   
    'Dim appExcel As Excel.Application
    'Dim wbkExcel As Excel.Workbook
    'Dim wksExcel As Excel.Worksheet
    'Dim rngExcel As Excel.Range


LG
Norbert
Gast
 


Zurück zu Access Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 5 Gäste