• 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.

PDF Print geavanceerd

Status
Niet open voor verdere reacties.
M

miso1995

Gebruiker
Lid geworden
25 mei 2018
Berichten
87
Beste,

Ik heb een werkboek in Excel met 3 bladen die afwijken en daarna 34 bladen die praktisch hetzelfde zijn (het gaat om checklisten).
Op Blad 3 is een inhoudsopgave die in eerste instantie zelf bepaalt welke bladen zichtbaar moeten zijn.
Iedere checklist heeft als eigenschap dat de titels worden herhaald, echter bij iedere checklist geldt, dat de laatste pagina een ondertekenpagina is. Daarvoor heb ik een nieuwe titelpagina gemaakt die ook steeds verborgen wordt. Beetje omslachtige procedure.
Nou is het gelukt om alle zichtbare werkbladen af te drukken naar pdf. Bij een afzonderlijke checklist heb ik een code die werkt, maar dan stuurt ie het direct naar de printer. Als ik daar een pdf printer aan zou hangen zou ik 100 keer apart een bestand moeten opslaan. Ik heb de codes gecombineerd, maar ik loop vast. Hier de code:
Code: 
Private Sub PrintWorkBook_Click()
Application.EnableEvents = False
Application.Run "UnhideAllChapters" 'Maakt alle bladen zichtbaar
Application.Run "UnhideSignPage" 'maakt de titel voor de laatste pagina zichtbaar op de betreffende bladen
Application.Run "HideNotApplicableChapters" 'verbergt de bladen die niet zichtbaar hadden moeten zijn
Dim myArray() As Integer, xPages As Long, xRG As Range
For Each ws In ActiveWorkbook.Worksheets
xPages = ws.PageSetup.Pages.Count
Set xRG = ws.Range("A1:H7")
On Error Resume Next
    If xPages > 0 Then
        With ws.PageSetup
            .CenterHorizontally = True
            .PrintTitleRows = xRG.AddressLocal
            ws.PrintOut from:=1, To:=xPages - 1 
            .CenterHorizontally = True
            .PrintTitleRows = ""
             ws.PrintOut from:=xPages, To:=xPages
        End With
    End If
    Next ws
    NameOfFile = Left(Sheets("Client information").Range("B3"), 8) & " - Checklist annual report 2019 " & Range("FollowUpNrWB").Value
    If Len(Dir("C:\Temp", vbDirectory)) = 0 Then
    MkDir "C:\Temp"
    End If
    PathOnly = "C:\Temp\"
    Path = PathOnly & NameOfFile
Dim i As Integer
Dim j As Integer
j = 0
For i = 1 To Sheets.Count
    If Sheets(i).Visible = True Then
        ReDim Preserve myArray(j)
        myArray(j) = i
        j = j + 1
    End If
Next i
Sheets(myArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "C:\temp\test.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, OpenAfterPublish:=True
Application.Run "UnhideAllChapters" 'maakt alles weer zichtbaar
Application.Run "HideSignPage" 'verbergt de titelpagina voor de laatste pagina van dat betreffende blad
Application.Run "HideNotApplicableChapters" 'verbergt weer alle paginas die niet van toepassing zijn
Application.EnableEvents = True
Sheets("Client information").Range("A1").Select
If Range("FollowUpNrWB").Value = 10 Then
    Range("FollowUpNrWB").Value = 0
Else: Range("FollowUpNrWB").Value = Range("FollowUpNrWB").Value + 1
End If
End Sub

Alvast bedankt voor degene die hier een oplossing voor heeft,
Bovenstaande code geeft geen foutmeldingen. Hij is er slechts erg lang mee bezig.

Groet,
Miso
 
Laatst bewerkt:
Met een (anoniem) voorbeeldbestandje wordt je sneller en beter geholpen.
 
Bovenstaande code geeft geen foutmeldingen. Hij is er slechts erg lang mee bezig.
Klik om te vergroten...
Hoe weet je wie er verantwoordelijk is voor het meeste tijdsconsumptie, is het die export naar pdf of de voorbereiding
kijk anders eens naar enkele tussentijden.
Waarom tussendoor ook nog eea naar de printer sturen, waarom de pagesetup nog aanpassen, ... ?
Code: 
Private Sub PrintWorkBook_Click()
  [COLOR="#FF0000"] t0 = Timer[/COLOR]
   Application.EnableEvents = False
   Application.Run "UnhideAllChapters"           'Maakt alle bladen zichtbaar
   Application.Run "UnhideSignPage"              'maakt de titel voor de laatste pagina zichtbaar op de betreffende bladen
   Application.Run "HideNotApplicableChapters"   'verbergt de bladen die niet zichtbaar hadden moeten zijn
   Dim myArray() As Integer, xPages As Long, xRG As Range
   For Each ws In ActiveWorkbook.Worksheets
      xPages = ws.PageSetup.Pages.Count
      Set xRG = ws.Range("A1:H7")
      On Error Resume Next
      If xPages > 0 Then
         With ws.PageSetup
            .CenterHorizontally = True
            .PrintTitleRows = xRG.AddressLocal
            ws.PrintOut from:=1, To:=xPages - 1
            .CenterHorizontally = True
            .PrintTitleRows = ""
            ws.PrintOut from:=xPages, To:=xPages
         End With
      End If
   Next ws
   NameOfFile = Left(Sheets("Client information").Range("B3"), 8) & " - Checklist annual report 2019 " & Range("FollowUpNrWB").Value
   If Len(Dir("C:\Temp", vbDirectory)) = 0 Then
      MkDir "C:\Temp"
   End If
   PathOnly = "C:\Temp\"
   Path = PathOnly & NameOfFile
   Dim i       As Integer
   Dim j       As Integer
   j = 0
   For i = 1 To Sheets.Count
      If Sheets(i).Visible = True Then
         ReDim Preserve myArray(j)
         myArray(j) = i
         j = j + 1
      End If
   Next i
   
  [COLOR="#FF0000"] t1 = Timer[/COLOR]
   
   Sheets(myArray).Select
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                   "C:\temp\test.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, OpenAfterPublish:=True
   
  [COLOR="#FF0000"] t2 = Timer[/COLOR]
   
   Application.Run "UnhideAllChapters"           'maakt alles weer zichtbaar
   Application.Run "HideSignPage"                'verbergt de titelpagina voor de laatste pagina van dat betreffende blad
   Application.Run "HideNotApplicableChapters"   'verbergt weer alle paginas die niet van toepassing zijn
   Application.EnableEvents = True
   Sheets("Client information").Range("A1").Select
   If Range("FollowUpNrWB").Value = 10 Then
      Range("FollowUpNrWB").Value = 0
   Else: Range("FollowUpNrWB").Value = Range("FollowUpNrWB").Value + 1
   End If
   
   [COLOR="#FF0000"]t3 = Timer[/COLOR]
   
 [COLOR="#FF0000"]  MsgBox "t1-t0 : " & t1 - t0 & vbLf & "t2-t1 : " & t2 - t1 & vbLf & "t3-t2 : " & t3 - t2
[/COLOR]End Sub
Als t2-t1 met het leeuwenaandeel wegloopt, dan is er niet veel kans op verbetering, misschien enkel die openafterpublish.
 
Laatst bewerkt:
Waarom al die Application.Run opdrachten voor macro's in hetzelfde document?
 
De application.run opdrachten heb ik erin gezet, omdat ik meerdere knoppen heb en afhankelijk van de positie gelden er andere voorwaarden voordat ie de handelingen gaat doen die in de application.Run staan
Maar als ik de macro aanpas, dan hoef ik het maar 1 keer aan te passen, in plaats van meerdere keren.

Een voorbeeldbestand maken kost ongelooflijk veel tijd voor deze specifieke casus. Maar ik denk dat ik de alternatieve kop weg haal, dan accepteer ik wel, dat de kop overal te zien is, want dan kunnen er een aantal application.runs weg.

Waar ik eigenlijk het meeste tegen aanloop, is het begrijpen en combineren van arrays. Ik heb al vaker oplossingen gevraagd, waarbij ik een array constructie terugkreeg. Mij viel het op, dat die constructies, een hele hoop code kunnen schelen, maar dat het tegelijkertijd vaak veel sneller is.

Probleem is dat ik moeite heb met het interpreteren van wat die arrays doen. En dan ook het reproduceren ervan is dan vervolgens een uitdaging.
Ik heb verschillende instructies gelezen, maar het blijft helaas niet echt hangen.

Aangezien het oorspronkelijke topic ging over het pdf printen en ik ermee kan leven dat het iets minder mooi wordt, kan wat mij betreft dit topic dicht en als opgelost worden gemarkeerd.

Als iemand die mij op weg kan helpen met het leren gebruiken van arrays op een creatieve wijze, dan houd ik mij aanbevolen.
 
ik had toch graag een terugkoppeling gezien.
Wat waren de waarden t1-t0, t2-t1 en t3-t2 ?
Woog t2-t1 zwaar door ?
 
tenzij je natuurlijk dit draadje wil beëindigen, als je REM plaats voor de 2 lijnen met Printout
Code: 
           .PrintTitleRows = xRG.AddressLocal
Rem            ws.PrintOut from:=1, To:=xPages - 1
            .CenterHorizontally = True
            .PrintTitleRows = ""
Rem            ws.PrintOut from:=xPages, To:=xPages
Hoeveel zakt die 1e tijd (166") dan ?
Je hebt dan geen uitvoer naar je printer, vermoedelijk remt die de boel af.
 
1e tijd zakt dan naar 28 seconden.
Maar wat ik eigenlijk wilde doen, dat van elke sheet, de eerste 7 regels als titel voor elke pagina komt, behalve op de laatste pagina van die sheet.
Dat werkt dus helaas niet.
Alhoewel het wel in de output van de fysieke printer goed gaat, wordt bij de export naar pdf die regel ongedaan gemaakt en komt er helemaal geen titel tevoorschijn bij de tweede en derde pagina.

Heb je een idee hoe ik dat naar pdf zou kunnen krijgen?
 
Je krijgt betere PDF's met:

Code: 
Sub M_snb()
  For Each it In Sheets
    it.ExportAsFixedFormat 0, "G:\OF\" & it.codename & ".pdf"
  Next
End Sub
 
ik zou
- een tijdelijke directory aanmaken
- daar zou ik achtereenvolgens de verschillende pdf's naar toe schrijven, met de vooraf aangepaste headers en footers (een beetje zoals SNB #10)
- daarna zou ik ofwel al die files handmatig samenvoegen (merge) door gebruik te maken van bv. PDFtk free (https://en.freedownloadmanager.org/Windows-PC/PDFtk-The-PDF-Toolkit.html ) ofwel daar online laten uitvoeren.
Er bestaan ook opties om via VBA samen te voegen, maar dat heb ik nog nooit gedaan. Als je Acrobat hebt zou dat bv. gemakkelijk lukken.
Het is natuurlijk te zien of dit een éénmalige actie is ofwel een dagelijkse oefening.
 
Een voorbeeldbestand maken kost ongelooflijk veel tijd voor deze specifieke casus.
Klik om te vergroten...

Heen en weer blijven gokken nog veel meer.
Maar als het niet de moeite waard is, is het niet de moeite waard.
 
nog een aanvulling, ik ben totaal niet thuis in VBA voor Word, maar anderen hier wel.
- Vertrekkend van mijn aanname 2 reacties geleden, een aparte tijdelijke directory met daarin de pdf's in de volgorde zoals je die wil samenvoegen en die noem je pdf001.pdf tot pdf099.pdf
- met een macro in Word open je nu 1 na 1 al die pdf's in 1 Word-dokument.
- daarna sla je die op als pdf,
- klaar.
Is dit te voorbarig/lichtzinnig denken ?
 
.PageSetup is supertraag.
ExecuteExcel4Macro ("PAGE.SETUP is sneller.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan