Herhalen van macro voor aantal velden

[MMarie]

Hulpvraag.

Ik heb een macro die bij het drukken op een knop op het 'Voorblad' ervoor zorgt dat een aantal tabbladen in dit bestand geprint worden naar PDF met een specifieke naam.
Op het tabblad 'Voorblad' is cel G3 elke keer te wijzigen met een specifiek nummer, waarna de gegevens in alle tabbladen wijzigen. op dit moment moet je handmatig de cel G3 invullen om de nieuwe gegevens op te halen en vervolgens te kunnen printen naar PDF via de macro.
Wat ik graag zou willen is dat je in een tabblad 'Input' onder elkaar de nummers in kolom A kunt zetten waarna je de bijgewerkte tabbladen van deze nummers kunt printen naar pdf.
Dus:
1. de macro moet kijken naar tabblad 'Input' cel A2,
2.dat nummer zetten in tabblad 'Voorblad' cel G3
3.vervolgens de onderstaande macro uitvoeren.
4.daarna cel A3 pakken en de cyclus herhalen. Als vervolgens de volgende cel niet meer gevuld is (dus bijv A30 is leeg) dan moet de macro stoppen.

Hoop dat ik een beetje duidelijk ben in mijn hulpvraag. Zit al een tijdje te prutsen maar kom er niet uit.


Sub PDF()
Sheets(Array("Voorblad", "M", "BN", "AS", "Bhr" _
)).Select
Sheets("Voorblad").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"K:\Algemeen" & "CBP " & Range("G3").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False
Sheets("Voorblad").Select
End Sub

 

[OctaFish]

Met een voorbeeldbestandje gaat het allemaal wat makkelijker, en als je de code tussen de CODE tags zet ([ CODE ] ervoor en [/CODE] erachter, zonder de spaties in de haken) dan is de macro ook een stuk leesbaarder . Want eerlijk gezegd snap ik de functie van die nummers niet.

 

[Haije]

Marie,

zou je voorbeeld excelbestand kunnen en willen posten?

 

[MMarie]

Marie,

zou je voorbeeld excelbestand kunnen en willen posten?

Is lastig, omdat er best veel data/informatie in zit (privacy). Bij het invullen van een nieuw nummer in cel G3 worden in de diverse tabbladen gegevens getoond die bij dat nummer horen. En dat pdf bestand is dan een soort naslagwerk.
Ik kijk even of ik m simpeler kan maken.

 

[OctaFish]

We zitten uiteraard niet te wachten op privacy gevoelige informatie . Het is al voldoende als er genoeg data in zit (tabbladen) om het principe te snappen.

 

[VenA]

Zoiets?

Sub PDF()
ar = Sheets("Input").Range("A2:A" & Sheets("Input").Cells(Rows.Count, 1).End(xlUp).Row)
Sheets(Array("Voorblad", "M", "BN", "AS", "Bhr")).Select
Sheets("Voorblad").Activate
For j = 1 To UBound(ar)
  Range("G3") = ar(j, 1)
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  "K:\Algemeen" & "CBP " & Range("G3").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False
Next j
End Sub

 

[MMarie]

Zoiets?

Sub PDF()
ar = Sheets("Input").Range("A2:A" & Sheets("Input").Cells(Rows.Count, 1).End(xlUp).Row)
Sheets(Array("Voorblad", "M", "BN", "AS", "Bhr")).Select
Sheets("Voorblad").Activate
For j = 1 To UBound(ar)
  Range("G3") = ar(j, 1)
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  "K:\Algemeen" & "CBP " & Range("G3").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False
Next j
End Sub

Top! Het werkt idd!
In het uiteindelijk bestand zit er nog wel een macro tussen. Na het invullen van het betreffende nummer in cel G3 op het voorblad, wordt er gezocht naar een foto in een bepaalde map. De juiste foto plaatst de macro vervolgens op het voorblad. Ik dacht dat dit automatisch zou gaan draaien in de nieuwe macro maar dat is niet zo. Dus blijkbaar moet in jouw code die andere macro ook nog toegevoegd worden. Ik ben er niet zodanig in thuis dat het me zelf lukt helaas. Heb er al aardig wat uurtjes inzitten :-( Heb jij nog een oplossing?

Option Explicit
Sub Foto()
 
    Dim Foto As String
    Dim myObj
    Dim Pictur
    Dim Pict As Shape
    
    Foto = "K:\Algemeen\foto's\" & Range("G3")
    
    If Dir(Foto) = "" Then
        MsgBox "Foto niet beschikbaar"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set myObj = ActiveSheet.DrawingObjects
    
    For Each Pictur In myObj
        If Left(Pictur.Name, 7) = "Picture" Then
            Pictur.Select
            Pictur.Delete
        End If
    Next
    
    Set Pict = ActiveSheet.Shapes.AddPicture(Foto, _
        msoTrue, msoFalse, 280, 150, -1, -1)
         Pict.Height = 365
        
    Application.ScreenUpdating = False
End Sub

 

[Haije]

Wellicht volstaat dit:

Sub PDF()
ar = Sheets("Input").Range("A2:A" & Sheets("Input").Cells(Rows.Count, 1).End(xlUp).Row)
Sheets(Array("Voorblad", "M", "BN", "AS", "Bhr")).Select
Sheets("Voorblad").Activate
For j = 1 To UBound(ar)
  Range("G3") = ar(j, 1)
[COLOR="#FF0000"]Call Foto[/COLOR]
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  "K:\Algemeen" & "CBP " & Range("G3").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
  :=False
Next j
End Sub

 

[MMarie]

@Haije ik krijg een foutmelding bij de regel: Pictur.Select

 

[VenA]

En als je die regel weglaat? Anders maar een bestandje plaatsen.

 

[MMarie]

Helaas, dan krijg ik weer een andere foutmelding. Bij deze het bestand, ik heb m wel bijna helemaal leeggetrokken, dus hoop dat ie nog voldoende werkt.

 

[VenA]

Werkt bij mij gewoon.

Sub VenA()
  For Each it In ActiveSheet.DrawingObjects
    If Left(it.Name, 7) = "Picture" Then it.Delete
  Next it
End Sub

 

[MMarie]

Ik blijf puzzelen en zal ongetwijfeld iets niet goed doen. Kun jij je bestand met mij delen?

 

[VenA]

Daar staat geen plaatje meer in. Net als in jouw voorbeeld.

 

[MMarie]

Laatste poging, ik geef het op voor vandaag :-(

hier het bestand (met foto) en jouw aanpassing.
Hij geeft een foutmelding op het verwijderen van de foto. Als ik G3 wijzig op het Voorblad dan werkt t. De oude foto gaat weg en de foto van het nieuwe geselecteerde nummer verschijnt.

Maar met de PDf button op het tabblad input loopt ie vast op het verwijderen van de foto.

 

[VenA]

Het heeft te maken met de meerdere tabjes die je selecteert. Als je het in de goede volgorde doet dan gaat het wel goed. Wel het Change event weghalen of de events uit en weer aanzetten.

Sub VenA()
c00 = "E:\Temp\"
  ar = Sheets("Input").Cells(1).CurrentRegion
  With Sheets("Voorblad")
    For j = 2 To UBound(ar)
      .Select
      .Range("G3") = ar(j, 1)
      For Each it In .DrawingObjects
        If Left(it.Name, 7) = "Picture" Then it.Delete
      Next it
      c01 = c00 & ar(j, 1) & ".png"
      If Dir(c01) <> "" Then Set a = Sheets("Voorblad").Shapes.AddPicture(c01, True, False, 280, 150, -1, 365)
      Sheets(Array("Voorblad", "M", "BN", "AS", "Bhr")).Select
      ActiveSheet.ExportAsFixedFormat xlTypePDF, c00 & "CBP " & ar(j, 1)
    Next j
  End With
End Sub

Nog wel het eea aanpassen naar jouw eigen situatie.

 

[MMarie]

Bedankt. Ik ga het morgen uitproberen en laat weten of het is gelukt!

 

[MMarie]

@VenA Met een paar kleine aanpassingen (moest nog wat rechtzetten in de verhouding van de foto) werkte dit perfect! Ik ben helemaal blij. Bedankt voor de hulp!