Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

32047 / 76734

←次へ　｜　前へ→


	【49926】マクロ式の簡略化

yayo - 07/6/28(木) 18:22 -


	引用なし

	パスワード

アルバムを作成しようとしています。
任意のセル１３行ごとにボタン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

5 hits

▼

【49926】マクロ式の簡略化 yayo 07/6/28(木) 18:22

≪