• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro voor afdrukbereik verschillende werkbladen

Status
Niet open voor verdere reacties.
K

Knollo

Gebruiker
Lid geworden
26 nov 2017
Berichten
31
Ik wil graag één macro maken waarin ik van een aantal werkbladen telkens het afdrukbereik (A1:p83) afdruk als PDF. Hierbij moet ik dus ook een printer selecteren, die staat in mijn printerlijst als "Microsoft Print to PDF".
Ik heb dus 13 werkbladen in mijn werkmap, en deze macro moet van alle werkbladen het afdrukbereik A1:p83 bepalen en dit vervolgens printen als PDF, met een geselecteerde printer, maar ook met de instelling "kolommen passend maken voor paginabreedte".
Hoe zou ik zoiets in een macro kunnen zetten??
Dank U.
 
Knollo,

neem de acties eens op met de macrorecorder, dan heb je een begin dat je in een lus kunt zetten..

En kijk dan eens goed naar de oplossing die @Cobbe je in je andere vraag gegeven heeft.
 
Laatst bewerkt:
Geachte,
Gij schat mij te hoog in. Dank voor het compliment, maar zoiets lukt mij niet. Ik ben maar een beginner.
Als ik een macro opneem, krijg ik dit:

Code: 
Sub Macro3()
'
' Macro3 Macro
'

'
    Range("A1:P83").Select
    Selection.PrintOut Copies:=1, Collate:=True
    Range("A1").Select
End Sub
Ik zie daar niet in terug dat ik de printerkeuze heb veranderd, noch dat ik "alle kolommen passend maken voor één pagina" heb ingesteld. Dus met deze opname kom ik niet veel verder. Dan kan ik net zo goed op de knop "snel afdrukken" drukken.

Ik begrijp de "lus" in de oplossing van @Cobbe, maar daar kan ik enkel mee verder als mijn tussenstuk klopt.

Hoe kan ik een printerkeuze en het "passend maken" in de macro formuleren?

Dank.
 
Hoi knollo,
test deze eens:
pdfs worden opgeslagen in de folder waar je excelbestand zich bevindt. worden opgeslagen met de tabbladnaam en datum van vandaag.
Code: 
Sub dotchie()
Dim WS_Count As Integer, I As Integer
Dim Name As String
Application.ScreenUpdating = False
    WS_Count = ThisWorkbook.Worksheets.Count
    For I = 1 To WS_Count
     Name = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets(I).Name & " " & _
     Format(Now(), "dd.mm.yyyy") & ".pdf"
        With Worksheets(I)
            .PageSetup.PrintArea = "$A$1:$P$83"
            .PageSetup.FitToPagesWide = 1
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
             Quality:=xlQualityStandard, IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, OpenAfterPublish:=False
         End With
    Next I
Application.ScreenUpdating = True
End Sub
 
Dank U zeer, gast0660. Dit is zeer bruikbaar. Indrukwekkend. Ik heb de code zitten lezen en opsplitsen hoe het werkt. Ik begrijp het nu, maar ik zou het zelf niet kunnen. Compliment. Hartelijk dank.

Bij het uitvoeren van de code, maakt hij inderdaad PDF's met datum van vandaag (wist niet dat dit zo kon zonder selecteren van printer!). Maar daarna geeft hij deze foutmelding:

Code: 
Fout 5 tijdens uitvoering:
Ongeldige procedure-aanroep of ongeldig argument.

Hij blijft dan hangen bij deze regel:

Code: 
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
             Quality:=xlQualityStandard, IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, OpenAfterPublish:=False

Uw code werkt dus perfect, maar na het aanmaken van alle PDF's krijg ik dus bovenstaande foutmelding.

Alvast super bedankt, deze code helpt mij enorm op weg. Ik ben onder de indruk van de kennis van alle Excel-kenners op dit forum. Excellent.
 
Laatst bewerkt:
Nog een vraag:

Ik heb eerder van @VenA en @HSV een formule ontvangen waarmee ik in code kan bepalen waar de laatste ingevulde regel zich bevindt:

Code: 
  Rows(Cells(Rows.Count, 4).End(xlUp).Row).Select

Die gebruik ik nu in heel veel codes. Het werkt perfect. Ik ben daar zeer verheugd over.

Nu zou ik graag in de code van gast0660 het afdrukbereik "$A$1:$P$83" willen vervangen door het bereik eindigend met de laatste volle regel. Dus de waarde "83" moet bepaald worden door Rows(cells(Rows.Count, 4),End(xlUp).Row).Select. Hoe zou ik dat in deze code kunnen aanpassen?
 
Werk je nog met Excel 2003 of ouder?
 
Mijn computer heeft Microsoft Office 365.
Microsoft Excel 2013 (15.0....) 32-bits
Onderdeel van Microsoft Office 365

Zegt dat u genoeg?
 
Zit daar geen opslaan.als PDF in?
 
Inderdaad. Dat is mogelijk. Zie ik nu pas.
Met de code van gast0660 kan ik echter alle tabbladen achter elkaar automatisch opslaan als PDF. Daar was ik naar op zoek.
Ook wil ik nog de afdrukselectie afstemmen op de laatst ingevulde regel, indien mogelijk met " Rows(Cells(Rows.Count, 4).End(xlUp).Row).Select"
Verder kan ik nog niet verklaren waarom na afloop daarvan bovenstaande foutmelding zich voordoet.
 
Heb je het bestand wel opgeslagen?


@dotchie moet ook geen variabelen gebruiken die al zijn vergeven aan leden.
Mijn suggestie:
Code: 
Sub hsv()
Dim sh As Worksheet
Dim Naam As String
Application.ScreenUpdating = False
   For Each sh In Sheets
     Naam = ThisWorkbook.Path & "\" & sh.Name & " " & _
     Format(Date, "dd.mm.yyyy")
        With sh
            .PageSetup.PrintArea = Range("A1", Cells(Rows.Count, 16).End(xlUp)).Address
            .PageSetup.FitToPagesWide = 1
            .ExportAsFixedFormat 0, Naam
         End With
    Next sh
End Sub
Of zonder de variabele naam.
Code: 
Sub hsv()
Dim sh As Worksheet
Application.ScreenUpdating = False
   For Each sh In Sheets
        With sh
            .PageSetup.PrintArea = Range("A1", Cells(Rows.Count, 16).End(xlUp)).Address
            .PageSetup.FitToPagesWide = 1
            .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & sh.Name & " " & Format(Date, "dd.mm.yyyy")
         End With
    Next sh
End Sub
Of:
Code: 
Sub hsv()
Dim sh As Worksheet
Application.ScreenUpdating = False
   For Each sh In Sheets
        With sh
            .PageSetup.FitToPagesWide = 1
            .Range("A1", .Cells(Rows.Count, 16).End(xlUp)).ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & sh.Name & " " & _
     Format(Date, "dd.mm.yyyy")
         End With
    Next sh
End Sub
 
Laatst bewerkt:
HSV, hartelijk dank.

Bij uw eerste code kreeg ik de volgende foutmelding:
"Fout 13 tijdens uitvoering: Typen komen niet met elkaar overeen"
De code blijft hangen bij deze regel: "Next sh"

Nu heb ik eerder een code gekregen van VenA en toegepast waar ook al Sh As Worksheet gebruikt wordt. Wellicht was dat het probleem?
Ik heb in deze code dus "sh" vervangen door "sht" en opnieuw gerund.

Dan krijg ik de foutmelding "Fout 424 tijdens uitvoering: Object vereist"
De code blijft nu hangen bij deze regel: ".PageSetup.PrintArea = Range("A1", Cells(Rows.Count, 16).End(xlUp)).Address"

Wat doe ik hier fout?
 
Je hebt van meerdere codes een code gemaakt?
Gebruik alleen de laatste eens.
 
Probeer deze
Het is natuurlijk beter om de oorzaak van de foutmeldingen te achterhalen.
Code: 
Sub dotchie()
Dim WS_Count As Integer, I As Integer
Dim Name As String
Dim LRow As Long
Application.ScreenUpdating = False
On Error GoTo Oops
LRow = Cells(Rows.Count, 1).End(xlUp).Row
    WS_Count = ThisWorkbook.Worksheets.Count
    For I = 1 To WS_Count
     Name = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets(I).Name & " " & _
     Format(Now(), "dd.mm.yyyy") & ".pdf"
        With Worksheets(I)
            .PageSetup.PrintArea = "A1:P" & LRow
            .PageSetup.FitToPagesWide = 1
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
             Quality:=xlQualityStandard, IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, OpenAfterPublish:=False
         End With
    Next I
Oops:
Application.ScreenUpdating = True
End Sub
@HSV, ik weet het, ik moet er eens werk van maken:confused:
@dotchie moet ook geen variabelen gebruiken die al zijn vergeven aan leden.
Klik om te vergroten...
 
Code: 
On Error GoTo Oops
Gaat je toch niet redden?

@HSV, ik weet het, ik moet er eens werk van maken:confused:
Klik om te vergroten...
Waarom niet vanaf nu starten.
 
Laatst bewerkt:
Hoe bedoelt ge, "van meerdere codes een code gemaakt"?
Ik heb uw code letterlijk gekopieerd als aparte Sub. Wel heb ik ook nog andere subs waar dezelfde "Sh" in genoemd wordt.
Als ik uw laatste code gebruik, krijg ik dezelfde foutmelding "typen komen niet met elkaar overeen" bij regel "next sh"
Als ik de "sh" vervang door een ander woord, blijft dezelfde fout:
Code: 
Sub hsv()
Dim bam As Worksheet
Application.ScreenUpdating = False
   For Each bam In Sheets
        With bam
            .PageSetup.FitToPagesWide = 1
            .Range("A1", .Cells(Rows.Count, 16).End(xlUp)).ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & bam.Name & " " & _
     Format(Date, "dd.mm.yyyy")
         End With
    Next bam
End Sub

Excuseer voor mijn onbegrip, wellicht maak ik hier ergens een domme fout. Ik kan de foutmelding niet bevatten.
 
Laat maar,
Maakt niet uit hoe de variabele heet, Jan, Piet of sh.
Heb je het bestand opgeslagen waarin de code staat.
Dit vroeg ik al eens, maar geen reactie op gekregen.
 
Laatst bewerkt:
gast0660, uw code werkt uitstekend. Net zoals aanvankelijk, alleen nu zonder de foutmelding. Ik ben hier zeer content mee!

HSV en gast0660, ik wil u beiden hartelijk danken voor deze bijdrage. Voor mij is de vraag opgelost. Ik hoop dat anderen hier ook plezier van kunnen hebben. Nogmaals hartelijk dank! Ik ga de vraag als "opgelost" markeren.

Maar toch blijf ik gefascineerd door de vraag wat ik hierboven fout heb gedaan? De codes van HSV moeten kloppen, waarom werkten ze bij mij niet? Waar zit mijn fout?
 
HSV, volgens mij had ik het bestand wel opgeslagen. Maar ik ga het opnieuw proberen.
 
Die code van @gast0660 onderdrukt alleen de foutmelding.
Er zal geen pdf aangemaakt worden.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan