Macro: opslaan als PDF

[Toops]

Beste,

Ik wil graag elk blad uit mijn worksheet(20 sheets) apart opslaan als een PDF bestand.
De naam van het bestand wil ik dan hetzelfde hebben als de sheetnaam + een getal uit een cel van die betreffende sheet.

Deze macro heb ik tot nu toe:

Sub SaveWorksheetAsPDF()

    Dim sFileName As String
    
    With ActiveSheet
        sFileName = .Range("I9").Value  '
        .Copy
        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\" & sFileName & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWindow.Close False
    End With
End Sub

Hierbij krijg ik alleen de actieve sheet als PDF, dus degene waarmee ik op dat moment mee bezig ben.
Wat moet ik veranderen zodat hij alle sheets in de werkmap exporteert?

Zou iemand me ook kunnen vertellen hoe ik VBA vertel om ook de naam van de desbetreffende sheet te gebruiken?

Enorm bedankt!

 

[ExcelAmateur]

toops,

Kijk hier eens bij #3

Zie in de code For each sheet
Of zo, je code alvast aangepast.

Sub SaveWorksheetAsPDF()
  Dim sFileName As String
  For x = 1 To Sheets.Count
    With Sheets(x) 'ActiveSheet
        sFileName = .Range("I9").Value  '
        .Copy
        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\" & sFileName & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWindow.Close False
    End With
  Next
End Sub

 

[Warme bakkertje]

Sub SaveWorksheetAsPDF()
  Dim sFileName As String
  For x = 1 To Sheets.Count
    With Sheets(x) 'ActiveSheet
        sFileName = .Name & "_" & .Range("I9").Value 
        .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & sFileName & ".pdf"
    End With
  Next
End Sub

 

[Toops]

Super bedankt, het is gelukt!

Nu heb ik nog een vraag, ik weet niet of dat mogelijk is maar het zou superhandig zijn.
is het mogelijk om ze op te slaan in een map die hij zelf aanmaakt met de naam van de huidige maand?
De huidige maand staat ook in het workbook in cel E19.

Het pad wat ik dan wil gebruiken is Macintosh HD/Gebruikers/Tobias/Documenten/facturen/2015

Weet iemand hoe ik dit moet verwerken in de macro?

Bedankt!

 

[ExcelAmateur]

Jij mag ook de ingebouwde zoekmachine van "Helpmij" gebruiken.
Vermeld de volgende keer ook dat je met een Mac werkt.

Als je gezocht had was je hier terecht gekomen.

Eventuele aanpassing zal je zelf wel kunnen.

 

[Toops]

Na dagen proberen en vele foutmeldingen kom ik er niet uit.

Het gaat hier al fout, als ik het bestand en de macro uit de link van Excelamateur gebruik en die zo aanpas voor Mac:

Sub Test()
Dim fs As Object 'Eerst kijken of de schijf en map bestaat
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists("Macintosh:Users:Documents:Tobias:facturen\" & Range("A1")) Then
'Maak een map
MkDir "Macintosh:Users:Documents:Tobias:facturen\" & Range("A1")
End If
ActiveWorkbook.SaveAs Filename:="Macintosh:Users:Documents:Tobias:facturen\" & Sheets("Blad1").Range("A1") & "\" & Sheets("Blad1").Range("A1") & ".pdf"
End Sub

Dan krijg ik de volgende foutmelding

Fout 429 tijdens Runtime
Active-X kan object niet maken.

Als ik vervolgens fout opsporen doe komt et volgende in het geel te staan:
Set fs = CreateObject("Scripting.FileSystemObject")

Wie kan mij helpen hiermee?

Dank!

 

[Warme bakkertje]

Ik heb geen ervaring met Mac maar zijn die dubbele punten in de padnaam correct ?

Heb je de correcte verwijzing aangevinkt bij Extra - Verwijzingen? (Microsoft Scripting Runtime)

Ook gaat SaveAs niet samen met pdf.

 

[ExcelAmateur]

Kijk anders of je hier wat vind, daar staan meerdere voorbeelden voor de mac en niet alleen voor PDF.

 

[Toops]

Bedankt voor de input!

@Warme Bakkertje, Ja Ik had om te checken een Macro opgenomen, waarin ik een excel bestand had opgeslagen, hier gaf hij ook de dubbele punten.

Ik heb met behulp van Ron het tot deze macro weten te schoppen:

Sub OpslaanAlsPDFmetmaand()
    Dim FolderString As String
    Dim ScriptToMakeDir As String
    Dim DirectoryName As String
    
    DirectoryName = ThisWorkbook.Sheets("Sheet1").Range("E17").Value

    FolderString = "Macintosh HD:Users:Tobias:Documents:facturen:2015:" & DirectoryName:

    ScriptToMakeDir = "tell application " & Chr(34) & _
                      "Finder" & Chr(34) & Chr(13)
    ScriptToMakeDir = ScriptToMakeDir & _
                      "do shell script ""mkdir -p "" & quoted form of posix path of " & _
                      Chr(34) & FolderString & Chr(34) & Chr(13)
    ScriptToMakeDir = ScriptToMakeDir & "end tell"

    On Error Resume Next
    MacScript (ScriptToMakeDir)
    On Error GoTo 0
    
    For x = 1 To Sheets.Count
    With Sheets(x) 'ActiveSheet
        sFileName = .Range("I9").Value & "_" & .Name
        .ExportAsFixedFormat 0, FolderString & sFileName & ".pdf"
    End With
  Next
    
End Sub

Hij maakt nu de Directory aan zoals ik die wil.:d

Alleen hij plaatst de bestanden niet IN de aangemaakte map, maar op dezelfde plek als de map.
Hij benoemt dan ook in iedere PDF als de DirectoryName gevolgd met Celwaarde en .Name

Ik wil dus dat hij de PDF's in de aangemaakte map plaatst zonder de DirectoryName in de filenames verwerkt.

Bedankt!

 

[Toops]

Het is gelukt!
Voor de geintresseerde"

2 aparte macro's maken en deze vervolgens in 1 macro callen bleek de oplossing

Zie hier

Sub MAAKMAP()
    Dim FolderString As String
    Dim ScriptToMakeDir As String
    Dim directoryName As String
     Dim sFilename As String
    Dim Directory As String
 
    
    directoryName = ThisWorkbook.Sheets("01Malin").Range("E17").Value

    Directory = "Macintosh HD:Users:Tobias:Documents:facturen:2015:" & directoryName:

    ScriptToMakeDir = "tell application " & Chr(34) & _
                      "Finder" & Chr(34) & Chr(13)
    ScriptToMakeDir = ScriptToMakeDir & _
                      "do shell script ""mkdir -p "" & quoted form of posix path of " & _
                      Chr(34) & Directory & Chr(34) & Chr(13)
    ScriptToMakeDir = ScriptToMakeDir & "end tell"

    On Error Resume Next
    MacScript (ScriptToMakeDir)
    On Error GoTo 0
    
    End Sub
    
    Sub opslaanPDFzondermapmaken()
    Dim FolderString As String
    Dim sFilename As String
    Dim DirectoryName As String
    
    directoryName = ThisWorkbook.Sheets("01Malin").Range("E17").Value
    
    FolderString = "Macintosh HD:Users:Tobias:Documents:facturen:2015:DirectoryName:"
    
    For x = 1 To Sheets.Count
    With Sheets(x) 'ActiveSheet
        sFilename = .Range("I9").Value & "_" & .Name
        .ExportAsFixedFormat 0, FolderString & sFilename & ".pdf"
    End With
  Next
    
End Sub

Sub PDFOpslaan()

Call ThisWorkbook.MAAKMAP
Call ThisWorkbook.opslaanPDF

End Sub