不動産鑑定士修習戦記ヨッチャム

鑑定及びデータサイエンスの勉強、並びに海岸に事務所を建てる

【修習VBA】物件調書の写真を良い感じに縮小して最背面移動マクロ

物件調書の写真を良い感じに縮小して最背面移動するマクロです
生写真データ大きすぎてそのまま貼り付けると縮小面倒だからべんり!

Sub 物件調書_写真縮小()
' 物件調書_写真縮小 Macro
' 縦横比固定で高さを118mmに縮小し、最背面へ移動する
    
    Const HEIGHT_IN_MILLIMETERS As Double = 118
    
'    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)
        
        '縦横比固定
        pic.LockAspectRatio = True
        
        '高さ指定
        pic.Height = heightInPoint
        
        '最背面へ
        pic.ZOrder msoSendToBack
        
    Next
End Sub