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.

Code:

---

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

---

The simplest solution is to change your textboxes to single-cell tables, with text wrapping if necessary.

Thanks. I've a play with a table and it seems it may work.

EDIT: Ok it works when I open the document. The problem is the text markers come back once I move to another record. Is there a way to get the code to fire each time I move to another record?

EDIT: I've started a new thread as this is a different question and I can't edit the title.

It sounds like you are previewing the merge and not actually merging. Complete the merge and then see what needs to be addressed. See your other thread.
As for your other macro, you are searching in ActiveDocument.Range. Text boxes are not in the activedocument range so will never be found.

Quote:

---

Originally Posted by gmayor

It sounds like you are previewing the merge and not actually merging. Complete the merge and then see what needs to be addressed. See your other thread.
As for your other macro, you are searching in ActiveDocument.Range. Text boxes are not in the activedocument range so will never be found.

---

I'm sorry but I'm not sure what that means. When I open the document I get a dialog asking if I want to run an SQL command SELECT * FROM 'my query'. I have many fields that are linked to this query query some of which are the markers for the pictures I want to insert. Pressing ALT+F9 brings them up. I can click through the different records/recipients in the mailings tab. I just print the ones I want using the quick print in the quick access menu. I can change the quick print button for a marco button that alters the merged marker text to pictures and prints, so this will work. The problem is I can't position the pictures where I want using a table so really need to use a text box, which the vba code doesn't find.

It's nearly there which is quite annoying. I want to change the images so different images will show depending on the recipient. I can code the access query so the markers are different depending on the recipient.


What do you mean by not completing the merge?

This code is able to fint the text box (giving it a numer 12) and find the marker text so surely I must be able to access it?

Code:

---

    Dim shp As Shape    Dim sTemp As String
    Dim iAnswer As Integer


    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            shp.Select
            Selection.ShapeRange.TextFrame.TextRange.Select
            sTemp = Selection.Text
            sTemp = Left(sTemp, 20)
            iAnswer = MsgBox("Box contains text beginning with:" & vbCrLf _
              & sTemp & vbCrLf & "Stop here?" & vbCrLf & Selection.ShapeRange.ID, vbYesNo, "Located Text Box")
            If iAnswer = vbYes Then Exit For
        End If
    Next
Exit Sub

---

So is there any way to edit this into the code at the top to change the text to pictures?

EDIT: I'm nearly there. I can now change the text to pictures in the text box. I just need to make it change the individual text markers and then delete them or move them out of view.

EDIT2: And then delete the images on the other recipients and replace with new ones....

Ok this code does it. I just need to add the print function to it. I have no idea if this will help anyone ever but here you go:

Code:

---

Sub Macro2()

    Dim shp As Shape
    Dim sTemp As String
    Dim iShp As InlineShape
    Dim StrNm As String


    For Each shp In ActiveDocument.Shapes
   
        If shp.Type = msoTextBox Then
        shp.Select
        Selection.ShapeRange.TextFrame.TextRange.Select
        sTemp = Selection.Text
       
        If sTemp Like "*§*" Then
    With Selection.ShapeRange.TextFrame.TextRange
       
    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
    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 = ""


      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
    .Collapse wdCollapseEnd
    .Find.Execute


  Loop
  End With
    End If
    End If
   
    Next
End Sub

---

EDIT: Print function coded in, works like a charm.

Quote:

---

Originally Posted by Agent Smith

The problem is I can't position the pictures where I want using a table

---

Absolute rubbish! You clearly haven't done as advised. Moreover, if you give the table cell a fixed height and width, any picture inserted into it via a mailmerge or VBA will be constrained the fit within those dimensions - at the correct aspect ration for the table. Try that with a textbox!

Quote:

---

Originally Posted by Agent Smith

I want to change the images so different images will show depending on the recipient. I can code the access query so the markers are different depending on the recipient.

---

You don't need VBA for that - a mailmerge can do it all by itself.

Quote:

---

Originally Posted by Agent Smith

What do you mean by not completing the merge?

---

That's what happens when you click on Finish & Merge and choose the appropriate output...

Quote:

---

Originally Posted by macropod

Absolute rubbish! You clearly haven't done as advised. Moreover, if you give the table cell a fixed height and width, any picture inserted into it via a mailmerge or VBA will be constrained the fit within those dimensions - at the correct aspect ration for the table. Try that with a textbox!

You don't need VBA for that - a mailmerge can do it all by itself.
That's what happens when you click on Finish & Merge and choose the appropriate output...

---

Well I tried to insert a table but it messed up the text nearby and I found it hard to position exactly where I wanted. It also moved around depending on the format of the generated letter. You clearly have more experience with layout in word than I do. Maybe you could have explained better. Thankfully I'm not too bad with VBA so have managed a work around, which is all coded in now and working fine. Is there a way to make a table stay in a certain position without moving?

Ok I now understand what you mean by "finish merging". For years I have just clicked through the records printing as I go. I didn't realize you could finalize the document. Given there is a big button I'm not sure why it has passed my by.

The problem I have now is that my sql code is so complex the previews are not updating properly. I will see if I can run vba code and finalize the merge.

Can you finalize a mail merge with vba but process code on each page as you do? I have got code to finalize the mail merge but it doesn't seem to run my picture insertion code.

Instead of messing around with VBA - which is quite unnecessary - you should invest the minimal time needed to deploy a table with the requisite field coding to insert the pictures when the merge is executed. It's hardly rocket science - see, for example, Managing Mailmerge Graphics in the Mailmerge Tips and Tricks thread at: http://www.msofficeforums.com/mail-m...ps-tricks.html

Thanks I have had a read and will investigate more. It may not be rocket science to you but to me it's not far off atm.

Can I ask is there a way to insert a table and make it stay in one place? The way I did it was buy adding a single cell table using the ribbon at the top. The problem is it moves as the length of the letter alters when I want to to stay in the bottom right of the document and not move at all.

I normally edit mergefields by pressing alt+f9. In this case if I have say a fields that is something like {if {MERGEFIELD Data} = 1, "hello", "goodbye"} how would I replace the "hello" and "goodbye" with pictures. And is it possible to apply shadow?

You would need to replace the 'hello' and 'goodbye' with includepicture fields in the correct format. See https://www.gmayor.com/mail_merge_graphics.htm and https://www.gmayor.com/mail_merge_graphics_addin.htm

If you want to fix the image on the page and set the width of the image, then you will find it easier to insert a frame which can be fixed to the page and set with wrapping as required. Insert the field structure in the frame. In all other respects a frame will work in the same way as a table cell. Add the FormatFrame... command from the all commands group to the QAT (Quick Access Toolbar) for ease of access to the frame insertion.

If you want shadow on your images, add it to the images used. This is child's play using SnagIt and its graphics editor (which allows batch processing of graphics).

Quote:

---

Originally Posted by Agent Smith

Can I ask is there a way to insert a table and make it stay in one place?

---

If you set the layout to 'around' wrapping, you can use the positioning options to set it's position exactly the same as you might for a textbox.

Quote:

---

Originally Posted by Agent Smith

if I have say a fields that is something like {if {MERGEFIELD Data} = 1, "hello", "goodbye"} how would I replace the "hello" and "goodbye" with pictures.

---

You really should read the content in the link. Done properly, you don't need an IF test.

Quote:

---

Originally Posted by Agent Smith

And is it possible to apply shadow?

---

No. To achieve something like that, though, you could use a graphics editor to apply the shadow to the pictures themselves.

Try inserting the table in a header/ footer, it is common practice when adding logos that need to be in a specific place.