Consulting

Results 1 to 15 of 15

Thread: Accessing text boxes in vba to change text to pictures

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    Accessing text boxes in vba to change text to pictures

    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
    Last edited by Agent Smith; 06-05-2019 at 01:23 PM.

Posting Permissions

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