マクロ初心者です。画像一括挿入について

質問

初めてマクロを使っております。
以下ネットで拾ってきましたコードなのですが、
行いたいのは
(1)挿入するセルを選択（複数可）
(2)画像を一括選択
(3)縦横比率を固定して挿入：横か縦の長さは自分で設定
※今のコードですと(3)で比率の固定ができず、伸びた画像が挿入されてしまいます

これを可能にするには、一体どこをどう変えたらよいのでしょうか。
慣れない画像編集に悪戦苦闘しております。
どなたかご教授いただけますと幸いです。

どうぞよろしくお願い致します。

Sub try()
　　Dim a　 As Range
　　Dim cc　As Range
　　Dim W　 As Single
　　Dim H　 As Single
　　Dim mx　As Long
　　Dim fi　As Long
　　Dim i　 As Long
　　Dim pkfile

　　On Error GoTo extLine

　　With Application
　　　　Set a = .InputBox("画像挿入するセル選択" & vbLf & _
　　　　　　　　　　　　　"複数選択可", _
　　　　　　　　　　　　　"複数画像の一括挿入（セル選択）", _
　　　　　　　　　　　　　Selection.Address, _
　　　　　　　　　　　　　Type:=8)
　　　　pkfile = .GetOpenFilename("すべての図" & _
　　　　　　　　　　　　　"(*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;" & _
　　　　　　　　　　　　　"*.jpe;*.png;*.bmp;*.gif)," & _
　　　　　　　　　　　　　"*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;" & _
　　　　　　　　　　　　　"*.jpe;*.png;*.bmp;*.gif", 2, _
　　　　　　　　　　　　　"挿入する図の選択（複数選択可）", , True)
　　　　If Not IsArray(pkfile) Then
　　　　　　MsgBox "ファイルが指定されていません", , _
　　　　　　　　　 "複数画像の一括挿入"
　　　　　　GoTo extLine
　　　　End If
　　　　W = .InputBox("ヨコ", Type:=1)
　　　　H = .InputBox("タテ", Type:=1)
　　　　.ScreenUpdating = False
　　End With

　　mx = UBound(pkfile)
　　fi = 1
　　For Each cc In a
　　　　If cc.Address = cc.MergeArea.Item(1).Address Then
　　　　　　Call picIns(cc, pkfile(fi), W, H)
　　　　　　fi = fi + 1
　　　　　　If fi > mx Then
　　　　　　　　Set cc = Nothing
　　　　　　　　Exit For
　　　　　　End If
　　　　End If
　　Next

　　For i = fi To mx
　　　　Set a = a(a.Rows.Count, 1).Offset(1)
　　　　Call picIns(a, pkfile(i), W, H)
　　Next
extLine:
　　Set a = Nothing
　　Application.ScreenUpdating = False
　　With err()
　　　　If .Number <> 0 Then MsgBox .Number & ":" & .Description
　　End With
End Sub

Sub picIns(ByVal r As Range, _
　　　　　 ByVal s As String, _
　　　　　 ByVal W As Single, _
　　　　　 ByVal H As Single)

　　With ActiveSheet.Pictures.Insert(s).ShapeRange
　　　　If (W > 0) And (H > 0) Then
　　　　　　.LockAspectRatio = msoFalse
　　　　　　.Width = W
　　　　　　.Height = H
　　　　ElseIf W > 0 Then
　　　　　　.Width = W
　　　　ElseIf H > 0 Then
　　　　　　.Height = H
　　　　End If
　　　　.Left = r.Left
　　　　.Top = r.Top
　　End With
End Sub

回答No.1

SI299792 · ベストアンサー

変更の必要はありません。
縦又は横に０を入力すれば、前の画像と同じ比率になります。
縦を指定したければ、横を0にします。横を指定したければ、縦を０にします。
縦横共に０を入力すれば、前の画像と同じ大きさになります。

お礼

早急なお返事ありがとうございます。
完成が見え、初心者ながらに興奮しております。
お恥ずかしいのですが、ヨコを約2cmにしたい場合はヨコに入力すべき数値はいくつなのでしょうか…重ねて質問で申し訳ありません。
どうかご教授いただけましたら幸いです。

回答No.2

tsubu-yuki

横入りで失礼します。

> ヨコを約2cmにしたい場合はヨコに入力すべき数値はいくつなのでしょうか…
Application.CentimetersToPoints
というメソッドを使うと楽ちんです。
例えば、２ｃｍをポイントに直すなら
　　Application.CentimetersToPoints(2)
といった具合に使います。

今回の場合、コレを使うと良いと考えられるタイミングは２か所。
・変数Ｗ・Ｈに代入するタイミング
　W = Application.CentimetersToPoints(.InputBox("ヨコ（ｃｍで指定）", Type:=1))
・画像の大きさを変えるタイミング
　.Width = Application.CentimetersToPoints(W)
このどちらかで使うのがベターと思われます。