Several macros for resizing photos to a specific size

I would take a different approach to Diane. I would use a single macro and use modifier keys to vary the size. This would allow you to have a single button to run the macro and you can hold the Shift or Ctrl key to get the other sizes. The following code needs to reside at the top of a module. 

Option Explicit

#If VBA7 Then

  Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer

#Else

  Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer

#End If

Global Const SHIFT_KEY = 16

Global Const CTRL_KEY = 17

Global Const ALT_KEY = 18

Sub ResizeAll()

  Dim tgtHeightCM As Double, oShp As Shape, oILShp As InlineShape

  

  If GetKeyState(SHIFT_KEY) < 0 Then

    tgtHeightCM = 9.86    'If user holds shift key, use size 2

  ElseIf GetKeyState(CTRL_KEY) < 0 Then

    tgtHeightCM = 12.5     'If user holds ctrl key, use size 3

  Else

    tgtHeightCM = 6.55    'default size

  End If

  

  For Each oShp In Selection.ShapeRange

    With oShp

      .LockAspectRatio = msoTrue

      .Height = CentimetersToPoints(tgtHeightCM)

    End With

  Next

  For Each oILShp In Selection.InlineShapes

    With oILShp

      .LockAspectRatio = msoTrue

      .Height = CentimetersToPoints(tgtHeightCM)

    End With

  Next

End Sub

Hi James,
>> when I create the next macro my first one is gone for whatever reason
The first macro disappears when you add the second? Are you using different names for the macros?

I would do it something like this - buttons on the ribbon for small, medium, and large.

Dim picSize As Variant
Sub Large()
picSize = 12.5
sizeone
End Sub

Sub Medium()
picSize = 9.86
sizeone
End Sub

Sub Small()
picSize = 6.55
sizeone
End Sub

Private Sub sizeone()
Dim targetHeight As Integer
Dim oShp As Shape
Dim oILShp As InlineShape
targetHeight = picSize
For Each oShp In Selection.ShapeRange
With oShp
.Width = AspectHt(.Height, .Width, CentimetersToPoints(9))
.Height = CentimetersToPoints(picSize)
End With
Next
For Each oILShp In Selection.InlineShapes
With oILShp
.Width = AspectHt(.Height, .Width, CentimetersToPoints(9))
.Height = CentimetersToPoints(picSize)
End With
Next
End Sub

Private Function AspectHt(ByVal origWd As Long, ByVal origHt As Long, ByVal newWd As Long) As Long
If origWd <> 0 Then
AspectHt = (CSng(origHt) / CSng(origWd)) * newWd
Else
AspectHt = 0
End If
End Function