Macro to Align Center & Wrap selected image

[Aquinax]

I want a macro to align center and wrap ("top & bottom") a selected image. When creating a custom macro the Format tab disappears and a picture cannot be selected, and I had no luck finding out how the corresponding VBA align and wrap commands are called. Help will be appreciated, thank you.

[gmayor]

The wrap part is simple enough, but the alignment is less so. A floating graphic is not part of the text range and thus does not adopt paragraph formatting with regard to alignment. You must work out the size of the picture and the page it is on (and its orientation) and then place the picture so that its centre aligns with the centre of that page. The following macro should do that whether the image starts as in-line or floating, for A4 or US letter size pages. If you are using some other size of page, then you will have to add the size to the case statements.

Frankly if you want a top and bottom wrap and a centred image, it would make more sense to insert the image in-line in its own paragraph, and centre align that paragraph.


Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 06 Aug 2017
Dim oShape As Shape
Dim lngSize As Long, lngO As Long
Dim lngW As Long, lngPW As Long
Dim lngL As Long
If Selection.InlineShapes.Count = 1 Then
Set oShape = Selection.InlineShapes(1).ConvertToShape
ElseIf Selection.ShapeRange.Count = 1 Then
Set oShape = Selection.ShapeRange(1)
Else
MsgBox "Not a shape"
GoTo lbl_Exit
End If

lngSize = Selection.Sections(1).PageSetup.PaperSize
lngO = Selection.Sections(1).PageSetup.Orientation

Select Case lngSize
Case 7 'A4
If lngO = 0 Then
lngPW = CentimetersToPoints(21)
Else
lngPW = CentimetersToPoints(29.7)
End If
Case 2 'Letter
If lngO = 0 Then
lngPW = CentimetersToPoints(21.59)
Else
lngPW = CentimetersToPoints(27.94)
End If
Case Else
End Select
With oShape
.WrapFormat.Type = wdWrapTopBottom
lngW = .Width / 2
lngL = Selection.Sections(1).PageSetup.LeftMargin
lngPW = lngPW / 2
lngPW = lngPW - lngL
.Left = (lngPW - lngW)
End With
lbl_Exit:
Set oShape = Nothing
Exit Sub
End Sub

[Aquinax]

The wrap part is simple enough, but the alignment is less so. A floating graphic is not part of the text range and thus does not adopt paragraph formatting with regard to alignment. You must work out the size of the picture and the page it is on (and its orientation) and then place the picture so that its centre aligns with the centre of that page. The following macro should do that whether the image starts as in-line or floating, for A4 or US letter size pages. If you are using some other size of page, then you will have to add the size to the case statements.

Frankly if you want a top and bottom wrap and a centred image, it would make more sense to insert the image in-line in its own paragraph, and centre align that paragraph.


Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 06 Aug 2017
Dim oShape As Shape
Dim lngSize As Long, lngO As Long
Dim lngW As Long, lngPW As Long
Dim lngL As Long
If Selection.InlineShapes.Count = 1 Then
Set oShape = Selection.InlineShapes(1).ConvertToShape
ElseIf Selection.ShapeRange.Count = 1 Then
Set oShape = Selection.ShapeRange(1)
Else
MsgBox "Not a shape"
GoTo lbl_Exit
End If

lngSize = Selection.Sections(1).PageSetup.PaperSize
lngO = Selection.Sections(1).PageSetup.Orientation

Select Case lngSize
Case 7 'A4
If lngO = 0 Then
lngPW = CentimetersToPoints(21)
Else
lngPW = CentimetersToPoints(29.7)
End If
Case 2 'Letter
If lngO = 0 Then
lngPW = CentimetersToPoints(21.59)
Else
lngPW = CentimetersToPoints(27.94)
End If
Case Else
End Select
With oShape
.WrapFormat.Type = wdWrapTopBottom
lngW = .Width / 2
lngL = Selection.Sections(1).PageSetup.LeftMargin
lngPW = lngPW / 2
lngPW = lngPW - lngL
.Left = (lngPW - lngW)
End With
lbl_Exit:
Set oShape = Nothing
Exit Sub
End Sub

Thanks,...

I've found this on and it does the job for me ...

Sub CENTER_IMAGE()'
' CENTER_IMAGE Macro
'
'
Dim sh As Word.Shape
Dim ish As Word.InlineShape
On Error Resume Next
Set ish = Selection.InlineShapes(1)
If Not ish Is Nothing Then
Set sh = Selection.InlineShapes(1).ConvertToShape()
Else
Set sh = Selection.ShapeRange.Item(1)
End If
If Not sh Is Nothing Then
sh.LockAnchor = True
sh.WrapFormat.Type = wdWrapTopBottom
sh.Left = wdShapeCenter
End If
End Sub
But thanks anyway, perhaps when I've more time I'll look into your code...