■ワークシート上のPictureの倍率を取得する（前編

#〆後にレス追加するのも最近億劫になってしまって...

エクセルVBAで、画像の倍率を知るには、どのようにすればいいのでしょう... - 教えて！goo

んぁ、トリミングしてた場合ですね。
基本、考え方は同じで

Option Explicit
'---------------------------------------------------------------------
Sub test() 'Pictureを選択して実行
　　Dim ret

　　If TypeName(Selection) = "Picture" Then
　　　　ret = fGetPicScale(Selection)
　　　　If IsArray(ret) Then
　　　　　　MsgBox "x:= " & ret(0) & vbLf & "y:= " & ret(1)
　　　　End If
　　End If
End Sub
'---------------------------------------------------------------------
Function fGetPicScale(ByRef pic As Picture)
　　Dim xy(0 To 1)　 As Single
　　Dim crop(0 To 3) As Single
　　Dim W　As Single
　　Dim H　As Single
　　Dim LC As Long

　　On Error GoTo errExit
　　With pic.ShapeRange
　　　　With .PictureFormat
　　　　　　crop(0) = .CropTop
　　　　　　crop(1) = .CropLeft
　　　　　　crop(2) = .CropRight
　　　　　　crop(3) = .CropBottom
　　　　　　.CropTop = 0#
　　　　　　.CropLeft = 0#
　　　　　　.CropRight = 0#
　　　　　　.CropBottom = 0#
　　　　End With
　　　　W = .Width
　　　　H = .Height
　　　　LC = .LockAspectRatio
　　　　.LockAspectRatio = msoFalse
　　　　.ScaleWidth 1, msoTrue
　　　　.ScaleHeight 1, msoTrue
　　　　xy(0) = W / .Width
　　　　xy(1) = H / .Height
　　　　.Width = W
　　　　.Height = H
　　　　.LockAspectRatio = LC
　　　　With .PictureFormat
　　　　　　.CropTop = crop(0)
　　　　　　.CropLeft = crop(1)
　　　　　　.CropRight = crop(2)
　　　　　　.CropBottom = crop(3)
　　　　End With
　　End With
　　fGetPicScale = xy
errExit:
End Function

ワークシート上に挿入した画像ファイルの、原型サイズと比較した時の倍率を得るコード。
Pictureを選択して、Selectionに対して処理するようにしてます。

現状画像の退避情報として
・PictureFormatプロパティのトリミングポイント（Top,Left,Right,Bottom）
・サイズ（Width,Height）
・LockAspectRatioプロパティ
以上を記憶します。

ScaleWidthメソッド、ScaleHeightメソッドを使って一旦原型サイズにし、
倍率を計算して取得した後、退避情報を元に処理前に戻します。

（実行例）


Duplicateメソッドで複製して最後に削除すれば、戻す必要がないので簡易的なコードでいけます。

Sub test2() 'Pictureを選択して実行
　　Dim x As Single
　　Dim y As Single

　　If TypeName(Selection) = "Picture" Then
　　　　With Selection.Duplicate.ShapeRange
　　　　　　With .PictureFormat
　　　　　　　　.CropTop = 0#
　　　　　　　　.CropLeft = 0#
　　　　　　　　.CropRight = 0#
　　　　　　　　.CropBottom = 0#
　　　　　　End With
　　　　　　x = .Width
　　　　　　y = .Height
　　　　　　.LockAspectRatio = msoFalse
　　　　　　.ScaleWidth 1, msoTrue
　　　　　　.ScaleHeight 1, msoTrue
　　　　　　x = x / .Width
　　　　　　y = y / .Height
　　　　　　.Delete
　　　　End With
　　　　MsgBox "x:= " & x & vbLf & "y:= " & y
　　End If
End Sub

...と、ここまで書いて、そう言えば2007ではDuplicateメソッドの振る舞いが違ってたなぁと思い出してチェックしてみたら...
全然ダメダメ君でありました...orz

#後編につづく？