Consulting

Results 1 to 3 of 3

Thread: Find and replace a list of words in PowerPoint presentation, including tables

  1. #1

    Question Find and replace a list of words in PowerPoint presentation, including tables

    Hi all,

    I have been trying to solve this issue for a couple of days and am very stuck despite googling around a lot, so would really appreciate any pointers


    So I am trying to replace a list of words by another (my file is a template used for several projects). It worked all right in textboxes, but did not work for tables so I have tried to adjust the textboxes code to tables. The below code runs without giving me an error message, but still does not edit my tables...


    Thank you in advance for your help!


    Celine

    Sub Multi_FindReplace()
    
    
    'PURPOSE: Find & Replace a list of text/values throughout entire PowerPoint presentation
    
    
    Dim sld As Slide
    Dim shp As Shape
    Dim ShpTxt As TextRange
    Dim TmpTxt As TextRange
    Dim FindList As Variant
    Dim ReplaceList As Variant
    Dim x As Long
    Dim i As Long
    Dim j As Long
    Dim tbl As Table
    
    
    
    
    ' INSERT THE LIST OF MERGE FIELDS HERE
    FindList = Array("word1", "word2", "word3")
    
    
    ' INSERT THE LIST OF VARIABLES TO BE INSERTED BY HERE  
    ReplaceList = Array("word1.1", "word2.1", "word3.1")
    
    
    
    
    'Loop through each slide in Presentation
      For Each sld In ActivePresentation.Slides
    
    
        For Each shp In sld.Shapes
    
    
            '''''for tables
            If shp.HasTable Then
    
    
                    'give name to table
                    Set tbl = shp.Table
    
    
                    'loops on table rows and columns
                    For i = 1 To shp.Table.Rows.Count
                        For j = 1 To shp.Table.Columns.Count
    
    
                            'Store cell text into a variable
                            ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange
    
    
    
    
                              'Ensure There is Text To Search Through
                              If ShpTxt <> "" Then
                                 For x = LBound(FindList) To UBound(FindList)
    
    
                                 'Store text into a variable
                                'Set ShpTxt = shp.TextFrame.TextRange
    
    
                                 'Find First Instance of "Find" word (if exists)
                                 Set TmpTxt = ShpTxt.Replace( _
                                  FindWhat:=FindList(x), _
                                  Replacewhat:=ReplaceList(x), _
                                  WholeWords:=False)
    
    
                                 'Find Any Additional instances of "Find" word (if exists)
                                  Do While Not TmpTxt Is Nothing
                                    Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length)
                                    Set TmpTxt = ShpTxt.Replace( _
                                      FindWhat:=FindList(x), _
                                      Replacewhat:=ReplaceList(x), _
                                      WholeWords:=False)
                                  Loop
                                 Next x
                              End If
    
    
    
    
                         Next j
                    Next i
            Else
    
    
    
    
            ''''for all shapes excluding tables
            If shp.HasTextFrame Then
    
    
               'Store shape text into a variable
               Set ShpTxt = shp.TextFrame.TextRange
    
    
                'Ensure There is Text To Search Through
                 If ShpTxt <> "" Then
                    For x = LBound(FindList) To UBound(FindList)
    
    
                    'Store text into a variable
                    'Set ShpTxt = shp.TextFrame.TextRange
    
    
                    'Find First Instance of "Find" word (if exists)
                    Set TmpTxt = ShpTxt.Replace( _
                      FindWhat:=FindList(x), _
                      Replacewhat:=ReplaceList(x), _
                      WholeWords:=False)
    
    
                    'Find Any Additional instances of "Find" word (if exists)
                    Do While Not TmpTxt Is Nothing
                      Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length)
                      Set TmpTxt = ShpTxt.Replace( _
                        FindWhat:=FindList(x), _
                        Replacewhat:=ReplaceList(x), _
                        WholeWords:=False)
                    Loop
                   Next x
                End If
    
    
            End If
    
    
            End If
    
    
        Next shp
    
    
    Next sld
    
    
    
    
    End Sub
    
    
    d

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,700
    Location
    This should error|:

    'Store cell text into a variable

    ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange

    ShpTxt is declared as a TEXTRANGE OBJECT

    SO

    'Store cell text into a variable

    Set ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3

    Talking [solved] thank you

    Hi John,

    thank you so much for the fix!
    I ran the code again and indeed the error came - no idea why it did not initially.
    The code works perfectly with the corrected syntax.

    Thanks!!!

    Celine


    Quote Originally Posted by John Wilson View Post
    This should error|:

    'Store cell text into a variable

    ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange

    ShpTxt is declared as a TEXTRANGE OBJECT

    SO

    'Store cell text into a variable

    Set ShpTxt = tbl.Cell(i, j).Shape.TextFrame.TextRange

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •