VBAで選択中の画像の縦横比を100％にする

Excelでマニュアル作成等を行い、スクリーンショットを画像で貼ることがよくあると思います。
この画像の縦横比がおかしくなっていて、画像内の文字が変につぶれていることがありませんか？

特に画像と図形をグループ化していると、ちょっとした動作で縦横比がズレてしまいがちです。

そんなときに、選択中の画像の縦横比を100％に戻すマクロを紹介します。

ExcelVBA

Sub sb選択中の画像の縦横比を100パーセントにする()

    If (TypeName(Selection) <> "Picture") Then
        MsgBox "選択しているものの全部又は一部が画像ではありません。", , "処理終了通知"
        Exit Sub
    End If
    
    Dim shapeObj As ShapeRange   '図形用変数
    Set shapeObj = Selection.ShapeRange
    
    With shapeObj
        .LockAspectRatio = msoTrue   '縦横比が固定
        .ScaleHeight 1, msoTrue      '縦横比が固定の場合、高さ・幅のどちらかを100％にすれば自動でもう一方も100％になる）
    End With

End Sub

なお、画像ではなく、図形を選択している場合には、元のサイズという概念がそもそもないため、処理せず終了するようにしています。
画像を他に図形とグループ化している場合には、グループ化を解除してから画像のみを選択している状態で実行してください。

個人マクロブックにこのコードを保存して、リボンから実行できるようにしておくと便利です。