1
votes

So I have a document with textboxes that contain a picture and caption. I have written a code to loop through the objects, check if the object is a textbox, and if so, copies the text of the caption, clears the textbox, replaces the picture with an updated one, and reinserts the caption.

However, the document has already made cross references that reference the captions. So when I reinsert the captions, the cross references no longer work. I think I can solve this issue by deleting only the picture within each textbox, so the caption stays and the cross references work.

I'm not sure how to reference the picture, though, within my code. Any help would be appreciated!

 For Each objShape In ActiveDocument.Shapes
    If objShape.Type = msoTextBox Then

       str = objShape.TextFrame.TextRange.Text
        If InStr(str, "(") > 0 Then
            captionTag = BetweenParentheses(str)
            If captionTag = imageTag Then
                If InStr(str, "Figure") > 0 Then

                   'problem area
                    Dim objPic As Word.InlineShapes
                    objPic.Delete


                   'does stuff
                    Dim firstTerm As String
                    Dim secondTerm As String
                    Dim caption As String
                    Dim caption2 As String

                    firstTerm = ":"
                    secondTerm = ")"

                    Dim startPos As Long
                    Dim stopPos As Long
                    Dim nextPosition As Long
                    nextPosition = 1

                    caption = objShape.TextFrame.TextRange


                    Do Until nextPosition = 0
                        startPos = InStr(nextPosition, caption, firstTerm, vbTextCompare) + 1
                        stopPos = InStr(startPos, caption, secondTerm, vbTextCompare) + 1
                        caption = Mid$(caption, startPos + Len(firstTerm), stopPos - startPos - Len(firstTerm))
                        nextPosition = InStr(stopPos, caption, firstTerm, vbTextCompare)
                   Loop



                    Set rng = objShape.TextFrame.TextRange
                    Set picture = rng.InlineShapes.AddPicture(fileName:=fullPath, LinkToFile:=False, SaveWithDocument:=True)
                    picture.ScaleHeight = 29.5 
                    picture.ScaleWidth = 29.5
                    rng.InsertCaption Label:="Figure", Title:=": " & caption, position:=wdCaptionPositionBelow, ExcludeLabel:=False

                    With objShape.TextFrame
                        .TextRange.Font.Name = "Calibri Light"
                        .TextRange.Font.Size = 9
                        .TextRange.Font.Color = RGB(79, 129, 189)
                    End With
                    'Next objPic
                End If
            End If
        End If
    End If

Next objShape
2

2 Answers

0
votes

Use the Shape.Fill property

This returns a FillFormat object which is used to add or remove Pictures.

'This will clear the existing picture
objShape.Fill.Solid

'This will set a picture using a path
objShape.Fill.UserPicture ("C:\Users\Public\Pictures\Sample Pictures\Lighthouse.jpg")

Reference:

0
votes

Okay, so the solution was pretty simple... and now I don't have to reinsert the caption and the references are still there.

 Set rng = objShape.TextFrame.TextRange
 rng.InlineShapes(1).Delete
 Set picture = rng.InlineShapes.AddPicture(fileName:=fullPath, LinkToFile:=False, SaveWithDocument:=True)