Microsoft Office Forums - View Single Post

macropod · 11-22-2013, 02:55 AM

OK, since F4 isn't working for you folk, try the following macro. In it, there's code to reformat both floating and inline pictures. All you should need to do before running the macro is to set the picture scaling or dimensions to suit your requirements (and Delete/Comment out whichever you don't use), plus tell the macro whether the aspect ratios should be preserved (if you set this to True, you only need to set the scaling or dimensions for either the height or the width). As it runs, each picture (or other 'object') will be selected and you'll be asked whether to resize it. You have Yes, No & Cancel options. Cancelling exits the macro.

Code:

Sub ReformatPics()
Dim oShp As Shape, iShp As InlineShape, Rslt, bLockAspectRatio As Boolean
Dim sngScHght As Single, sngScWdth As Single, sngHght As Single, sngWdth As Single
' Set Pic Dimensions here
bLockAspectRatio = True
sngScHght = 70: sngScWdth = 70
sngHght = CentimetersToPoints(10)
sngWdth = CentimetersToPoints(15)
With ActiveDocument
  For Each oShp In .Shapes
    With oShp
      .Select
      Rslt = MsgBox("Resize this picture?", vbYesNoCancel)
      If Rslt = vbCancel Then Exit Sub
      If Rslt = vbYes Then
        .LockAspectRatio = bLockAspectRatio
        ' Delete/Comment out unused scaling/dimensioning parameters here
        .ScaleHeight sngScHght / 100, True
        .ScaleWidth sngScWdth / 100, True
        .Height = sngHght
        .Width = sngWdth
      End If
    End With
  Next
  For Each iShp In .InlineShapes
    With iShp
      Rslt = MsgBox("Resize this picture?", vbYesNoCancel)
      If Rslt = vbCancel Then Exit Sub
      If Rslt = vbYes Then
        .LockAspectRatio = bLockAspectRatio
        ' Delete/Comment out unused scaling/dimensioning parameters here
        .ScaleHeight = sngScHght
        .ScaleWidth = sngScWdth
        .Height = sngHght
        .Width = sngWdth
      End If
    End With
  Next
End With
MsgBox "Finished Reformatting."
End Sub

PS: In the macro, I've used the 'CentimetersToPoints' conversion. If you prefer, you can use the 'InchesToPoints' conversion, or simply input a number of points with no conversion (e.g instead of CentimetersToPoints(2.54) or InchesToPoints(1) you could insert 72; all give the same result).