• 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 het plotten per A4

Status
Niet open voor verdere reacties.
E

Eelkovdm

Gebruiker
Lid geworden
3 sep 2020
Berichten
5
Hallo, beste helpers.

Ik heb een excel blad welke op basis van een aantal tabellen 100 plus grafieken onder elkaar aanmaakt.
Ik heb het zo ingericht dat er 1 grafiek per A4 uit komt maar hij print het hele blad in 1pdf met meerder pagina's.

Is het ook mogelijk om per grafiek 1 pdf te krijgen, en dan als bestandsnaam de eerste cel van de A4.

Bovenstaande wou ik graag in een vba macro zetten.

Ik heb al even rond gekeken maar ik zie alleen maar opties om verschillende tabbladen stuk voor stuk te printen.
 
Eelkovdm zei:
Hallo, beste helpers.

....

Ik heb al even rond gekeken maar ik zie alleen maar opties om verschillende tabbladen stuk voor stuk te printen.
Klik om te vergroten...

Is de oplossing dan niet om per tabblad één grafiek te plaatsen?

Of, anders gezegd, voor elke grafiek een eigen tabblad te voorzien?
 
Dat zou kunnen maar dan zou ik wel erg veel tabbladen krijgen en dan ben ik bang dat het dan erg traag word of niet wil.
 
er van uitgaande dat iedere grafiek even groot is, anders moet er even gekeken worden naar width en height

Kleine aanpassing, je wilde nog de 1e cel van je A4
Code: 
               .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & "grafiek_" & [COLOR="#FF0000"]c.Address[/COLOR] & ".pdf", OpenAfterPublish:=False   'naar pdf
 

Bijlagen

  • grafeken.xlsm
    35,6 KB · Weergaven: 27
Laatst bewerkt:
Of je plaatst pagina-einden bij ongelijke grootte van de grafieken cq. bereikreeks.

Code: 
Sub hsv()
Dim i As Long, ber As Range
For i = 1 To ActiveSheet.HPageBreaks.Count + 1
    If i = 1 Then
      Set ber = Range("a1").Resize(ActiveSheet.HPageBreaks(i).Location.Row - 1)
    Else
      Set ber = Range(ActiveSheet.HPageBreaks(i - 1).Location.Address).Resize(ActiveSheet.HPageBreaks(i - 1).Location.Row + 2)
     End If
ber.ExportAsFixedFormat 0, "c:\temp\pdf" & i & ".pdf"
Next
End Sub
 
Bedankt

De Hsv versie komt in de buurt van wat het idee is,

in een test document met 3 grafieken krijg ik 3 pdf's.
Echter print hij alleen de eerste kolom.
En zie ik niet hoe ik een bestandsnaam op basis van een cel waarde zou kunnen doen.

het te plotten bereik is altijd
1 tot 33 en A tot N
links boven altijd de grafiek naam A1 en A34 etc.
 
Breid de resize uit met 14.
 
Hier schiet direct mijn basis kennis van macro's tekort.
Ik heb in de voorbeeld macro de dikgedrukte getallen veranderd in 14 zonder succes, wat mis ik.

Sub hsv()
Dim i As Long, ber As Range
For i = 1 To ActiveSheet.HPageBreaks.Count + 1
If i = 1 Then
Set ber = Range("a1").Resize(ActiveSheet.HPageBreaks(i).Location.Row - 1)
Else
Set ber = Range(ActiveSheet.HPageBreaks(i - 1).Location.Address).Resize(ActiveSheet.HPageBreaks(i - 1).Location.Row + 1)
End If
ber.ExportAsFixedFormat 0, "c:\temp" & i & ".pdf"
Next
End Sub
 
Code: 
Sub hsv()
Dim i As Long, ber As Range
with activesheet
For i = 1 To .HPageBreaks.Count + 1
    If i = 1 Then
      Set ber = Range("a1").Resize(.HPageBreaks(i).Location.Row - 1[COLOR=#ff0000][SIZE=4],14[/SIZE][/COLOR])
    Else
      Set ber = Range(.HPageBreaks(i - 1).Location.Address).Resize(.HPageBreaks(i - 1).Location.Row + 2[COLOR=#ff0000][SIZE=4],14[/SIZE][/COLOR])
     End If
ber.ExportAsFixedFormat 0, "c:\temp\pdf" & i & ".pdf"
Next
end with
End Sub
 
Ah nu snap ik wat je bedoelde met bereik,

Is er ook een optie om een cellwaarde te gebruiken als bestandsnaam voor al de bladen?
Ik kan, of in de eerste Cell van iederblad een waarde zetten die ik als bestandsnaam wil hebben , of in een ander tabblad een lijst met namen hebben die dan gebruikt kan worden voor de naam

Namen zullen niet altijd logisch opvolgend zijn.
 
Namen staan in Blad1 kolom "L" beginnend in de eerste rij.
Code: 
Sub Misschien()
Dim shp As Shape, i As Long
i = 1
Application.ScreenUpdating = False
For Each shp In Sheets("Blad1").Shapes
If Left(shp.Name, 7) = "Grafiek" Then
With Sheets("Blad1").Range(shp.TopLeftCell.Address & ":" & shp.BottomRightCell.Address)
    .PrintOut , , , , , True, , "C:\Folder Naam Hier\" & Sheets("Blad1").Range("L" & i).Value & ".PDF"
End With
i = i + 1
End If
Next shp
Application.ScreenUpdating = True
End Sub
 
zou dit niet voldoende zijn als alle bereiken toch even groot zijn.
 

Bijlagen

  • veel pdf's opslaan..xlsm
    18,2 KB · Weergaven: 22
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan