I wrote the following macro to update images in Shapes in Word.
The idea was to pass a reference to the shape object and change the Shape.Fill.UserPicture to a given image fill. I was using .PNG files.
It runs, and returns "SUCCESS" with no errors, but the image is not updated. I can't work out why.
Any help would be greatly appreciated.
Note that I commented out the the error catch.
Private Function ReplaceShapeFill(imgFileName As String, ByRef fPath As String, oldShapeName As String, _
useDestAspect As Boolean, aspect As Double) As String
If Right(fPath, 1) <> Application.PathSeparator Then fPath = fPath & Application.PathSeparator
'On Error GoTo onErr
Dim wdDoc As Document
Set wdDoc = ThisDocument
Dim oShapeOld As Object
Set oShapeOld = GetShape(oldShapeName)
oShapeOld.Select
If Selection.ShapeRange.Count = 1 Then
Dim shp As Shape
Set shp = oShapeOld
With shp.Fill
.Visible = msoTrue
.UserPicture fPath & imgFileName
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
ElseIf Selection.InlineShapes.Count = 1 Then
Dim InShp As InlineShape
Set InShp = oShapeOld
With InShp.Fill
.Visible = msoTrue
.UserPicture fPath & imgFileName
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
End If
ReplaceShapeFill = "SUCCESS"
Exit Function
onErr:
ReplaceShapeFill = "FAIL"
End Function
Public Function GetShape(titleStr As String) As Object
Dim oShp As Object
For Each oShp In ThisDocument.Shapes
If oShp.Title = titleStr Then
Set GetShape = oShp
Exit Function
End If
Next oShp
For Each oShp In ThisDocument.InlineShapes
If oShp.Title = titleStr Then
Set GetShape = oShp
Exit Function
End If
Next oShp
End Function
Bookmarks