Vanuit access een Excel sheet aanpassen

Status
Niet open voor verdere reacties.

Sytse1

Gebruiker
Lid geworden
9 aug 2007
Berichten
584
Office versie
miDer
Met een selectie query exporteer ik twee kruistabel queries naar Excel.
De twee kruistabellen die in de selectie query verbonden zijn worden regelmatig geupdated.
Werkt uitstekend. En wordt in Excel getoond.
De vraag is of het mogelijk is vanuit Access het Excel sheet zodanig aan te passen dat de kolommen passend zijn.
Hieronder mijn vba script die exporteerd.
Code:
im tFile As String
Dim Antwoord As Variant
Dim xlApp As Object, wkBK As Object
    Antwoord = MsgBox("De spreadsheet wordt opgeslagen in C:\Temp\Periodeoverzicht.xlsx " & Chr(13) & "Wil je het excel bestand nu openen?", vbQuestion + vbYesNo, "Bestand openen")
    If Antwoord = vbYes Then
        tFile = "C:\Temp\Periodeoverzicht.xlsx"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Qry_UItslagen_Periode_Kruistabel_Totaal", tFile, True, "Periodeoverzicht"
        Set xlApp = CreateObject("Excel.Application")
        With xlApp
            .Visible = True
            Set wkBK = .Workbooks.Open(tFile)
        End With
    Else
    Antwoord = MsgBox("Oke dan doen we dit niet" & Chr(13) & "U gaat terug naar het laatste overzicht", vbYes, "Volgende keer beter")
    End If

Zie een stukje van de sheet als voorbeeld.
 

Bijlagen

  • voorbeeld.png
    voorbeeld.png
    12,4 KB · Weergaven: 23
Waarom maak je in Excel niet een macro die het gegevensgebied selecteert en vervolgens op basis daarvan de kolombreedtes instelt? Die macro start je dan als je het Excel bestand opent. Heb je alles simpel (en vooral: snel) geregeld.
 
Dat kan, maar er wordt volgens mij in vba steeds een nieuwe sheet geexporteerd.
Daarna wordt Excel geopend.
Volgens mij werkt een autoexe in Excel dan niet.
Vandaar mij vraag.
 
De code van zo'n macro kun je ook in je export macro verwerken.
 
:Dit is dan ook precies mijn vraag. Graag een tip hoe dit moet. :eek:
 
Die heb je ik je gegeven: neem de macro op in Excel :). Dan weet je namelijk welke acties je na het openen van je bestand moet toevoegen. De code is namelijk hetzelfde.
 
Als het niet werkt, moet je maar even laten zien welke code je daarvoor gebruikt.
 
Octafish, ik heb de volgende (niet werkende) code voor het aanpassen van de Excel sheet.
De query wordt geexporteerd. Excel en de sheet wordt geopend maar dan stopt het bij .Workbooks.Sheets("Periodeoverzicht").Select
Ik heb geprobeerd op te lossen tevergeefs.
Graag je reactie waar mijn fout zit.
Ik wil dat de kolommen zich aan de breedte het geexporteerde aanpassen en dat de tekst in kolomkoppen op de eerste regel vertikaal getoond worden.

Code:
Dim tFile As String
Dim Antwoord As Variant
Dim xlApp As Object, wkBK As Object
    Antwoord = MsgBox("De spreadsheet wordt opgeslagen in C:\Temp\Periodeoverzicht.xlsx " & Chr(13) & "Wil je het excel bestand nu openen?", vbQuestion + vbYesNo, "Bestand openen")
    If Antwoord = vbYes Then
        tFile = "C:\Temp\Periodeoverzicht.xlsx"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Qry_UItslagen_Periode_Kruistabel_Totaal", tFile, True, "Periodeoverzicht"
        Set xlApp = CreateObject("Excel.Application")
        With xlApp
         .Visible = True
        Set wkBK = .Workbooks.Open(tFile)
        .Workbooks.Sheets("Periodeoverzicht").Select
        .Workbooks.Sheets("Periodeoverzicht").Rows("1:1").Select
       With .Workbooks.Sheets("Periodeoverzicht").Selection
        .HorizontalAlignment = .Workbooks.Sheets("Periodeoverzicht").xlGeneral
        .VerticalAlignment = .Workbooks.Sheets("Periodeoverzicht").xlBottom
        .WrapText = False
        .Orientation = .Workbooks.Sheets("Periodeoverzicht").xlVertical
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = .Workbooks.Sheets("Periodeoverzicht").xlContext
        .MergeCells = False
    End With
    .Workbooks.Sheets("Periodeoverzicht").Cells.Select
    .Workbooks.Sheets("Periodeoverzicht").Cells.EntireColumn.AutoFit
    .Workbooks.Sheets("Periodeoverzicht").Range("A1").Select
        End With
    Else
    Antwoord = MsgBox("Oke dan doen we dit niet" & Chr(13) & "U gaat terug naar het laatste overzicht", vbYes, "Volgende keer beter")
    End If
 
Je vergeet te zeggen welk workbook. Ofwel noem je het workbook zoals je ook bij de verzameling sheets doet: Workbooks("naamVanHetBoek"), maar aangezien je al een referentie hebt naar het juiste werkboek kan je ook wkbk.sheets("Periodeoverzicht").select doen
 
Laatst bewerkt:
Waarom zoveel Select in de macro? Nergens voor nodig…
 
Dat is typisch het resultaat van een opgenomen macro. Daar staan bijna altijd overbodige selects in
 
Bedankt voor de bijdrage.
Als ik net zo goed was als Octafish en Noellag kon ik het volgende liedje zingen.
'T is moeilijk bescheiden te blijven
Wanneer je zo goed bent als ik
Zo stoer, zo charmant en zo aardig
Dat zie je in één ogenblik

Maar nu moet ik het jullie aanwijzingen doen:D:D
 
Laat ik je dan een beetje helpen met de code; alleen zeggen waaróm helpt je natuurlijk niet verder. Hierbij derhalve de aangepaste macro.

Code:
Dim tFile As String, Antwoord As Variant
Dim xlApp As Object, wkBK As Object, wkSht As Object

    Antwoord = MsgBox("De spreadsheet wordt opgeslagen in D:\Test\Periodeoverzicht.xlsx " & Chr(13) & "Wil je het excel bestand nu openen?", vbQuestion + vbYesNo, "Bestand openen")
    If Antwoord = vbYes Then
        tFile = "D:\Test\Periodeoverzicht.xlsx"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Query1", tFile, True, "Periodeoverzicht"
        Set xlApp = CreateObject("Excel.Application")
        With xlApp
             .Visible = True
            Set wkBK = .Workbooks.Open(tFile)
            With wkBK
                Set wkSht = .Sheets("Periodeoverzicht")
                With wkSht
                    .Rows("1:1").Orientation = xlVertical
                    .Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
                    .Range("A1").Select
                End With
            End With
        End With
    Else
        Antwoord = MsgBox("Oke dan doen we dit niet" & Chr(13) & "U gaat terug naar het laatste overzicht", vbYes, "Volgende keer beter")
    End If
 
Octafish, bedankt weer.
De code is een stuk korter. Ik heb mijn overbodige en niet werkende met jouw code weer bestudeerd en weer bijgeleerd.
1 regel in de code werkt niet maar geeft ook geen foutmelding.
.Rows("1:1").Orientation = xlVertical
Ik zoek verder waar dit aan ligt.
Sytse
 
Ik heb die niet getest, moet ik er bij zeggen. In mijn test heb ik de eerste regel vet gemaakt, en dat werkte prima met deze code. Ging er vanuit dat een kopietje van jouw code genoeg zou zijn :).
 
Ik zou het vanuit Excel aanvliegen. Vanuit Access een nieuwe instantie creëren werkt niet echt lekker. Na het sluiten van het bestand lijkt Excel afgesloten te zijn maar in de 'taskmanager' staat er nog wel een instantie open.
Vanuit Excel kan je vrij eenvoudig een koppeling maken met een Access tabel/query.

Via powerquery ziet het er zo uit:
PHP:
let
    Source = Access.Database(File.Contents("E:\Temp\Test.accdb"), [CreateNavigationProperties=true]),
    _Qry_UItslagen_Periode_Kruistabel_Totaal = Source{[Schema="",Item="Qry_UItslagen_Periode_Kruistabel_Totaal"]}[Data]
in
    _Qry_UItslagen_Periode_Kruistabel_Totaal

Eventueel schrijf je er nog wat code omheen om de altijd belangrijke lay-out aan te passen.
 
Vanuit Access een nieuwe instantie creëren werkt niet echt lekker. Na het sluiten van het bestand lijkt Excel afgesloten te zijn maar in de 'taskmanager' staat er nog wel een instantie open.
Die instantie kun je natuurlijk ook prima sluiten vanuit Access. TS heeft niet de volledige code laten zien, dus ik ga er vanuit dat de sluitcode er best wel bij zou kunnen zitten. En anders is die er natuurlijk zo bijgepend. Ik heb in ieder geval nooit problemen gehad met het afsluiten van Excel objecten vanuit Access.
 
Het is de bedoeling dat de gebruiker direct het resultaat in Excel ziet en zelf Excel afsluit.
Bedankt voor het meedenken en van de vba code.
 
Laatst bewerkt:
Ik snap nog niet helemaal wat je wilt, maar is dit wat je bedoelt?
Code:
Dim tFile As String, Antwoord As Variant, xlApp As Object, wkBK As Object, wkSht As Object
    Antwoord = MsgBox("De spreadsheet wordt opgeslagen in D:\Test\Periodeoverzicht.xlsx " & Chr(13) & "Wil je het excel bestand nu openen?", vbQuestion + vbYesNo, "Bestand openen")
    If Antwoord = vbYes Then
        tFile = "D:\Test\Periodeoverzicht.xlsx"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Query1", tFile, True, "Periodeoverzicht"
        Set xlApp = CreateObject("Excel.Application")
        With xlApp
             .Visible = True
            Set wkBK = .Workbooks.Open(tFile)
            With wkBK
                Set wkSht = .Sheets("Periodeoverzicht")
                With wkSht
                    With .Rows("1:1")
                        .WrapText = False
                        .Orientation = 90
                    End With
                    .Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
                    .Range("A1").Select
                End With
            End With
        End With
    Else
        Antwoord = MsgBox("Oke dan doen we dit niet" & Chr(13) & "U gaat terug naar het laatste overzicht", vbYes, "Volgende keer beter")
    End If
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan