[Excel 2013] Automatisch rapporten genereren

[zarar]

Context
Ik heb een zakelijk dashboard gebouwd waarin ik een aantal kerngegevens vanuit een heleboel data naar boven haal zodra ik het relatienummer intoets. Dit werkt voornamelijk met vert.zoeken. Deze rapportages verstrek ik als PDF per mail aan mijn zakelijke relaties op periodieke basis. Probleem is dat het inmiddels 60+ relaties zijn en de tijdsimpact te groot wordt.

Mijn vraag
Hoe kan ik automatisch vanuit een lijst met relatienummers deze rapporten genereren?

Aanvulling
Dit mag door de uitkomst in een nieuw tabblad te zetten of als nieuw excelwerkblad. Ik heb een macro die daar vervolgens een PDF van maakt en klaar zet in mijn outlook met en standaard bericht. Mooiste is natuurlijk als ik alles kan integreren.

Wat ik al gevonden of geprobeerd heb
Ik vind het lastig om te omschrijven welke zoektermen ik hiervoor moet gebruiken. Zit al wat uren zoekwerk in, maar kom niet tot de juiste oplossingen.

[F_J_K]

Je kunt in eenzelfde soort macro alle klantnummers een voor een laten opvoeren en daarna de pdf-macro draaien. In hetzelfde worksheet of ieder een eigen worksheet.

Of: eventueel een 'mail merge' doen.

[zarar]

Correct, maar ik worstel met de functie om ze op te laten voeren. Welke kan ik daarvooer gebruiken?

[F_J_K]

Hoe doe je het met de hand precies? Als je nu ID's met de hand invoert, kan je dat met een eenvoudige FOR-loop automatiseren: lees de lijst in, vul ID in, roep rapport-functie aan, volgende. Wat is je huidige code?

[zarar]

Handmatig typ ik een relatienummer in cel D11 en druk op enter. Dan verschijnt alle data. Vervolgens opslaan als PDF en naam toekennen. En dan ga ik naar het volgende relatienummer uit de lijst etc etc

Ik heb gewoon een standaard stukje code:

code:

Sub VulCel()

With Sheets("Dashboard")
.[d11].Value = 1000

End With

End Sub

Nu is de uitdaging de Value te laten vullen met elke opvolgende regel in een loop. Ik dacht aan:

code:

Do until IsEmpty

Als dit lukt om de volgende stap om de handeling van opslaan als PDF ertussen te zetten Ik ben nog wel even bezig denk ik. Maar ja, ik kan 8 a 10 uur p/mnd besparen. Dus 1x investeren loont op zich wel

[Lustucru]

Met neme een range (bij voorkeur een benoemd bereik) waarin alle relatienummers onder elkaar staan en dan:

Visual Basic:

dim relatie as range
For each relatie In range("relaties")
      sheets("rapportage").Range(D11).value=relatie.value
      'maak pdf
      'verstuur mail
Next relatie

[zarar]

Ik heb m nu werkend, wellicht niet helemaal optimale code, maar ben er nu tevreden mee.

code:

Sub Knop20_Klikken()

Sheets("Relaties").Select
Range("A2").Select

Do Until IsEmpty(ActiveCell)

With Sheets("Dashboard")
.[F13].Value = ActiveCell

End With

Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
 
' Not sure for what the Title is
Title = "Dashboard" & " " & Sheets("Dashboard").Range("i1")
 
  ' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & " " & Sheets("Dashboard").Range("i1") & ".pdf"
 
  ' Export activesheet as PDF
With Sheets("Dashboard").Range("C3:P43")
.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
 
  ' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
  Set OutlApp = CreateObject("Outlook.Application")
  IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
  .Subject = Title
  .To = Sheets("Dashboard").Range("A1") ' <-- Put email of the recipient here
  .CC = "*****@**.nl;***@***.nl" ' <-- Put email of 'copy to' recipient here
  .Body = "Beste," & " " & Sheets("Dashboard").Range("B1") & vbLf & vbLf _
        & "Let op dit is een automatisch gegenereerd bericht." & vbLf & vbLf _
        & "Hierbij het maandelijkse dashboard vanuit ************" & vbLf & vbLf _
        & "Met vriendelijke groet," & vbLf & vbLf _
        & "****** & ******" & vbLf & vbLf _
        & "T 06 111111111|  010 11111111" & vbLf & vbLf _
    
        
        
  .Attachments.Add PdfFile
   
    ' Try to send
  On Error Resume Next
  .Display
  .Save
  .Close olPromtForSave
  
  Application.Visible = True
  
   
End With
 
 ' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
  
  ' Release the memory of object variable
Set OutlApp = Nothing


ActiveCell.Offset(1, 0).Select

Loop


End Sub