VBA 画像の部分拡大表示を作る(その１)

最近作りたいマクロがある。

Wordでマニュアルを作る際に、操作のスクリーンショットを貼り付けたりするが、全体と部分を同時に見せたいので以下のようなテクニックを使用する。

f:id:t-hom:20150710234556p:plain

ただし、これはいちいち手で作るのが非常に面倒くさい。
できればWordマクロにしてしまいたいが、まずはマクロの記録を備えたExcelでやってみることにした。

方法はなんとなく見えている。まず画像を同じ場所にコピーして、赤枠のLeft,Top,Width,Heightからトリミングのサイズを割り出し、画像をトリムする。そしてズームしてシャドウと赤枠をつけたら適当な場所にずらせて台形を描画する。

これもいきなり全部は難しいので、まずは幅を任意サイズにトリムするところから取りかかる。

手動でトリムするには、図ツールの右端のトリミングをクリックする。
f:id:t-hom:20150711060510p:plain

さて、マクロの記録で以下のようにトリムしてみたところ、
f:id:t-hom:20150711060331p:plain

次のようなコードが出力された。

Sub Macro2()
'
' Macro2 Macro
'

'
    ActiveSheet.Shapes.Range(Array("Picture 12")).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementLeft 41.9738582677
    Selection.ShapeRange.ScaleWidth 0.7562591791, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 172
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 148
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = -20
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
End Sub

HeightやOffsetYは縦幅の話なので一旦削除して、Picture12固定になっているところを選択画像に対する処理に置き換えると、次のように整形できる。

Sub 画像トリム()
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .IncrementLeft 41.9738582677
        .ScaleWidth 0.7562591791, msoFalse, msoScaleFromTopLeft
        .PictureFormat.Crop.PictureWidth = 172
        .PictureFormat.Crop.PictureOffsetX = -20
    End With
End Sub

良く分からない数字が並んでいるけど、調べてみたら次の値と一致する。
f:id:t-hom:20150711062443p:plain

ステップ実行してみると、どうやら次のような処理をしているらしい。
1)一旦ずらす(IncrementLeft)
2)縮める(ScaleWidth)
3)現在のサイズで、中身の伸縮率を元のサイズにもどす(Crop.PictureWidth)
4)画像の中央を基準でサイズが戻ってしまうので、カットサイズの半分の幅で表示位置をずらす。
f:id:t-hom:20150711063727p:plain

なんでそんなややこしいことをするかな。。

ひょっとしてScaleWidthの基準点を右下に変更すればIncrementLeftを省けるんじゃないか。

以下、実験してみたらうまくいった。

Sub 画像トリム()
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .ScaleWidth 0.7562591791, msoFalse, msoScaleFromBottomRight
        .PictureFormat.Crop.PictureWidth = 172
        .PictureFormat.Crop.PictureOffsetX = -20
    End With
End Sub

あとは、カットするサイズを変数で定義して、各要素を計算式に置き換えてやれば左のトリムは完成

Sub 画像トリム()
    
    leftCutSize = 40
    
    With Selection.ShapeRange
        OriginalWidth = .Width
        .LockAspectRatio = msoFalse
        .ScaleWidth (OriginalWidth - leftCutSize) / OriginalWidth, msoFalse, msoScaleFromBottomRight
        .PictureFormat.Crop.PictureWidth = OriginalWidth
        .PictureFormat.Crop.PictureOffsetX = leftCutSize / 2 * -1
    End With
End Sub