I have a word document that contains text boxes and some code to change specific text markers to pictures. The problem is that some of the text markers are in a text box and these are not found. The code is below. Can anyone help me adapt it to work with the whole document, including text boxes?
I’ve tried a couple of things using shapes and storyrange but haven’t manged to get anything to work.
Application.ScreenUpdating = False
Dim i As Long, j As Long, StrNm As String, StrErr As String, iShp As InlineShape
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "§[0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
StrNm = .Text
MsgBox StrNm
If StrNm = "§1" Then StrNm = "C:\LetterImages2019\1.jpg"
If StrNm = "§2" Then StrNm = "C:\LetterImages2019\5.jpg"
If StrNm = "§3" Then StrNm = "C:\LetterImages2019\3.jpg"
.Text = ""
If Dir(StrNm) = "" Then
j = j + 1: StrErr = StrErr & vbCr & StrNm
Else
i = i + 1
Set iShp = .InlineShapes.AddPicture(FileName:=StrNm, LinkToFile:=False, SaveWithDocument:=True, Range:=.Duplicate)
With iShp
.Shadow.Style = msoShadowStyleOuterShadow
.Shadow.Type = msoShadow21
.Shadow.ForeColor = WdColor.wdColorBlack
.Shadow.Transparency = 0.6
.Shadow.Size = 100
.Shadow.Blur = 4
.Shadow.OffsetX = 2
.Shadow.OffsetY = 2
.LockAspectRatio = True
.Height = InchesToPoints(1)
If .Width > InchesToPoints(2) Then .Width = InchesToPoints(2)
End With
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True