VBA Macro To Insert Border For All Images

[BlueStone]

Hi Experts,

I've some documents which contains quite a number of images, mainly screen capture images and I've been doing a manual work to manually add a border to each of these images. It's a very tedious work and very time consuming.

I've tried using a macro to handle the border, but only able to handle 1 image at a time. I've assigned this macro to a keyboard shortcut for ease of execution.

Here is my simple macro code:


Sub BorderMacro()
'
' BorderMacro Macro
'
'
With Selection.InlineShapes(1)
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth100pt
.DefaultBorderColor = wdColorAutomatic
End With
End Sub

Will it be possible to enhance this macro to handle all the existing images and add a border to each of the existing images in MS Word document?

Thank you.


- Blue

[fumei]

Sub BorderMacro()
Dim oInlineShp As InlineShape
For Each oInlineShp In ActiveDocument.InlineShapes
With oInlineShp
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
.Borders.Shadow = True
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth100pt
.DefaultBorderColor = wdColorAutomatic
End With
Next
End Sub

[BlueStone]

Hi fumei,

Thanks for your response and help.

A little magic touch and it works perfectly.

It really helps me a lot :)

Thanks again.


- Blue

[fumei]

It is not magic, and I hope you grasp what is happening.

Declare an InlineShape object
For Each one of those objects in the ActiveDocument InlineShapes collection
do this...
Next one of those objects in the collection


Glad I could help.

[gmcnultnult]

It is not magic, and I hope you grasp what is happening.

Declare an InlineShape object
For Each one of those objects in the ActiveDocument InlineShapes collection
do this...
Next one of those objects in the collection


Glad I could help.

I modded fumei's code because it kept crashing in my doc...this does the trick for me though:

Sub BorderMacro()
Dim oInlineShp As InlineShape
For Each oInlineShp In ActiveDocument.InlineShapes
With oInlineShp
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorAutomatic
End With
End With
Next
End Sub


Regardles, thanks fumei! :thumb