Opgelost Selectie opslaan als pdf met bestands locatie en documentnaam uit celwaarde

[HoeveWatersnoodt]

Beste helper,

Ik zoek een macro code voor het volgende:
Ik wil een afbeelding invoegen met een toegewezen macro waardoor op het blad "Factuur maken" het afdrukbereik word opgeslagen als pdf.
Alle variabele gegevens wil ik graag invoeren op het blad "Instellingen"

• afdrukbereik bepalen op blad "Factuur maken": Gegevens van het afdrukbereik staan op "Instellingen" cellen AG4 en AH4.
• dit afdrukbereik van "Factuur maken" opslaan als PDF:
• op locatie die vermeld staat op blad "instellingen" in cel AD3
• met als naam die staat op blad "instellingen" in cel AG1

Mocht de pdf al bestaat met de naam mag er een opvolgend nummer "(01)" achter.

Alvast heel erg bedankt voor de genomen moeite!
Groet

 

[AD1957]

Neem eens de moeite en zoek op "opslaan als PDF"
Deze vraag komt regelmatig voor.

 

[HoeveWatersnoodt]

Neem eens de moeite en zoek op "opslaan als PDF"
Deze vraag komt regelmatig voor.

Ik zou de vraag niet stellen als ik niet al uren aan het zoeken ben op google en forums met allerlei verschillende zoektermen en van alles uit te proberen wat mogelijk kan werken. Maar bedankt voor je toevoeging.

 

[AD1957]

Probeer het maar eens zo.

Sub PDF()
Dim FacName As String, pad As String

FacName = Sheets("instellingen").Range("AG1")
pad = Sheets("instellingen").Range("AD3")
Sheets("Factuur maken").Range("B2:F16").ExportAsFixedFormat 0, pad & "\" & FacName, , 1, 0, , , 1
End Sub

 

[HoeveWatersnoodt]

Erg bedankt voor de code, met jouw toevoeging ben ik tot een werkend geheel gekomen. In de finetuning word het pdf document als die al met betreffende naam bestaat alleen nog overschreven iov dat die 01 toevoegt achter de naam.

Sub PDFbetaald()
Dim FacName As String, pad As String
FacName = Sheets("instellingen").Range("AG1").Value
pad = Sheets("instellingen").Range("Ae3").Value

ThisWorkbook.Sheets("Factuur maken").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Printtofile:=1, PrToFileName:=pad & "\" & FacName & ".PDF"
End Sub

 

[jverkerk]

Deze code heb ik aangepast, het werkt bij mij.
Ik ben geen vba specialist, dus geleend, ik heb dit volgens mij ook van @AD1957 gekregen maar dat weet ik niet zeker.
Had dit nog in een tekstbestand opgeslagen.
Zal misschien korter kunnen.

Sub PDFbetaald()
    Dim FacName As String, pad As String
    FacName = Sheets("instellingen").Range("AG1").Value
    pad = Sheets("instellingen").Range("AE3").Value

    ThisWorkbook.Sheets("Factuur maken").Activate

    ' Controleer of de factuur al bestaat
    If FileExists(pad & "\" & FacName & ".PDF") Then
        ' Vraag om bevestiging voor het opslaan met toevoeging (01)
        If MsgBox("Deze factuur bestaat al. Wilt u opslaan met toevoeging (01)?", vbQuestion + vbYesNo) = vbYes Then
            Dim nummer As Integer
            nummer = 1

            ' Zoek een uniek nummer voor de bestandsnaam
            Do While FileExists(pad & "\" & FacName & " (" & Format(nummer, "00") & ").PDF")
                nummer = nummer + 1
            Loop

            ' Maak de PDF met uniek nummer in de bestandsnaam
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Printtofile:=1, PrToFileName:=pad & "\" & FacName & " (" & Format(nummer, "00") & ").PDF"
            MsgBox "Factuur succesvol gemaakt!", vbInformation
        Else
            ' Gebruiker heeft ervoor gekozen om niet op te slaan
            MsgBox "Factuur niet opgeslagen.", vbInformation
        End If
    Else
        ' Maak de PDF als de factuur niet bestaat
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Printtofile:=1, PrToFileName:=pad & "\" & FacName & ".PDF"
        MsgBox "Factuur succesvol gemaakt!", vbInformation
    End If
End Sub

Function FileExists(FilePath As String) As Boolean
    ' Controleer of het bestand bestaat
    FileExists = Dir(FilePath) <> ""
End Function

 

[AD1957]

Probeer het eens zo, na afdrukken/opslaan factuurnummer met 1 ophogen.
Dan heb je de controle niet nodig.

Sub OpslaanPrinten()
 Dim FacName As String, pad As String

 FacName = "Factuur " & Sheets("Factuur maken").Range("D5")
 pad = Sheets("instellingen").Range("AD3")

 With Sheets("Factuur maken")
    .Range("B2:F16").ExportAsFixedFormat 0, pad & "\" & FacName
    .Range("B2:F16").PrintPreview         ' PrintOut
    .Range("D5") = .Range("D5") + 1       'na opslaan en printen factuurnummer met 1 ophogen
 End With
End Sub

 

[HoeveWatersnoodt]

Bedankt beide, zeer nuttige aanvullingen. Ik ben hiermee goed geholpen.