Works well
I DO have to learn more about the Selection object (and the Range object)
Thanks
Final (for now at least) version:
Sub CopyPictureFormat()
Dim oMaster As InlineShape
Dim i As Long, n As Long
If ActiveDocument.InlineShapes.Count < 2 Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
Set oMaster = Selection.InlineShapes(1)
On Error GoTo 0
If oMaster Is Nothing Then
Call MsgBox("No Inline Shape Selected", vbCritical + vbOKOnly, "Apply Formatting to Other Pictures")
Exit Sub
End If
With ActiveDocument
n = .InlineShapes.Count
For i = 1 To .InlineShapes.Count
If Not oMaster.Range.Start = .InlineShapes(i).Range.Start Then
StatusBar = "Processing Inline Picture " & Right(" " & Format(i, "#,##0"), 5) & " (" & Format(i / n, "0.0%") & ")"
If .InlineShapes(i).Type = wdInlineShapePicture Then
Call PaintFormatToPicture(oMaster, .InlineShapes(i))
End If
End If
Next
End With
StatusBar = vbNullString
Application.ScreenUpdating = True
End Sub
Private Sub PaintFormatToPicture(ByRef oILSRef As InlineShape, oILSTarget As InlineShape)
Dim i As Long, j As Long
'Select it and copy formatting. This grabs most of the attributes (e.g., border, shadow, soften, etc.)
oILSRef.Select
Selection.CopyFormat
'Set the target image.
oILSTarget.Select
Selection.PasteFormat
On Error Resume Next
'Clear all picture effects in the target shape.
For i = oILSTarget.Fill.PictureEffects.Count To 1 Step -1
oILSTarget.Fill.PictureEffects.Item(i).Delete
Next I
'Apply picture effects of source ILS to target ILS
For i = 1 To oILSRef.Fill.PictureEffects.Count
'Insert the effect.
oILSTarget.Fill.PictureEffects.Insert oILSRef.Fill.PictureEffects.Item(i)
'Apply the effect parameters.
For j = 1 To oILSRef.Fill.PictureEffects.Item(i).EffectParameters.Count
oILSTarget.Fill.PictureEffects.Item(i).EffectParameters(j).Value = oILSRef.Fill.PictureEffects.Item(i).EffectParameters(j).Value
Next j
Next I
Selection.Collapse
DoEvents
On Error GoTo 0
End Sub