Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5588 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【49926】マクロ式の簡略化 yayo 07/6/28(木) 18:22 質問[未読]
【49936】Re:マクロ式の簡略化 ｂｙｋｉｎ 07/6/28(木) 23:16 回答[未読]
【49941】Re:マクロ式の簡略化 yayo 07/6/29(金) 16:05 質問[未読]
【49942】Re:マクロ式の簡略化 Jaka 07/6/29(金) 17:29 発言[未読]
【49944】Re:マクロ式の簡略化 ｂｙｋｉｎ 07/6/29(金) 21:55 回答[未読]
【50001】Re:マクロ式の簡略化 yayo 07/7/3(火) 10:35 お礼[未読]
【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
【49936】Re:マクロ式の簡略化
回答  ｂｙｋｉｎ  - 07/6/28(木) 23:16 -
引用なし
パスワード
   こんばんわ。

何か最近似たようなご質問が多いけど・・・（＾＾；；
こういうときにこそApplication.Callerを使うんです。

【１】準備

各ボタンの名前を次のように変更しておきます。
２行目のボタン：ボタン 1
１５行目のボタン：ボタン 2
２８行目のボタン：ボタン 3
　　・
　　・
２６２行目のボタン：ボタン 21

※上記例は一応デフォルトの名前に合わせてあります。

【２】マクロコード（標準モジュール）

Public Sub InsertPicture()
　　Dim fName As Variant
　　Dim PicTop As Single
　　Dim PicLeft As Single

　　fName = Application.GetOpenFilename _
　　　　　　("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像挿入")

　　If fName = False Then
　　　 Exit Sub
　　End If
　　
　　Application.ScreenUpdating = False

　　'↓クリックしたボタンの名前の5文字目以降の数値を取り出して
　　'↓挿入位置を計算している
　　With Cells((Val(Mid$(Application.Caller, 5)) - 1) * 13 + 2, 2)
　　　　PicTop = .Top
　　　　PicLeft = .Left
　　End With
　　
　　With ActiveSheet.Pictures.Insert(fName)
　　　　.Top = PicTop
　　　　.Left = PicLeft
　　　　.Height = 234#
　　　　.Width = 312#
　　End With
　　Application.ScreenUpdating = True
End Sub

【３】該当ボタン全部を選択して上記マクロを登録します。

こうすれば、１個のプロシージャで全てまかなえます。

※変数はDimでちゃんと宣言してから使うことをお勧めします。

試してみてな。
ほな。
【49941】Re:マクロ式の簡略化
質問  yayo  - 07/6/29(金) 16:05 -
引用なし
パスワード
   ▼ｂｙｋｉｎ さん：

早速教えていただき、ありがとうございました。
Application.Callerを使うと、
１個のプロシージャで全てまかなえ、
とてもすっきりしたコードになりました。
感激しました。ありがとうございました。

ただ、ボタンの名前を数字のみにした場合、
一つ目以降の数値を見に行くように、
With Cells((Val(Mid$(Application.Caller, 1)) - 1) * 13 + 2, 2)
とすると、デバックとなります。
これは、どうしてでしょうか。

また、ボタンを使わず、
任意のセルをダブルクリックすると、
その右隣のセルに画像を挿入することは可能でしょうか。

たとえば、b1のセルをダブルクリックすると、
ｂ２のセルに、自動的に縮小された画像を挿入したいのです。
この場合の、セル位置の指定方法が分かりません。

もし、この方法が可能なら、
後から入れ忘れた画像を挿入する場合も、
セルをコピーすれば、行位置が変わっても、
そのままコードを利用できるのでは・・と思うのですがいかがでしょうか。
たびたび申し訳ありませんが、どうぞ宜しくお願いいたします。


>こんばんわ。
>
>何か最近似たようなご質問が多いけど・・・（＾＾；；
>こういうときにこそApplication.Callerを使うんです。
>
>【１】準備
>
>各ボタンの名前を次のように変更しておきます。
>２行目のボタン：ボタン 1
>１５行目のボタン：ボタン 2
>２８行目のボタン：ボタン 3
>　　・
>　　・
>２６２行目のボタン：ボタン 21
>
>※上記例は一応デフォルトの名前に合わせてあります。
>
>【２】マクロコード（標準モジュール）
>
>Public Sub InsertPicture()
>　　Dim fName As Variant
>　　Dim PicTop As Single
>　　Dim PicLeft As Single
>
>　　fName = Application.GetOpenFilename _
>　　　　　　("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像挿入")
>
>　　If fName = False Then
>　　　 Exit Sub
>　　End If
>　　
>　　Application.ScreenUpdating = False
>
>　　'↓クリックしたボタンの名前の5文字目以降の数値を取り出して
>　　'↓挿入位置を計算している
>　　With Cells((Val(Mid$(Application.Caller, 5)) - 1) * 13 + 2, 2)
>　　　　PicTop = .Top
>　　　　PicLeft = .Left
>　　End With
>　　
>　　With ActiveSheet.Pictures.Insert(fName)
>　　　　.Top = PicTop
>　　　　.Left = PicLeft
>　　　　.Height = 234#
>　　　　.Width = 312#
>　　End With
>　　Application.ScreenUpdating = True
>End Sub
>
>【３】該当ボタン全部を選択して上記マクロを登録します。
>
>こうすれば、１個のプロシージャで全てまかなえます。
>
>※変数はDimでちゃんと宣言してから使うことをお勧めします。
>
>試してみてな。
>ほな。
【49942】Re:マクロ式の簡略化
発言  Jaka  - 07/6/29(金) 17:29 -
引用なし
パスワード
   ▼yayo さん：
>ただ、ボタンの名前を数字のみにした場合、
どうやってしたのかわからないけど、単純に
Msgbox Application.Caller
で、どんな文字が取得されているのか確認した方が良いです。

>(Val(Mid$(Application.Caller, 1)) - 1) * 13 + 2
が
((0 - 1) * 13 + 2
ってなっているからじゃないかと....。

>たとえば、b1のセルをダブルクリックすると、
>ｂ２のセルに、自動的に縮小された画像を挿入したいのです。
>この場合の、セル位置の指定方法が分かりません。
シートのWクリックイベントを利用したらどうですか。
そうすれば

Target.Left
Target.Width
Target.Height

こんなのでセルのサイズがわかります。
検索すれば、そのもののコードが見つかると思います。
【49944】Re:マクロ式の簡略化
回答  ｂｙｋｉｎ  - 07/6/29(金) 21:55 -
引用なし
パスワード
   こんばんわ。

>ボタンの名前を数字のみにした場合、
>一つ目以降の数値を見に行くように、
>With Cells((Val(Mid$(Application.Caller, 1)) - 1) * 13 + 2, 2)
>とすると、デバックとなります。
>これは、どうしてでしょうか。

ボタンの名前を数字のみには出来へんと思うねんけど・・・（＾＾；；
どーやって数字のみにしたんでっか？？？

名前やのうて、キャプションを数字のみにしったてことなんとちゃうかなー
（名前(Name)とキャプション(Caption)の違いはヘルプを参照）

>任意のセルをダブルクリックすると、
>その右隣のセルに画像を挿入することは可能でしょうか。

こっちについては、Jakaはんのおっしゃるとおり、ダブルクリックイベント
ってのがあります。
ま、イベントプロシージャが鬱陶しくないんやったら、使ってみてな。
（わては絶対使いまへんが・・・）

ほな。
【50001】Re:マクロ式の簡略化
お礼  yayo  - 07/7/3(火) 10:35 -
引用なし
パスワード
   ｂｙｋｉｎ さん、Ｊａｋａさん、
お礼が遅くなって申し訳ありません。
色々ご指導、ありがとうございました。

ボタンの名前とキャプションを混同していたようです。
ボタンを右クリックして、ボタンの編集をしていただけでした。
知識不足でせっかくのアドバイスが理解できなくてすみません。

ダブルクリックイベントについては、
まだまだ勉強不足で・・(>_<)
ｂｙｋｉｎ さんに教えていただいたとおり、
With Cells((Val(Mid$(Application.Caller, 5)) - 1) * 13 + 2, 2)を使って、
作成して、ようやく望みのものが完成しました。

本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5588 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free