Printmarge instellen in bestaande VBA code

[Bruggemanmark]

Hallo Allemaal,

Heb een mooie code welke goed werkt van dit forum gehaald, alleen als deze een pdf maakt kan ik niet een marge instellen van het bereik wat hij moet afdrukken.
Hij moet zeg maar, maar 1 A4 afdrukken.

Dit is de code. Heb ook een code voor apart PDF maken alleen dan wordt deze niet automatisch verzonden en dat vindt ik wel makkelijk

Sub sendpdf()

Dim mailtext As String, bestand$, adres$, onderwerp$

'Hieronder staan een paar regels met gegevens die je mag invullen voor het aanmaken van de PDF.
'en het verzenden van de e-mail. Groene regels als deze zijn commentaar, en worden door het
'programma niet gebruikt'

'Plaats  en naam van het tijdelijke PDF bestand

bestand$ = "e:\bestandsnaam.pdf"

'Hieronder vul je het onderwerp in. De " aan het begin en het einde moeten blijven staan

onderwerp$ = "Versturen mail"

'De regel hieronder vul je het adres in van de ontvanger. De " aan het begin en het einde moeten blijven staan.

adres$ = "test@domein.nl"

'Hieronder vul je de standaard mail in: De " aan het begin en het einde moeten blijven staan.
'Extra regels kan je toevoegen door een regel te kopieren.

mailtext = "aanhef "
mailtext = mailtext + vbNewLine + ""                        '<====  geen tekst geeft een lege regel.
mailtext = mailtext + vbNewLine + "Dit is de eerste regel"
mailtext = mailtext + vbNewLine + "Dit de tweede. "
mailtext = mailtext + vbNewLine + ""
mailtext = mailtext + vbNewLine + "Met vriendelijke groeten, "
mailtext = mailtext + vbNewLine + "Marc H."

' Hieronder geen wijzigingen aanbrengen


resultaat = RDB_Create_PDF(ActiveWorkbook, bestand$, True, False)
If resultaat <> "" Then
    RDB_Mail_PDF_Outlook bestand$, adres$, onderwerp$, mailtext, True
Else
    MsgBox "Er is iets fout gegaan bij het aanmaken van de PDF, mail is niet verzonden.", vbCritical
End If
End Sub
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrSubject As String, StrBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = StrTo
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function


Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                 OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant

    'Test to see if the Microsoft Create/Send add-in is installed.
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                  Title:="Create PDF")

            'If you cancel this dialog, exit the function.
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        'If OverwriteIfFileExist = False then test to see if the PDF
        'already exists in the folder and exit the function if it does.
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        'Now export the PDF file.
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0

        'If the export is successful, return the file name.
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function

 

[gast0660]

Hoi,
Zoiets ?

Dim mailtext As String, bestand$, adres$, onderwerp$

'Hieronder staan een paar regels met gegevens die je mag invullen voor het aanmaken van de PDF.
'en het verzenden van de e-mail. Groene regels als deze zijn commentaar, en worden door het
'programma niet gebruikt'

'Plaats  en naam van het tijdelijke PDF bestand
[COLOR="#FF0000"]naam van uw werkblad.PageSetup.PaperSize = xlPaperA4[/COLOR] [COLOR="#008000"]'pas naam van uw werkblad aan[/COLOR]
bestand$ = "e:\bestandsnaam.pdf"

Groet

 

[Bruggemanmark]

Helaas werkt deze code niet, print nog steeds het volledige werkblad uit.

 

[gober]

kun je wat met onderstaande code?
PrintArea = "$B$7:$I$52" geeft aan welk gedeelte geprint wordt.
plaatst wel alles op 1 pagina

meerdere pagina's kun je als volgt doen(voorbeeld:
.PrintArea = _
"$B$7:$I$62,$B$64:$I$122,$B$124:$I$182,$B$184:$I$242,$B$244:$I$299,$B$301:$I$359,$B$361:$I$419,$B$421:$I$479,$B$481:$I$539,$B$541:$I$599"

With ActiveSheet.PageSetup
    .LeftMargin = Application.CentimetersToPoints(1.5)
    .RightMargin = Application.CentimetersToPoints(1)
    .TopMargin = Application.CentimetersToPoints(1.5)
    .BottomMargin = Application.CentimetersToPoints(0.5)
    .HeaderMargin = Application.CentimetersToPoints(0.2)
    .FooterMargin = Application.CentimetersToPoints(0.2)
    .CenterVertically = True
    .PaperSize = xlPaperA4
    .Orientation = xlPortrait 'xlLandscape
    
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
    .PrintArea = "$B$7:$I$52"
    
    End With