Macro PDF opslaan meerdere tabbladen afzonderlijk

[paulkoenis]

Goedendag

Ik heb onderstaande macro staan om 1 excel tabblad op te slaan in een bepaalde map
Nu heeft het excel bestand meer dan 100 tabbladen en dat kunnen er volgende maand wel weer meer zijn

Ik heb nu deze macro op alle tabbladen gezet en zo sla ik 1 voor 1 de PDF op

Graag zou ik willen dat ik met 1 macro alle tabbladen afzonderlijk kan opslaan met hun eigen naam

Hoe realiseer ik dit?


Sub PDF()
Dim FacName As String
FacName = ActiveSheet.Range("G1").Value & " " & Range("E1").Value
If Dir("\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Spaaruren" & FacName & ".pdf") <> "" Then
MsgBox "Het bestand: " & FacName & ".pdf bestaat reeds"
Exit Sub
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Spaaruren" & FacName & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End If
End Sub

 

[VenA]

Zet er een lusje omheen

Sub PDF()
  For Each sh In Sheets
    jouw code
  Next sh
End Sub

Waarbij je activesheet vervangt door sh en de onnodige Exit Sub weglaat.

 

[paulkoenis]

Heel hartelijk dank het werkt

Hoe kan ik er voor zorgen dat de eerste 4 tabbladen niet meegenomen wordt?

De Macro ziet er nu zo uit

Sub PDF()
'
' PDF Macro
'
For Each sh In Sheets
Dim FacName As String
FacName = sh.Range("G1").Value & " " & sh.Range("E1")
If Dir("\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Test" & FacName & ".pdf") <> "" Then
MsgBox "Het bestand: " & FacName & ".pdf bestaat reeds"
Else
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Test" & FacName & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End If
Next sh
End Sub



Alvast bedankt

 

[edmoor]

Dat wordt dan zoiets:

Sub PDF()
[COLOR="#008000"]    '
    ' PDF Macro
    '[/COLOR]
    Dim FacName As String
    For Each sh In Sheets
        FacName = sh.Range("G1").Value & " " & sh.Range("E1")
        Select Case sh.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet4"
            Case Else
                If Dir("\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Test" & FacName & ".pdf") <> "" Then
                    MsgBox "Het bestand: " & FacName & ".pdf bestaat reeds"
                Else
                    sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Test" & FacName & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
                End If
        End Select
    Next sh
End Sub

 

[OctaFish]

Of zo, en wat flexibeler:

Sub PDF()
Dim FacName As String
Dim sh As Worksheet
    For Each sh In Sheets
        If Mid(sh.CodeName, 5, Len(sh.CodeName) - 4) > 4 Then
            FacName = sh.Range("G1").Value & " " & sh.Range("E1")
            If Dir("\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Test" & FacName & ".pdf") <> "" Then
                MsgBox "Het bestand: " & FacName & ".pdf bestaat reeds"
            Else
                sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:="\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\Test" & FacName & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
            End If
        End If
    Next sh
End Sub

Ik ga uit van een Nederlandse versie met 'Blad1' etc. als Codenaam. Heb je de Engelse versie, dan heet dat Sheet1 en moet je niet 4 gebruiken in de Mid, maar 5.

 

[VenA]

Je kan ook gewoon vanaf de 5e tab beginnen te tellen en om mogelijk veel meldingen te voorkomen kan je deze beter in 1 keer tonen anders blijf je op Ok klikken.

Sub VenA()
  c00 = "\\go.local\data2\klantendata2\TSNed\Groepsdata\Regio Controller\"
  For j = 5 To Sheets.Count
    c01 = "Test" & Sheets(j).Range("G1").Value & " " & Sheets(j).Range("E1") & ".pdf"
    If Dir(c00 & c01) <> "" Then
      c02 = c02 & c01 & vbLf
     Else
      Sheets(j).ExportAsFixedFormat 0, c00 & c01
    End If
  Next j
  If Len(c02) Then MsgBox "de volgende bestanden bestaan al" & vbLf & c02
End Sub

 

[paulkoenis]

Heel hartelijk dank allemaal
Ik ben enorm geholpen