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
 
Sort by date Sort by votes
Try adding vbTextCompare to the 2 Instr lines.
Shown in blue below:

Rich (BB code): 
    ' 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", vbTextCompare) > 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", vbTextCompare) > 0 Then
                Set arrShapes(2) = shp
                Exit For
            End If
        End If
    Next shp
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Did you copy paste those lines over the top of your ones ?
Did you try it on the same file you sent us in your link ?

Repost the full code you are now using with that change in it so we can retest it at our end. Please make sure you press on the VBA button and post your code between the 2 Code tags
 
Upvote 0
This is what i have done:

opened my date.xlsl document then developer and clicked on Visual Basic (ALT+F11) then insert module.. pasted the below code then pressed F5.

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 = "https://Documents/Desktop/cert/certificateTemplate.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", vbTextCompare) > 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", vbTextCompare) > 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 = Date
        
        ' 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
 
Upvote 0
That worked like a charm for me.

If you put a breakpoint where I have it below and stop the code there, do you have power point and the document open ?
In the pp document if you hit Ctrl+F10 in the panel that opens on the right side can you see name & date appearing ?

1733749781997.png


If that is all good put another breakpoint on the Do While line and run the code to there.
Double click on arrShapes to select it, right click > Add Watch
Expand it in the Watch window, do both arrShapes 1 and 2 contain a value ?
 
Upvote 0
it has worked partially the presentation name format has changed corresponding to what i have on excel sheet i just need the date corresponding the same as its currently displaying todays date 09/12/2024.

answer to your Qs... how do i add a breakpoint? i ran the code again with all documents opened excel and powerpoint the error code still appears although the ppt name is correctly changed for the first student on the list, date unmatched to the document.

would it be the fact i am limited as its a work laptop? dont know why its working for you and not for me. it hasn't saved the file in pdf either it jujts opens the powerpoint with the name reflected correctly and wrong date and doesn't save in pdf
 
Upvote 0
I haven't had a chance to test it, but see if this helps...

VBA Code: 
Option Explicit

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 shapeCount As Long
    Dim xlSheet As Worksheet
    Dim row As Long
    Dim name As String
    Dim gradDate As String
    Dim savePath As String
    Dim certificateTemplate As String
    
    ' Path to your PowerPoint template
    certificateTemplate = "https://Documents/Desktop/cert/certificateTemplate.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)
    
    shapeCount = 0
    
    ' 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", vbTextCompare) > 0 Then
                Set arrShapes(1) = shp
                shapeCount = shapeCount + 1
                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", vbTextCompare) > 0 Then
                Set arrShapes(2) = shp
                shapeCount = shapeCount + 1
                Exit For
            End If
        End If
    Next shp
    
    If shapeCount = 2 Then
        
        ' 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 = Date
            
            ' Export slide as PDF
            pptPres.ExportAsFixedFormat Path:=savePath & name & "_certificate.pdf", _
                                FixedFormatType:=2, _
                                RangeType:=4, _
                                PrintRange:=pr, _
                                Intent:=2, _
                                FrameSlides:=msoFalse
            
            PauseMacro 1 'second
            
            row = row + 1
            
        Loop
        
        pptPres.Close
        
        PauseMacro 1 'second
        
        pptApp.Quit
        
        PauseMacro 1 'second
        
        ' 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!"
        
    Else
    
        MsgBox "The TextBox for name and/or date not found.", vbExclamation
    
    End If
    
End Sub

Sub PauseMacro(ByVal secs As Long)

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

Does this help?
 
Upvote 0
apologies Domenic i had to remind myself of the rules.. please see the photo of my excel sheet i think my rows or columns isn't correct please advice accordingly and recheck the codes please
 

Attachments

  • date excel sheet1.jpg
    date excel sheet1.jpg
    88.2 KB · Views: 3
Upvote 0
Domenic your code has worked perfectly thank you so much and the pdf documents have been generated. please help me link the date correctly from my excel sheet uploaded above as currently the dates dont match
 
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