Solved Using Access VBA to change a Powerpoint text box value

The Rev

The Rev

Registered User.
Local time
Today, 13:10
Joined
Jan 15, 2003
Messages
118
Good afternoon,

I am trying to have my Access database open up a Powerpoint presentation template .pptx and replace a value with a value from the database. Currently, on the main slide and a few others in the template, we have a placeholder of "XXXXX" for the company name. That value is already part of the database, so I'd like to replace all instances of XXXXX with the value of Me.Company_Name from my Reports form button. I have the following code so far that lets me choose the template from a location, and it tries to cycle through all of the slides looking for that value, but I keep getting an "Object Required" error where I try to start looping through the slides.



Code: 
Const msoFileDialogFilePicker As Long = 3
Dim strSelectedFile As String
Dim AppPPT As Object
 
Set fdg = Application.FileDialog(msoFileDialogFilePicker)
 
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Path = objSFolders("MyDocuments")
 
With fdg
  .AllowMultiSelect = False
  .Filters.Add "File Type", "*.pptx", 1
  .InitialFileName = Path
   If .Show = -1 Then
    For Each strSelectedItem In .SelectedItems
           Set AppPPT = CreateObject("PowerPoint.Application")
           AppPPT.Visible = True
           With AppPPT.Presentations.Open(strSelectedItem)
'Here is where I get the error on the following line
               For Each Slide In Presentation.Slides
           For Each Shape In pptSlide.Shapes
            If Shape.Type = TextFrame Then
               TextFrame.TextRange.Text = Replace(TextFrame.TextRange.Text, "XXXXX", "Company Name")
            End If
           Next
        Next
       End With
           'AppPPT.Quit
    Next strSelectedItem
    Else
    End If
End With
Set fdg = Nothing
Set AppPPT = Nothing
Set objSFolders = Nothing

I know it's clunky, but I need this to work and I don't remember how to call the Powerpoint slide and textbox... HELP!!
 
I use this to replace a string assuming you already have the object set (in my case ppres is the already open presentation)
SQL: 
Sub SetReplaceString(sRepWord As String)

    Dim sld As Slide
    Dim shp As Shape
    Dim ShpTxt As TextRange
    Dim TmpTxt As TextRange
    Dim FindWord As Variant
    Dim ReplaceWord As Variant
    Dim iWords As Integer
    Dim textLoc As PowerPoint.TextRange

    FindWord = "xxxxxxx"
    ReplaceWord = sRepWord

    'Loop through each slide in Presentation
 
    For Each sld In ppPres.Slides
    
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    Set textLoc = shp.TextFrame.TextRange.Find(FindWord)  'use Find function to get the textrange for the string being searched for
                    If Not (textLoc Is Nothing) Then 'if something is found
                        textLoc.Text = ReplaceWord      'then replace it
                        iWords = iWords + 1
                    End If
                End If
            End If
        Next shp
      
    Next sld
    Debug.Print "xxxxxxx updated to " & sRepWord & " " & iWords & " times"

End Sub
 
Minty said:
I use this to replace a string assuming you already have the object set (in my case ppres is the already open presentation)
SQL: 
Sub SetReplaceString(sRepWord As String)

    Dim sld As Slide
    Dim shp As Shape
    Dim ShpTxt As TextRange
    Dim TmpTxt As TextRange
    Dim FindWord As Variant
    Dim ReplaceWord As Variant
    Dim iWords As Integer
    Dim textLoc As PowerPoint.TextRange

    FindWord = "xxxxxxx"
    ReplaceWord = sRepWord

    'Loop through each slide in Presentation

    For Each sld In ppPres.Slides
   
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then
                    Set textLoc = shp.TextFrame.TextRange.Find(FindWord)  'use Find function to get the textrange for the string being searched for
                    If Not (textLoc Is Nothing) Then 'if something is found
                        textLoc.Text = ReplaceWord      'then replace it
                        iWords = iWords + 1
                    End If
                End If
            End If
        Next shp
     
    Next sld
    Debug.Print "xxxxxxx updated to " & sRepWord & " " & iWords & " times"

End Sub
Click to expand...


I'm getting "Object doesn't Support this property or method" at

For Each sld In AppPPT.Slides


I'm just using this code from an "On Click" event, not as a separate Sub.
 
Can you post the full code you have right now? In the first attempt you didn't have Slide declared anywhere.

Cheers,
 
Does this work?

Code: 
Const msoFileDialogFilePicker As Long = 3
Dim strSelectedFile As String
Dim AppPPT As Object, objSlide as object, objShape as object, objPresentation as object
 
Set fdg = Application.FileDialog(msoFileDialogFilePicker)
 
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Path = objSFolders("MyDocuments")
 
With fdg
  .AllowMultiSelect = False
  .Filters.Add "File Type", "*.pptx", 1
  .InitialFileName = Path
   If .Show = -1 Then
    For Each strSelectedItem In .SelectedItems
           Set AppPPT = CreateObject("PowerPoint.Application")
           AppPPT.Visible = True
           set objPresentation = AppPPT.Presentations.Open(strSelectedItem)
               For Each objSlide In objPresentation.Slides
                       For Each objShape In pptSlide.Shapes
                        If Shape.Type = TextFrame Then
                               TextFrame.TextRange.Text = Replace(TextFrame.TextRange.Text, "XXXXX", "Company Name")
                        End If
                       Next objShape
                Next objSlide

           'AppPPT.Quit
    Next strSelectedItem
    Else
    End If
End With
Set fdg = Nothing
Set AppPPT = Nothing
Set objSFolders = Nothing
 
Isaac said:
Does this work?

Code: 
Const msoFileDialogFilePicker As Long = 3
Dim strSelectedFile As String
Dim AppPPT As Object, objSlide as object, objShape as object, objPresentation as object

Set fdg = Application.FileDialog(msoFileDialogFilePicker)

Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Path = objSFolders("MyDocuments")

With fdg
  .AllowMultiSelect = False
  .Filters.Add "File Type", "*.pptx", 1
  .InitialFileName = Path
   If .Show = -1 Then
    For Each strSelectedItem In .SelectedItems
           Set AppPPT = CreateObject("PowerPoint.Application")
           AppPPT.Visible = True
           set objPresentation = AppPPT.Presentations.Open(strSelectedItem)
               For Each objSlide In objPresentation.Slides
                       For Each objShape In pptSlide.Shapes
                        If Shape.Type = TextFrame Then
                               TextFrame.TextRange.Text = Replace(TextFrame.TextRange.Text, "XXXXX", "Company Name")
                        End If
                       Next objShape
                Next objSlide

           'AppPPT.Quit
    Next strSelectedItem
    Else
    End If
End With
Set fdg = Nothing
Set AppPPT = Nothing
Set objSFolders = Nothing
Click to expand...
No. I get Object Required for

For Each objShape In pptSlide.Shapes
 
HI Isaac,
It should, I think you have a few small errors:
Code: 
Const msoFileDialogFilePicker As Long = 3
Dim strSelectedFile As String
Dim AppPPT As Object, objSlide as object, objShape as object, objPresentation as object
 
Set fdg = Application.FileDialog(msoFileDialogFilePicker)
 
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Path = objSFolders("MyDocuments")
 
With fdg
  .AllowMultiSelect = False
  .Filters.Add "File Type", "*.pptx", 1
  .InitialFileName = Path
   If .Show = -1 Then
    For Each strSelectedItem In .SelectedItems
           Set AppPPT = CreateObject("PowerPoint.Application")
           AppPPT.Visible = True
           set objPresentation = AppPPT.Presentations.Open(strSelectedItem)
               For Each objSlide In objPresentation.Slides
                       For Each objShape In objSlide.Shapes  'pptSlide.Shapes
                        If objShape.Type = TextFrame Then
                               objShape.TextRange.Text = Replace(objShape.TextRange.Text, "XXXXX",Me.CompanyName) '' "Company Name")
                        End If
                       Next objShape
                Next objSlide

           
    Next strSelectedItem
    Else
    End If
End With
Set fdg = Nothing
           AppPPT.Quit
Set AppPPT = Nothing
Set objSFolders = Nothing
 
Still tinkering.

Code: 
Private Sub Outbrief_Click()
Const msoFileDialogFilePicker As Long = 3
Dim strSelectedFile As String
Dim AppPPT As Object, objSlide As Object, objShape As Object, objPresentation As Object
 
Set fdg = Application.FileDialog(msoFileDialogFilePicker)
 
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Path = objSFolders("MyDocuments")
 
With fdg
  .AllowMultiSelect = False
  .Filters.Add "File Type", "*.pptx", 1
  .InitialFileName = Path
   If .Show = -1 Then
          strSelectedItem = .SelectedItems(1)
          Set AppPPT = CreateObject("PowerPoint.Application")
           AppPPT.Visible = True
           Set objPresentation = AppPPT.Presentations.Open(strSelectedItem)
               For Each objSlide In objPresentation.Slides
                       For Each Shape In objPresentation.Shapes
                        If Shape.Type = TextFrame Then
                               TextFrame.TextRange.Text = Replace(TextFrame.TextRange.Text, "XXXXX", "Company Name")
                        End If
                       Next Shape
                Next objSlide

           'AppPPT.Quit
    
    Else
    End If
End With
Set fdg = Nothing
Set AppPPT = Nothing
Set objSFolders = Nothing
End Sub

Object doesn't support this property or method

For Each Shape In objPresentation.Shapes
 
bastanu said:
HI Isaac,
It should, I think you have a few small errors:
Code: 
Const msoFileDialogFilePicker As Long = 3
Dim strSelectedFile As String
Dim AppPPT As Object, objSlide as object, objShape as object, objPresentation as object

Set fdg = Application.FileDialog(msoFileDialogFilePicker)

Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Path = objSFolders("MyDocuments")

With fdg
  .AllowMultiSelect = False
  .Filters.Add "File Type", "*.pptx", 1
  .InitialFileName = Path
   If .Show = -1 Then
    For Each strSelectedItem In .SelectedItems
           Set AppPPT = CreateObject("PowerPoint.Application")
           AppPPT.Visible = True
           set objPresentation = AppPPT.Presentations.Open(strSelectedItem)
               For Each objSlide In objPresentation.Slides
                       For Each objShape In objSlide.Shapes  'pptSlide.Shapes
                        If objShape.Type = TextFrame Then
                               objShape.TextRange.Text = Replace(objShape.TextRange.Text, "XXXXX",Me.CompanyName) '' "Company Name")
                        End If
                       Next objShape
                Next objSlide

          
    Next strSelectedItem
    Else
    End If
End With
Set fdg = Nothing
           AppPPT.Quit
Set AppPPT = Nothing
Set objSFolders = Nothing
Click to expand...

This didn't generate errors, but it didn't replace the text.
 
Maybe try to step in through the code and see what is doing? Your previous post was wrong as Shape was not declared, objShape was...

Cheers,
 
bastanu said:
Maybe try to step in through the code and see what is doing? Your previous post was wrong as Shape was not declared, objShape was...

Cheers,
Click to expand...

Got it!!!


Code: 
Const msoFileDialogFilePicker As Long = 3
Dim strSelectedFile As String
Dim AppPPT As Object, objSlide As Object, objShape As Object, objPresentation As Object

Set fdg = Application.FileDialog(msoFileDialogFilePicker)

Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
Path = objSFolders("MyDocuments")

With fdg
  .AllowMultiSelect = False
  .Filters.Add "File Type", "*.pptx", 1
  .InitialFileName = Path
   If .Show = -1 Then
    For Each strSelectedItem In .SelectedItems
           Set AppPPT = CreateObject("PowerPoint.Application")
           AppPPT.Visible = True
           Set objPresentation = AppPPT.Presentations.Open(strSelectedItem)
               For Each objSlide In objPresentation.Slides
                       For Each objShape In objSlide.Shapes  'pptSlide.Shapes
                        If objShape.Type = 1 Then
                              objShape.TextFrame.TextRange = Replace(objShape.TextFrame.TextRange, "XXXXX", "CompanyName")
                       End If
                       Next objShape
                Next objSlide

          
    Next strSelectedItem
    Else
    End If
End With
Set fdg = Nothing
          ' AppPPT.Quit
Set AppPPT = Nothing
Set objSFolders = Nothing
 
The Rev said:
No. I get Object Required for

For Each objShape In pptSlide.Shapes
Click to expand...
Sorry, please change this line:

For Each objShape In pptSlide.Shapes

to:

For Each objShape In objSlide.Shapes
 
So, next task is a bit more complicated. In the middle of the slide deck, I have on slide 5 of the template a slide where I list failed requirements. It has 3 text fields on it, but I need to only replace what is in the second with my failed requirements report information. The stickler is that I only need 2 failed requirements per page and I need to duplicate and insert slides in the template as necessary. I'm going to start coding this morning and post my progress and maybe ask for a bit of help. I appreciate you guys
 
Good luck, I do a lot of PPT slide automation work, and trust me it is unbelievably frustrating.

Some of the methods have been depreciated, but are still needed as they haven't actually replaced them, and they overwrite some bits of the newer properties efforts.

Try setting a line transparency in a chart. And then try altering the line colours.
 
The Rev said:
So, next task is a bit more complicated. In the middle of the slide deck, I have on slide 5 of the template a slide where I list failed requirements. It has 3 text fields on it, but I need to only replace what is in the second with my failed requirements report information. The stickler is that I only need 2 failed requirements per page and I need to duplicate and insert slides in the template as necessary. I'm going to start coding this morning and post my progress and maybe ask for a bit of help. I appreciate you guys
Click to expand...
Nice sig
 
So far so good. I have the presentation making duplicates temporarily based on an input box, and each slide is individually edited based on the slide number. Now, here comes the hard part... I have an existing query that gives me all of the failed requirements in table format. I have no idea how to take the pertinent data so I can get it into the text box.
 
You could open a recordset and create whatever your "lines in the textbox" requirement is crafted from the recordset results
 
Out of curiosity, is there a character limit for the SQL statement? Mine's 758 characters long because I need lots of different data for the query, but only 5 data fields from the query will get combined into the text I need to paste into the text box.
 
You must log in or register to reply here.

Similar threads

The Rev
Solved Dealing with long file paths
Replies
6
Views
2,048
Isaac
Isaac
N
Data source changed from a table to a query
Replies
13
Views
291
Pat Hartman
P
R
  • Question Question
Using vba to select a particular record in a combo box is not working properly
Replies
4
Views
282
cheekybuddha
cheekybuddha
L
Consuming an API to retrieve data and store it in a Microsoft Access table.
Replies
3
Views
229
lbcurrier
L
Uncle Gizmo
How to Simplify MS Access Form Searches Using Class Modules and Collections to Pair Text Boxes and Option Groups for Efficient SQL Query Generation
Replies
14
Views
441
MarkK
MarkK

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom