#  Other Applications & Softwares  > Word Formatting & General >  >  Word VBA select Shape(1) and InlineShape(1) HELP

## marylin123

Hi all,

I have a macro in MS Word that replaces the header and footer and any text that matches requirements from a master document into all other documents in a a directory.
This works perfectly.

I have also got the macro working to select the InlineShape in the documents and replace it with an inline shape from the master document.
The problem I'm having is trying to do this with a Shape (image set behind text).

The select and replace functions dont seem to work and when I have got them working the image isnt replaced in the same place in the document.

Any help would be appreciated as I'm going crazy trying to get this to work!!

Thanks



Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String
Dim wdDocSrc As Document, wdDocTgt As Document, HdFt As HeaderFooter
Dim aStory As Range
Dim aField As Field
Dim oldFilename As String
Dim bmRange As Range
Dim Response As Integer
Dim i As Long
Dim imgLogo As InlineShapes


Set wdDocSrc = ActiveDocument
strDocNm = wdDocSrc.FullName
strFolder = GetFolder
    If strFolder = "" Then Exit Sub
        strFile = Dir(strFolder & "\*.doc", vbNormal)

                'Check the user has selected the correct directory to rebrand - if no Exit sub
                Response = MsgBox(prompt:="Are you sure you want to apply template changes to: " & strFolder & "!", Buttons:=vbYesNo, Title:="Tom's Rebranding Tool")
                If Response = vbNo Then Exit Sub

            While strFile <> ""
        If strFolder & "\" & strFile <> strDocNm Then


        Set wdDocTgt = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)



With wdDocTgt


'Replace text as per table in template
Dim oRow As Row
Dim oCell As Cell
a = 2
b = 1
x = 2
y = 2

For Each oRow In ActiveDocument.Tables(1).Rows

Replace1 = ActiveDocument.Tables(1).Cell(a, b)
Insert1 = ActiveDocument.Tables(1).Cell(x, y)

scellTExt = Replace1
dcellTExt = Insert1

scellTExt = Left$(Replace1, Len(Replace1) - 2)
dcellTExt = Left$(Insert1, Len(Insert1) - 2)

    With .Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = scellTExt
        .Replacement.Text = dcellTExt
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll

'add 1 to the row number when looping through table
a = a + 1
x = x + 1
    End With
Next oRow

'Set the header in the wdDocTgt the same as in wdDocSrc
      For Each HdFt In .Sections.First.Headers
        If HdFt.Exists Then
          If wdDocSrc.Sections.First.Headers(HdFt.Index).Exists Then
            HdFt.Range.FormattedText = wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
          End If
        End If
        Next
'Set the footer in the wdDocTgt the same as in wdDocSrc
      For Each HdFt In .Sections.First.Footers
        If HdFt.Exists Then
          If wdDocSrc.Sections.First.Footers(HdFt.Index).Exists Then
            HdFt.Range.FormattedText = wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText

                    'FILE NAME CODE
                    'Check if the DocName bookmark exists
                    If wdDocTgt.Bookmarks.Exists("DocName") = True Then
                    'If DocName bookmark does exist do this
                    Set bmRange = wdDocTgt.Bookmarks("DocName").Range
                            'NEW gets the name of the target document and removed the .doc extension
                            oldFilename = wdDocTgt.name
                            If Right(oldFilename, 5) = ".docx" Then
                            oldFilename = Left(oldFilename, Len(oldFilename) - 5)
                                ElseIf Right(oldFilename, 4) = ".doc" Then
                                oldFilename = Left(oldFilename, Len(oldFilename) - 4)

                    'Update bmRange (DocName bookmark) with the file name with no extension
                    bmRange.Text = oldFilename
                            End If
                    End If

                     If wdDocTgt.Bookmarks.Exists("DocName2") = True Then
                    'If DocName bookmark does exist do this

                     Set bmRange = wdDocTgt.Bookmarks("DocName2").Range
                     'set bmRange as blank so as to no duplicate the name
                     bmRange.Text = " "
                        'NEW gets the name of the target document and removed the .doc extension
                            oldFilename = ""
                            oldFilename = wdDocTgt.name
                            If Right(oldFilename, 5) = ".docx" Then
                            oldFilename = Left(oldFilename, Len(oldFilename) - 5)
                                ElseIf Right(oldFilename, 4) = ".doc" Then
                                oldFilename = Left(oldFilename, Len(oldFilename) - 4)

                    'Update bmRange (DocName bookmark) with the file name with no extension
                     bmRange.Text = oldFilename
                     End If
                 End If
                'END FILE NAME CODE

          End If
        End If

      Next

            'IMAGE CHANGE
            'Select and copy the InlineShape in the template
            wdDocSrc.InlineShapes(1).Select
            With Selection
            .Copy
            End With

            'Select the inlineshape in the letter, delete it and paste (already copied the
            'image in the code above) then loop for every inline image in the document.

         For i = wdDocTgt.InlineShapes.Count To 1 Step -1
      wdDocTgt.InlineShapes(i).Select
      With Selection
        .Delete
        .PasteSpecial
      End With
        Next i


                    'Select and copy the SHAPES in the template
                           wdDocSrc.Shapes(1).Select
            With Selection
            .Copy
            End With

                    'Select the SHAPE in the letter, delete it and paste (already copied the
                    'image in the code above) then loop for every inline image in the document.






        'Save changes to the wdDocTgt and close it
      .Close SaveChanges:=True
End With
End If

  strFile = Dir()
Wend
MsgBox "Macro Complete"
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub

----------


## macropod

Try the following. Note that I've streamlined the code somewhat.



```
Please Login or Register  to view this content.
```


PS: When posting code, please use the code tags, indicated by the # symbol on the posting toolbar. Without them (and structured code), it's very much harder to follow what your code is doing.

----------


## marylin123

Hi, Thanks for your help.
The code you have given i now replacing the shapes image however it also adds another copy of the image where the InLineShapes version of it is as well! I need to differentiate between the both shapes as they are in different places and formatted differently in some documents.

----------


## marylin123

Hi,

There is a mix of images in my documents of types:
Behind Text
Infront of Text
Inline

I need a way to select each type individually. - My Inline works (code below) but I can not get it to work with any other types of image.



```
Please Login or Register  to view this content.
```

----------


## macropod

> Hi, Thanks for your help.
> The code you have given i now replacing the shapes image however it also adds another copy of the image where the InLineShapes version of it is as well! I need to differentiate between the both shapes as they are in different places and formatted differently in some documents.



Given that inlineshapes and shapes are processed separately, inlineshapes will be replace only with (as per your spec) the first inlineshape in the source document and each shape will be replaced with the corresponding shape in the source document. So I can't follow what you mean by 'replacing the shapes image however it also adds another copy of the image where the InLineShapes version of it is as well'




> There is a mix of images in my documents of types:
> Behind Text
> Infront of Text
> Inline



If there is a 1:1 relationship between the shapes, that shouldn't matter. If there isn't, then you need to explain how each shape in the source relates to the shapes in the target.

----------


## macropod

Cross-posted at: http://www.vbaexpress.com/forum/show...BA-(-location)

Please read the Cross-Posting policy in rule #8: http://www.excelforum.com/forum-rule...rum-rules.html
Please also read and comply with the corresponding vbaexpress Rules: http://www.vbaexpress.com/forum/show...-Cross-Posting

----------

