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

meerdere pagina's naar PDF

Status
Niet open voor verdere reacties.
Thankyou

Thankyou

Terugkerende gebruiker
Lid geworden
3 mei 2009
Berichten
1.737
Beste,

In het bijgevoegde voorbeeld bestand staan 2 bladen (DATA en GRAFIIEK). Alles werkt maar ik wil iets anders en dat krijg ik niet voor elkaar.

Het gaat om het blad GRAFIEK. Hier zit een combobox in die de grafiek laat veranderen en een knop om de grafiek als PDF op te slaan. Nu heb ik het zo voor elkaar dat met die ene knop alle grafieken elk naar een eigen PDF-bestand (landscape) opslaat, met om een een of andere reden nog een 2e leeg blad erbij.

Wat ik graag zou willen: Alle grafieken in 1 PDF bestand opgeslagen, op de volgorde zoals de combobox aangeeft en zonder een leeg blad erbij/er tussen. Het bestand hier is een voorbeeld bestand en het stuk vba moet dus nog naar het werkelijke bestand en de tabblad namen moeten nog aangepast worden.

Wie kan dit voor elkaar krijgen?

Groet,
 

Bijlagen

  • Test-PDF(T1).xlsm
    27,6 KB · Weergaven: 43
Alle grafieken naar 1 pdf kun je doen door een nieuw workbook Temp aan te maken, en aan het eind van je for/next het bijgewerkte sheet naar Temp te kopieren. Na de for/next selecteer je alle sheets in Temp (sheets.select) en print dit naar pdf. Het is verstandig om op het te kopieren sheet geen controls te hebben.
De extra pagina: het afdrukvoorbeeld is helaas niet altijd gelijk aan de pdf-export. Stel om te beginnen je Afdrukbereik goed in en probeer het eens met Fit 1:1. Daarna nog even verder experimenteren.
 
Pixcel, bedankt voor je input.

Ik ga eens kijken of ik als beginnend vba-er hier iets mee kan, mocht dat niet lukken meld ik me.
De topic laat ik nog even open staan - wie weet . . . .

groet,

P.S.
Volgens mij moet het dan ook met een tijdelijk extra tabblad kunnen, dat zal ik eerst eens proberen.
 
Laatst bewerkt:
Beste,

Na een tip van Pixcel ben ik nu bezig om alle grafieken in 1 blad te zetten.

Dit werkt, maar met een fout. De waarden die veranderen op het blad GRAFIEK worden goed over gezet naar het nieuw aangemaakte tabblad GRAFIEKEN. De grafieken zelf echter, daar is nog een leuke uitdaging mee - alle grafieken zijn nu plots exact gelijk, wat natuurlijk niet klopt. Bij het wegschrijven naar afzonderlijke PDF files ging dit wel goed en klopte de grafieken met de bijbehorende gegevens. Waarom gaat dit niet en wat is hier de oplossing voor?

In het bijgevoegde bestand de VBA code en al de aangemaakte sheet GRAFIEKEN met het probleem. Ik werk met excel 2007.

Groet,
 

Bijlagen

  • Test-PDF(T1).xlsm
    48,9 KB · Weergaven: 36
De bereiken van je grafieken blijven verwijzen naar de oude instelling.
Met de onderstaande macro worden deze aangepast. Je hoeft alleen het rode gedeelte toe te voegen.
Ik heb alleen de goto's weggehaald en de controle of de map bestaat uit de loop gehaald want mijn inziens
hoeft deze geen 14 keer gecontroleerd te worden.

Niels


Code: 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For sh = Sheets.Count To 1 Step -1
If Sheets(sh).Name = "Grafieken" Then Sheets(sh).Delete
Next
Application.DisplayAlerts = True
            
            Sheets.Add: ActiveSheet.Name = "Grafieken"
                With Sheets("Grafieken")
                    .Range("B1:AF1").ColumnWidth = 3
                    .Range("A1").ColumnWidth = 6.57
                    .PageSetup.Orientation = xlLandscape
                    
                End With

    Sheets("Grafiek").Range("A32").Value = Format(Date, "DD-MM-YY")
    
Set fs = CreateObject("Scripting.FileSystemObject")
Location = ActiveWorkbook.Path
loc2 = Location & "\" & Format(Date, "YYYY-MM-DD") & " Thanks"
bestandGF = loc2 & "\" & Format(Date, "YYYY-MM-DD") & " " & ActiveSheet.Name & " " & ".pdf"
If Not fs.folderexists(loc2) Then
MkDir (loc2)
End If
If Dir(bestandGF) <> "" Then
Kill bestandGF
End If
   
    For i = 6 To 19
    
            j = Sheets("Data").Range("A" & i).Value
            ComboBox1.Value = j
            

                    Dim lRow As Long
                        lRow = Sheets("Grafieken").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
                            Sheets("Grafiek").Range("A1:AF33").Copy Sheets("Grafieken").Range("A" & lRow)
                            
                                [COLOR="#FF0000"]ActiveSheet.ChartObjects("Grafiek " & i - 5).Activate
                                ActiveChart.SeriesCollection(1).Name = "='Grafieken'!C" & (i - 6) * 32 + 6 & ":V" & (i - 6) * 32 + 6
                                ActiveChart.SeriesCollection(1).Values = "='Grafieken'!C" & (i - 6) * 32 + 6 & ":V" & (i - 6) * 32 + 6[/COLOR]                            
                            
Application.ScreenUpdating = True
            'Range("A1:AF32").ExportAsFixedFormat Type:=xlTypePDF, Filename:=bestandGF  '( Dit werkkt goed maar schrijft naar aparte PDF files weg )
            
    Next i

End Sub


PS als je onderstaande code toepast wordt het bestand een stuk sneller

Code: 
Private Sub ComboBox1_Change()
    
    Dim code As Long
        On Error Resume Next
            code = Worksheets("Data").Range("A6:A19").Find(Sheets("Grafiek").ComboBox1.Value, LookIn:=xlValues, Lookat:=xlWhole).Row

                    Cells(5, 1).Resize(1, 22).Value = Sheets("Data").Cells(code, 1).Resize(1, 22).Value

    
End Sub
 
Laatst bewerkt:
Antwoord op je eventuele volgende vraag,

Voeg deze onderaan het rode stukje toe.
Code: 
ActiveChart.ChartTitle.Text = Sheets("Grafieken").Range("A" & (i - 6) * 32 + 6)

Niels
 
Niels,

Bedankt, in het voorbeeld bestand loopt het als een tierelier.
Vanavond in wet werkelijke bestand toevoegen, daarna zorgen dat elke grafiek met zijn bijbehorende gegevens op een aparte pagina komen te staan en ben ik klaar.
Als alles werkt zal ik de topic op opgelost zetten.

Nogmaals hartelijk dank, zowel Pixcel voor zijn idee als Niels28 voor de aanpassing van de code.
 
Had je de PS en mijn 2de berichtje ook gezien?

Niels
 
Niels,

1. Het 2e stukje uit #5 : Is dit een extra stuk wat bovenaan de code erbij komt ?
2. Het stukje uit #6 : Voegt het nummer toe aan de grafiek - wederom Dank.

Groet,
 
Je hebt in je voorbeeld een macro staan met de naam "Private Sub ComboBox1_Change()"
Vervang deze door die uit deel 2 van #5

Niels
 
Pixcel en Niels hartelijk dank voor de input.

Had even wat moeite om de code van Niels aan te passen naar het werkelijke bestend maar dat is gelukt.

Nogmaals bedankt,
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan