シート内の画像サイズをリサイズ（横幅指定）

Sub prcResizeAllImagesToSpecificCm()
    ' インプットボックスからの入力に基づいてシート内の全ての画像を特定のサイズ（cm）に変更する

    Dim shp As Shape
    Dim dblCm As Double
    Dim dblPoints As Double
    Dim strInput As String

    ' インプットボックスでサイズ（cm）を入力させる
    strInput = InputBox("画像のサイズをセンチメートル単位で入力してください（例：3.5）", "画像サイズ変更")

    ' 数値チェックと変換
    If IsNumeric(strInput) Then
        dblCm = CDbl(strInput)
        dblPoints = dblCm * 28.35 ' cmをポイントに変換
    Else
        MsgBox "数値を入力してください。", vbExclamation
        Exit Sub
    End If

    ' シート内の全ての図形に対してループ
    For Each shp In ActiveSheet.Shapes
        ' 図形が画像である場合のみサイズを変更
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Or shp.Type = msoEmbeddedOLEObject Then
            With shp
                .LockAspectRatio = msoTrue
                .Width = dblPoints ' 幅を設定
                ' 高さはアスペクト比を維持して自動調整される
            End With
        End If
    Next shp
End Sub