エクセルマクロでサイズを指定して画像を一括貼り付けしたいです。
エクセルマクロでサイズを指定して画像を一括貼り付けしたいです。
前任者が作成したマクロです。写真のサイズを指定したいのですができません。私はマクロ初心者の為このコードは難しくて理解できません。どうかよろしくお願い致します。
Sub 複数画像の挿入()
Dim c, sr, sc, s, rr, pkfile, ar, ac, rc, ccc, ca0
On Error GoTo err
Set a = Application.InputBox("画像挿入するセル選択" _
& Chr(13) & Chr(10) & "複数選択可" _
, "複数画像の一括挿入(セル選択)", Selection.Address, , , , , 8)
Application.ScreenUpdating = False
a.Select
sr = Selection.Row
sc = Selection.Column
rr = sr
pkfile = Application.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 "ファイルが指定されていません", , "複数画像の一括挿入": End
For fi = 1 To UBound(pkfile)
If pkfile(fi) = False Then MsgBox "ファイルが指定されていません", , "複数画像の一括挿入": End
Next fi
n = ActiveSheet.Pictures.Count
Application.DisplayAlerts = False
ar = a.Address
ac = Range(ar).Count
fi = 1
If ac > 1 Then GoTo ech Else GoTo pc
ech:
ca0 = ""
For Each cc In ActiveSheet.Range(ar)
ca = Range(cc.Address).MergeArea.Address
rc = Range(ca).Rows.Count
ccc = Range(ca).Columns.Count
If rc > 1 Or cc > 1 Then
ca = Cells(Range(ca).Row + rc - 1, Range(ca).Column + ccc - 1).Address
End If
If ca0 = ca Then GoTo mne
ca0 = ca
ca = Range(cc.Address).MergeArea.Address
Range(ca).Select
g = ActiveSheet.Pictures.Insert(pkfile(fi)).Name
fl = pkfile(fi)
fi = fi + 1
If fi = UBound(pkfile) + 1 Then GoTo en
mne:
Next
Application.DisplayAlerts = True
a.Select
Exit Sub
pc:
For fi = 1 To UBound(pkfile)
ca = Cells(rr, sc).Address
Range(ca).Select
g = ActiveSheet.Pictures.Insert(pkfile(fi)).Name
fl = pkfile(fi)
rr = rr + 1
Next fi
Exit Sub
en:
Application.DisplayAlerts = True
Application.ScreenUpdating = False
a.Select
Exit Sub
err: MsgBox "選択が正しくありません"
End Sub
お礼
Tacosan様 返答ありがとうございます.解決しました! おっしゃるとおり,マクロ内の後の空白が原因でした. また,前の空白については,実際は 「かくかくしかじかで, \my_command{0} { #1=0ではこっちをえらび } { でないとこっちを選びます. } というマクロを作りたいです.」 という風に中カッコをつけていましてそのためでした. 申し訳ありません,説明不足でした.... 解決できました,ありがとうございます!