Auteur Topic: Geselecteerde tabbladen opslaan als 1 PDF-bestand dmv een macro (gelezen 92236 keer)

StefanDeHeuvel · « **Gepost op:** 22 juli 2024, 13:53:56 »

Ik heb een excel-bestand met meerdere tabbladen. Nu zou ik graag een macro willen maken om geselecteerde tabbladen op te slaan als 1 PDF bestand.

De code die ik heb ziet er nu zo uit:

Code: [Selecteer]

Sub SavePDF()

'
    Sheets("Fotos").Select
    Application.CutCopyMode = False
    Sheets("Fotos").Move After:=Sheets(3)


Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As Variant
strName = Range("L3").Value
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd-mm-yyyy\_hh-mm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")

'export to PDF if a folder was selected
If myFile <> False Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        fileName:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file is opgeslagen!" _
    & vbCrLf _
    & myFile
Else
    MsgBox "PDF file is niet opgeslagen"
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "PDF file is niet opgeslagen"
    Resume exitHandler
End Sub

Della Jordan · « **Reactie #1 Gepost op:** 22 juli 2024, 16:00:18 »

Waarom een macro?

Citaat

Open je Excel-werkmap.
Houd de 'Ctrl'-toets op je toetsenbord ingedrukt.
Klik op de tabbladen van de bladen die je als PDF wilt opslaan. Geselecteerde bladen worden gemarkeerd.
Ga naar 'Bestand' in de linkerbovenhoek.
Kies 'Opslaan als'.
Selecteer de locatie waar je het bestand wilt opslaan.
Kies 'PDF' in de vervolgkeuzelijst 'Opslaan als'.
Klik op 'Opslaan'.

SoftAid · « **Reactie #2 Gepost op:** 22 juli 2024, 19:30:36 »

Sorry, Della....

Heb je dat ook zelf getest?

Bij mij werkt dat toch niet (Excel 2021).

@ StefanDeHeuvel,

Welkom op Oplossing.be

Een manier om vanuit Excel meerdere tabbladen op te slaan in één PDF vind ik niet.
Wel een aangepaste macro om alle (gewenste) tabbladen afzonderlijk op te slaan, en dan kan je via Acrobat of een free online tool de verschillende PDF's samenvoegen.

Groeten,

SoftAid

Della Jordan · « **Reactie #3 Gepost op:** 22 juli 2024, 20:06:20 »

Citaat

Bij mij werkt dat toch niet (Excel 2021).

Vreemd, misschien doe je iets verkeerd.
In bijlage, een voorbeeldje.
Selecteer de gewenste tabbladen (Ctrl + shift) oftewel (Ctrl + spatie) die je wilt opslaan als pdf.

SoftAid · « **Reactie #4 Gepost op:** 22 juli 2024, 20:32:36 »

Hallo Della,

Ja, met Ctrl + Shift ingedrukt werkt het wel, maar dat stond niet in je beschrijving.
Daarin stond enkel Ctrl ingedrukt houden bij het selecteren van de gewenste tabbladen.

Daarom vroeg ik ook of je het zelf gecontroleerd (getest) had. Ik deed dus niets verkeerd, enkel dat wat jij door gaf....

Mijn vraag nu: kan deze handeling in een macro gegoten worden, onder een knop?

Groeten,

SoftAid

JEC · « **Reactie #5 Gepost op:** 22 juli 2024, 21:42:53 »

Een van de weinige voorbeelden waarbij je "select" gebruikt

Voor alle sheets:

Code: [Selecteer]

Sub jec()
Sheets.Select
ActiveSheet.ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & "test"
End Sub

Als je specifieke sheets wilt printen kan dat door de eerste regel zo te schrijven

Code: [Selecteer]

Sheets(Array("Sheet1", "Sheet3")).Select

SoftAid · « **Reactie #6 Gepost op:** 22 juli 2024, 21:54:49 »

Dank je wel Jim,

Duidelijk en krachtig

SoftAid

mvdvlist · « **Reactie #7 Gepost op:** 23 juli 2024, 10:42:27 »

SoftAid, de methode van Della kun je ook met de macro recorder opnemen. Wel de blad namen evt aanpassen zoals bv in voorbeeld Jim.

StefanDeHeuvel · « **Reactie #8 Gepost op:** 23 juli 2024, 11:28:11 »

Iedereen bedankt voor de oplossingen. Dat is nu gelukt.
Zou ik alleen graag nog willen weten welk stukje code ik dien te veranderen om de pdf op te slaan met de naam van de werkmap ipv de datum/tijd notatie (_22-07-2024_12-41.pdf)

SoftAid · « **Reactie #9 Gepost op:** 23 juli 2024, 11:52:34 »

Citaat van: StefanDeHeuvel op 23 juli 2024, 11:28:11

Zou ik alleen graag nog willen weten welk stukje code ik dien te veranderen om de pdf op te slaan met de naam van de werkmap ipv de datum/tijd notatie (_22-07-2024_12-41.pdf)

Hallo Stefan, welke aangeboden (en eventueel aangepaste) oplossing heb je gebruikt?

SoftAid

StefanDeHeuvel · « **Reactie #10 Gepost op:** 23 juli 2024, 13:07:28 »

Hi SoftAid, heb de code zoals hij nu gemaakt is hieronder geplaatst.
Ik heb de tabbladen dus eerst geselecteerd n.a.v. wat Della schreef.

Code: [Selecteer]

Sub SavePDF()

'
    Sheets("Fotos").Select
    Sheets("Fotos").Move After:=Sheets(3)
    Sheets(Array("Gegevens Import", "Fotos")).Select
    Sheets("Gegevens Import").Activate

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As Variant
strName = Range("L3").Value
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd-mm-yyyy\_hh-mm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")

'export to PDF if a folder was selected
If myFile <> False Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        fileName:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file is opgeslagen!" _
    & vbCrLf _
    & myFile
Else
    MsgBox "PDF file is niet opgeslagen"
End If

 '
    Sheets("Belijningsvlakken - inspectie").Select
    ActiveWindow.SelectedSheets.Visible = False

exitHandler:
    Exit Sub
errHandler:
    MsgBox "PDF file is niet opgeslagen"
    Resume exitHandler
        
End Sub

SoftAid · « **Reactie #11 Gepost op:** 23 juli 2024, 14:45:08 »

Hallo Stefan,

goed, dat kan werken. Vraag is meervoudig:

- Is het nodig dat werkblad "Fotos" naar achteren verhuisd wordt?
- Welke werkbladen wil je samenvoegen in het PDF en in welke volgorde?
- Waarom wil je werkblad "Belijningsvlakken - inspectie" onzichtbaar maken als je het niet wilt meenemen naar de PDF?
- Wat is er mis met de heel eenvoudige code van JEC ?

Ik heb even alle "bagger" uit je code gehaald, en de naam van het gebruikte (oorspronkelijke) .xlsm bestand gebruikt als naam voor het PDF (je krijgt hier dan bvb Map1.xlsm.PDF als naam.

Code: [Selecteer]

Sub SavePDF_SA()

Dim wsA As Worksheet, wbA As Workbook, strName As Variant, myFile As Variant
Dim strPathFile As String, strPath As String, strFile As String
Sheets(Array("Gegevens Import", "Fotos")).Select
Sheets("Gegevens Import").Activate  
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strFile = strName & ".pdf"
strPathFile = strPath & strFile
myFile = wbA.Name
wsA.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile, IgnorePrintAreas:=False
End Sub

Test deze code eens uit. Resultaat PDF word opgeslaan in de standaard map (meestal "Documenten")

Al die controles worden overbodig indien je naam automatisch wordt gekozen aan de hand van de Excel-mapnaam.

Als je even antwoord op de vragen dan weten we weer iets meer.

SoftAid

Della Jordan · « **Reactie #12 Gepost op:** 23 juli 2024, 16:42:57 »

De beste mentor die ik ooit heb gekend heeft tijdens mijn opleiding eens gezegd dat select of activate in 99% overbodig is
Deze zou moeten voldoende zijn:

Code: [Selecteer]

Sub SavePDF_SA()
With Sheets(Array("Gegevens", "Import", "Fotos"))
Set wbA = ThisWorkbook
Set wsA = ActiveSheet
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strFile = strName & ".pdf"
strPathFile = strPath & strFile
myFile = wbA.Name
wsA.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile
End With
End Sub

En al de variabelen declareren zijn ook niet meer nodig in 2024.
Dit is maar een kladje, het zou veel beter kunnen.
,

SoftAid · « **Reactie #13 Gepost op:** 23 juli 2024, 17:52:58 »

Hallo Della....

Citaat

De beste mentor die ik ooit heb gekend heeft tijdens mijn opleiding eens gezegd dat select of activate in 99% overbodig is

De beste mentor die ik ooit heb gekend heeft tijdens mijn 20 jaar eens gezegd dat select of activate in x % overbodig is, maar soms toch nodig is.

Je vervangt Select door With/EndWith (geen vooruitgang dus) ... én... je code werkt niet?

Heb je die niet getest?

SoftAid

SoftAid · « **Reactie #14 Gepost op:** 23 juli 2024, 18:02:54 »

Citaat van: SoftAid op 23 juli 2024, 17:52:58

... je code werkt niet?

Oh, je had een van de namen van de tabbladen niet juist overgenomen..... Als je "Gegevens Import" vervangt door "Gegevens" werkt het niet.
en je had in de array slechts 2 tabbladen opgenomen, geen drie.

Variabelen declareren doe ik steeds omdat er ook mensen meekijken die met oude versies van Excel werken.
Die mensen wil je niet in de problemen brengen door die declaraties weg te laten, toch?

Voor de rest is je code gelijk aan die van mij.

Groeten,

SoftAid

Help!

Menu

Hulp bij posten

Zoeken

Recente topics