Excel VBA Help

J

jah1385

New Member
Joined
Nov 30, 2024
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Sub GenerateCertificates()
Dim pptApp As Object
Dim pptPres As Object
Dim pptSlide As Object
Dim xlSheet As Worksheet
Dim row As Integer
Dim name As String
Dim gradDate As String
Dim savePath As String
Dim certificateTemplate As String

' Path to your PowerPoint template
certificate_Template = "C:\Users\jay\Desktop\cert\certificate_template.pptx"

' Folder to save generated certificates
savePath = "C:\Users\jay\Desktop\cert\"

' Set Excel sheet
Set xlSheet = ThisWorkbook.Sheets("Sheet2") ' Adjust sheet name if necessary

' Open PowerPoint
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True

' Loop through rows in Excel
row = 2 ' Assuming data starts in row 2
Do While xlSheet.Cells(row, 1).Value <> ""
' Get data from Excel
name = xlSheet.Cells(row, 1).Value
gradDate = xlSheet.Cells(row, 3).Value

' Open PowerPoint template
Set pptPres = pptApp.Presentations.Open(certificate_Template)
Set pptSlide = pptPres.Slides(1) ' Adjust if template has multiple slides

' Replace placeholders in PowerPoint
Dim shp As Object
For Each shp In pptSlide.Shapes
If shp.HasTextFrame Then
If InStr(1, shp.TextFrame.TextRange.Text, "Name") > 0 Then
shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Name", name)
End If
If InStr(1, shp.TextFrame.TextRange.Text, "Date") > 0 Then
shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Date", gradDate)
End If
End If
Next shp

' Save as a new PowerPoint file
pptPres.SaveAs savePath & name & "_certificate.pptx"
pptPres.Close
row = row + 1
Loop

' Clean up
pptApp.Quit
Set pptApp = Nothing
MsgBox "Certificates generated successfully!"
End Sub


i have managed to work something out but the data isn't being replicated in the actual presentation instead it saves the certificate of all the student names i.e John.ppt

i also get an error code Run-time error '-2147467259 (80004005)

Presentation Open
Presentation.Close : Failed

I am trying to link the names into the name part of the powerpoint and the date into the date textbox. i then would like the ppt to be saved in PDF

anyone can support me greatly appreciated
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
just to reiterate i have the name and date in excel sheet. i have the certificate in powerpoint (dont want to use mailmerger)

i want to link the name and date between the files and get macro to eventually save the certificate in PDF. its for a graduation day to issue multiple students their certificates

A1 Name B1 Date
A2 John B2 11/01/2024
A3 Jay B3 30/04/2024
 
Upvote 0
I have amened your code as follows. A few things to note, though. At first, I was going to use the Export method of the Slide object to export the slide as a PDF. However, whenever I did so, PowerPoint would remain in the background for some reason when it quits. Maybe it doesn't like exporting the slide as a PDF. Exporting it as a JPG seems fine, though. Anyway, as a result, I used the ExportAsFixedFormat method of the Presentation object instead. Also, note that I've assume that the presentation contains only one slide.

VBA Code: 
Sub GenerateCertificates()

    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim shp As Object
    Dim arrShapes(1 To 2) As Object
    Dim xlSheet As Worksheet
    Dim row As Integer
    Dim name As String
    Dim gradDate As String
    Dim savePath As String
    Dim certificateTemplate As String
   
    ' Path to your PowerPoint template
    certificateTemplate = "C:\Users\jay\Desktop\cert\certificate_template.pptx"
   
    ' Folder to save generated certificates
    savePath = "C:\Users\jay\Desktop\cert\"
   
    ' Set Excel sheet
    Set xlSheet = ThisWorkbook.Sheets("Sheet2") ' Adjust sheet name if necessary
   
    ' Open PowerPoint
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
   
    ' Open PowerPoint template
    Set pptPres = pptApp.Presentations.Open(certificateTemplate)
   
    Set pptSlide = pptPres.Slides(1) ' Adjust if template has multiple slides
   
    ' Find shape index for shape containing the name
    For Each shp In pptSlide.Shapes
        If shp.hastextframe Then
            If InStr(1, shp.TextFrame.TextRange.Text, "Name") > 0 Then
                Set arrShapes(1) = shp
                Exit For
            End If
        End If
    Next shp
   
    ' Find shape index for shape containing the date
    For Each shp In pptSlide.Shapes
        If shp.hastextframe Then
            If InStr(1, shp.TextFrame.TextRange.Text, "Date") > 0 Then
                Set arrShapes(2) = shp
                Exit For
            End If
        End If
    Next shp
       
    ' Loop through rows in Excel
    row = 2 ' Assuming data starts in row 2
    Do While xlSheet.Cells(row, 1).Value <> ""
   
        ' Get data from Excel
        name = xlSheet.Cells(row, 1).Value
        gradDate = xlSheet.Cells(row, 3).Value
       
        ' Replace placeholders in PowerPoint
        arrShapes(1).TextFrame.TextRange.Text = name
        arrShapes(2).TextFrame.TextRange.Text = gradDate
       
        ' Export presentation as PDF
        pptPres.ExportAsFixedFormat Path:=savePath & name & "_certificate.pdf", FixedFormatType:=2, printRange:=Nothing
       
        DoEvents
       
        row = row + 1
       
    Loop
   
    pptPres.Close
   
    DoEvents
   
    pptApp.Quit
   
    DoEvents
   
    ' Clean up
    Set shp = Nothing
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
   
    AppActivate ThisWorkbook.Windows(1).Caption 'bring Excel to front to ensure that the user sees the MsgBox that appears in Excel
   
    MsgBox "Certificates generated successfully!"
   
End Sub

Hope this helps!
 
Last edited:
Upvote 0
In case your template contains more than one slide, the following code will save as PDF only the first slide...

VBA Code: 
Sub GenerateCertificates()

    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim pr As Object
    Dim shp As Object
    Dim arrShapes(1 To 2) As Object
    Dim xlSheet As Worksheet
    Dim row As Integer
    Dim name As String
    Dim gradDate As String
    Dim savePath As String
    Dim certificateTemplate As String
    
    ' Path to your PowerPoint template
    certificateTemplate = "C:\Users\jay\Desktop\cert\certificate_template.pptx"
    
    ' Folder to save generated certificates
    savePath = "C:\Users\jay\Desktop\cert\"
    
    ' Set Excel sheet
    Set xlSheet = ThisWorkbook.Sheets("Sheet2") ' Adjust sheet name if necessary
    
    ' Open PowerPoint
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    
    ' Open PowerPoint template
    Set pptPres = pptApp.Presentations.Open(certificateTemplate)
    
    Set pptSlide = pptPres.Slides(1) ' Adjust if template has multiple slides
    
    ' clear the print range and set it to the specified slide
    pptPres.PrintOptions.Ranges.ClearAll
    Set pr = pptPres.PrintOptions.Ranges.Add(Start:=pptSlide.slideNumber, End:=pptSlide.slideNumber)
    
    ' Find shape index for shape containing the name
    For Each shp In pptSlide.Shapes
        If shp.hastextframe Then
            If InStr(1, shp.TextFrame.TextRange.Text, "Name") > 0 Then
                Set arrShapes(1) = shp
                Exit For
            End If
        End If
    Next shp
    
    ' Find shape index for shape containing the date
    For Each shp In pptSlide.Shapes
        If shp.hastextframe Then
            If InStr(1, shp.TextFrame.TextRange.Text, "Date") > 0 Then
                Set arrShapes(2) = shp
                Exit For
            End If
        End If
    Next shp
        
    ' Loop through rows in Excel
    row = 2 ' Assuming data starts in row 2
    Do While xlSheet.Cells(row, 1).Value <> ""
    
        ' Get data from Excel
        name = xlSheet.Cells(row, 1).Value
        gradDate = xlSheet.Cells(row, 3).Value
        
        ' Replace placeholders in PowerPoint
        arrShapes(1).TextFrame.TextRange.Text = name
        arrShapes(2).TextFrame.TextRange.Text = gradDate
        
        ' Export slide as PDF
        pptPres.ExportAsFixedFormat Path:=savePath & name & "_certificate.pdf", _
                            FixedFormatType:=2, _
                            RangeType:=4, _
                            PrintRange:=pr, _
                            Intent:=2, _
                            FrameSlides:=msoFalse
        
        DoEvents
        
        row = row + 1
        
    Loop
    
    pptPres.Close
    
    DoEvents
    
    pptApp.Quit
    
    DoEvents
    
    ' Clean up
    Set shp = Nothing
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    
    AppActivate ThisWorkbook.Windows(1).Caption 'to ensure that the user sees the MsgBox that appears in Excel
    
    MsgBox "Certificates generated successfully!"
    
End Sub

Hope this helps!
 
Upvote 0
Thats correct it saves the first slide which is correct however the powerpoint field marked as Name and Date doesn't complete as the field is left blank when it is saved in PDF
 
Upvote 0
Set pptPres = pptApp.Presentations.Open(certificateTemplate)

error code Run-Time Error '-21470224893
Method 'Open of object' 'Presentations' failed

The file name is correct in the my folder as far as my understanding is of this error code
 
Upvote 0
Update manged to fix that file name error using the pptx copy path link

can you guide me arrshapes textframet how i can label that correctly on ppt? as the error code is now object variables or block not set
 
Upvote 0
When I tested it before posting, it ran successfully, without an errors. It may be a timing issue. See if this helps. First add the following procedure to your module...

VBA Code: 
Sub PauseMacro(ByVal secs As Long)

    Dim endTime As Single
    endTime = Timer + secs
    
    Do
        DoEvents
    Loop Until Timer > endTime
    
End Sub

Then replace each occurence of...

VBA Code: 
DoEvents

with

VBA Code: 
PauseMacro 1 'seconds

Does this help?
 
Upvote 0
Domenic it still shows an error code 91 and when i click on debug it highlights the following vba code in yellow:

arrShapes(1).TextFrame.TextRange.Text = name

P.S Thank you for your support so far :)
 

Attachments

  • Error Code 91.png
    Error Code 91.png
    201.4 KB · Views: 6
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Data Transfer from Excel to PowerPoint and getting PDF file of PPT
Replies
1
Views
99
Sequoyah
Sequoyah
C
  • Question Question
Embedding and displaying a Powepoint slide presentation in an Excel Userform. Possible?
Replies
0
Views
409
chazrab
C
T
  • Question Question
VBA to update Powerpoint Text from Excel Data in Cells
Replies
9
Views
1K
tbakbradley
T
Ottsel
  • Question Question
Create & Secure PDFS with Excel
Replies
3
Views
215
John_w
J
B
  • Question Question
Export to PowerPOint using Excel VBA
Replies
0
Views
975
bronc
B

Forum statistics

Threads
1,224,503
Messages
6,179,136
Members
452,890
Latest member
Nikhil Ramesh

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top