none
Add Image after finding text location in PPT RRS feed

  • Question

  • I'm new to VBA so if this is old news please point me to the right place for it ;-)

    I have a script to find a text box value in PPT and once I find it I would like to replace the Textbox with a PNG file

    the following VBA find the textbox but I can't find the syntax to add the image in the Textbox location:
                                                        
    For image_counter = 1 To 10
        PPT_Pic_File_Location = PPT_File_Location & SFR_PPT_File_Names_Dim(image_counter) & ".png"
        Text_Location = "<<" & SFR_PPT_File_Names_Dim(image_counter) & ">>"

        ' Checking if the file exist
        If Dir(PPT_Pic_File_Location) <> "" Then
            Dim PPT_Slides As Slide
            Dim PPT_Shapes As Shape
            'Go over each slides
            For Each PPT_Slides In ActivePresentation.Slides
                'Go over each shapes and textRanges
                For Each PPT_Shapes In PPT_Slides.Shapes
                    'Go over all text boxes and find the text for file location
                    If PPT_Shapes.HasTextFrame Then
                        If PPT_Shapes.TextFrame.HasText Then
                            Set SlideTestBox = PPT_Shapes.TextFrame.TextRange
                            Set FoundTextInBox = SlideTestBox.Find(FindWhat:=Text_Location)

                            If Not (FoundTextInBox Is Nothing) Then

    <<< This is the place I need to have the right comment to replace the TextBox I found with an image (located at: PPT_Pic_File_Location) >>>

                            End If
                        End If
                    End If
                Next PPT_Shapes
            Next PPT_Slides
        End If
    Next image_counter


    Thanks
    Tuesday, February 5, 2013 6:22 PM

Answers

  • Hi Eyalh99,

    Please take a look at this:

    Option Explicit
    Const MatchText = "Test it"
    Const ImageSource = "C:\*****\Test.jpg"
    
    Private Sub ReplaceTextBox(ByVal TargetSlide As Slide, ByVal ImagePath As String, _
        ByVal MatchString As String)
        Dim pSh As Shape
        Dim psp As Shape
        
        On Error GoTo exceptionPump
        
        del = False
        For Each pSh In TargetSlide.Shapes
            If pSh.HasTextFrame Then
                If pSh.TextFrame.TextRange.Text = MatchString Then
                    Set psp = TargetSlide.Shapes.AddPicture(ImagePath, msoFalse, msoTrue, _
                        pSh.Left, pSh.Top, pSh.Width, pSh.Height)
                    pSh.Delete
                End If
            End If
        Next
        
        Set psp = Nothing
        Set pSh = Nothing
        
        Exit Sub
    exceptionPump:
        MsgBox Err.Description
    End Sub
    
    Public Sub Execute()
        Dim ppP As Presentation
        Dim ppS As Slide
        
        On Error GoTo ExceptionHandler
        
        Set ppP = ActivePresentation
            
        For Each ppS In ppP.Slides
            ReplaceTextBox ppS, ImageSource, MatchText
        Next
        
        Set ppS = Nothing
        Set ppP = Nothing
        Exit Sub
    ExceptionHandler:
        MsgBox Err.Description
    End Sub

    Hope it can help you.

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.


    Thursday, February 7, 2013 3:42 AM
    Moderator

All replies

  • Hi Eyalh99,

    Thanks for posting in the MSDN Forum.

    As far as I know that we can insert a picture in a exists textbox. We will create a new image shape instead of original textbox.

    Please take a look following snippet:

    Option Explicit
    
    Private Sub test()
        Dim ppP As Presentation
        Dim pPs As Slide
        Dim pSh As Shape
        Dim psp As Shape
        
        On Error GoTo exceptionPump
        
        Set ppP = ActivePresentation
        Set pPs = ppP.Slides(1)
        Set pSh = pPs.Shapes(1)
        
        Set psp = pPs.Shapes.AddPicture( _
            "C:\*******.jpg", _
            msoFalse, msoTrue, pSh.Left, pSh.Top, pSh.Width, pSh.Height)
        pSh.Delete
        
        Set pSh = Nothing
        Set pPs = Nothing
        Set ppP = Nothing
        
        Exit Sub
    exceptionPump:
        MsgBox Err.Description
    End Sub

    Please use your specific Shape varible instead of the pSh in the code snippet to approach your goal.

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Wednesday, February 6, 2013 2:13 AM
    Moderator
  • Thanks for the quick answer and it work but partiality

    the problem is that if  there are multiple shapes on the slide it select the first one (1) and not the one that has the text I would like to replace

    Any idea how to select the shape with the text i found in the .TextRange ?

    Thanks,

    Wednesday, February 6, 2013 2:40 PM
  • Hi Eyalh99,

    Please take a look at this:

    Option Explicit
    Const MatchText = "Test it"
    Const ImageSource = "C:\*****\Test.jpg"
    
    Private Sub ReplaceTextBox(ByVal TargetSlide As Slide, ByVal ImagePath As String, _
        ByVal MatchString As String)
        Dim pSh As Shape
        Dim psp As Shape
        
        On Error GoTo exceptionPump
        
        del = False
        For Each pSh In TargetSlide.Shapes
            If pSh.HasTextFrame Then
                If pSh.TextFrame.TextRange.Text = MatchString Then
                    Set psp = TargetSlide.Shapes.AddPicture(ImagePath, msoFalse, msoTrue, _
                        pSh.Left, pSh.Top, pSh.Width, pSh.Height)
                    pSh.Delete
                End If
            End If
        Next
        
        Set psp = Nothing
        Set pSh = Nothing
        
        Exit Sub
    exceptionPump:
        MsgBox Err.Description
    End Sub
    
    Public Sub Execute()
        Dim ppP As Presentation
        Dim ppS As Slide
        
        On Error GoTo ExceptionHandler
        
        Set ppP = ActivePresentation
            
        For Each ppS In ppP.Slides
            ReplaceTextBox ppS, ImageSource, MatchText
        Next
        
        Set ppS = Nothing
        Set ppP = Nothing
        Exit Sub
    ExceptionHandler:
        MsgBox Err.Description
    End Sub

    Hope it can help you.

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.


    Thursday, February 7, 2013 3:42 AM
    Moderator