【修習VBA】事例カードの位置図と公図をトリミングするだけのマクロ組んだ

これからVBAとPythonとRを少しずつ書いて覚えていく

使い方
１．位置図や公図を対象不動産がだいたい中央になるようにした画像を用意します
２．Excelに貼り付けて、選択状態にしておきます（複数枚可）
３．マクロを実行するといい感じの大きさになるよ

Option Explicit

Sub 事例カード_画像トリミング()
'
' 事例カード_画像トリミング Macro
' 幅177mm, 高さ830mm
' 選択中のすべての画像について、画像中心部を指定の大きさにトリミングする
    
    Const WIDTH_IN_MILLIMETERS As Double = 177
    Const HEIGHT_IN_MILLIMETERS As Double = 83
    
    Dim widthInPoint As Double  '指定する幅（単位: ポイント）
    widthInPoint = Application.CentimetersToPoints(WIDTH_IN_MILLIMETERS / 10)
    Dim heightInPoint As Double '指定する高さ（単位: ポイント）
    heightInPoint = Application.CentimetersToPoints(HEIGHT_IN_MILLIMETERS / 10)

    Dim pics As ShapeRange  '選択された画像（Shape）のまとまり
    Set pics = ActiveWindow.Selection.ShapeRange
    
    Dim i As Long
    For i = 1 To pics.Count
        'Shapeオブジェクトの取得
        Dim pic As Shape
        Set pic = pics.Item(i)
        
        '切り取る幅（右と左それぞれ）
        Dim cutWidth As Double
        cutWidth = (pic.Width - widthInPoint) / 2
        Debug.Print "切り取る幅: " & cutWidth
        
        '切り取る高さ（上と下それぞれ）
        Dim cutHeight As Double
        cutHeight = (pic.Height - heightInPoint) / 2
        Debug.Print "切り取る高さ: " & cutHeight
        
        '上下左右をそれぞれトリミングする
        With pic.PictureFormat
            .CropRight = cutWidth
            .CropLeft = cutWidth
            .CropTop = cutHeight
            .CropBottom = cutHeight
        End With
    Next

End Sub