| |
アルバムを作成しようとしています。
任意のセル１３行ごとにボタン20個を作り、
それぞれに、マクロ１〜20（それぞれ、セル位置が違う）を登録して、
画像サイズを自動的に縮小、
任意のセルに貼り付けたいのですが、
現状のままだと、画像サイズを変更しないといけない場合、
マクロ20個それぞれに変更を加えないといけないため、大変です。
この同じ作業の繰り返しを簡略化したいのですが、
以下のdo loop コードを組み込むことで解決するでしょうか。
また、組込み方についても、教えていただきたいのですが。
行の初期値は2
１３行毎に画像を貼り付け、
262行目までループしたいのです。
宜しくお願いいたします。
=========================================================
Sub Macro1()
i = 2
Cells(i, 2).Select
fname = Application.GetOpenFilename _
("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像挿入")
If fname = False Then
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.Pictures.Insert(fname).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 234#
Selection.ShapeRange.Width = 312#
Selection.ShapeRange.Rotation = 0#
End Sub
Sub Macro2()
i = 2 + 13 * 1
Cells(i, 2).Select
fname = Application.GetOpenFilename _
("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像挿入")
If fname = False Then
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.Pictures.Insert(fname).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 234#
Selection.ShapeRange.Width = 312#
Selection.ShapeRange.Rotation = 0#
End Sub
Sub Macro3()
i = 2 + 13 * 2
Cells(i, 2).Select
fname = Application.GetOpenFilename _
("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像挿入")
If fname = False Then
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.Pictures.Insert(fname).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 234#
Selection.ShapeRange.Width = 312#
Selection.ShapeRange.Rotation = 0#
End Sub
|
|
yayo
- 07/6/28(木) 18:22 -
