複数のセル入力時のたびに自動実行されるイベントマクロを使い、それぞれの入力値と同じ画像を決まったセルに貼り付けようとするVBAをつくろうとしています。
画像サイズ加工(サイズ調整、トリミング)は同じものとします。
更に、画像がないセルに関しては、画像が挿入されるそれぞれのセルに
”画像登録がありません”と表示される。
入力セル=B3:B10 画像挿入セル=F2,F9,F16,F23,F30,F37,F44,F51
できれば、勉強の為に’コメント説明付のご回答をお願いします。
No.3ベストアンサー
- 回答日時:
こんにちは。
>到底たどり着けないコードでした。
VBA力というのかな、囲碁などで言う、棋力と同じようにいうなら、それをすべてを組み入れられるのは、2段クラスぐらいかな?(どこかの県知事の名目剣道2段とはちょっと違います) 半年や1年のレベルでは、無理だと思います。ただ、この範囲は、掲示板での回答の範囲です。(そうでない場合は、お断りしているケースもあります)
でも、世の中は広いというか、怖いもので、プログラミングの経験がなくても、数ヶ月であっけなく上位クラスまで到達するような人もいます。ただ、一般的に簡単なBASIC コードでも、使いこなせられる人は、10人に1人だといわれていました。そういう私は、もうWindowsも扱うことはなかろうと思っていたのが、あるきっかけで、使い始めて、VBAも紆余曲折で覚えました。しかし、今、何年やっても、1週間もやっていないと、VBAがさび付いてきます。毎日のように、VBAのコードを触っていないとダメなのです。年のせいか、すべてのレベルが下降中です。(ここ数ヶ月パワーダウンしてしまっています)
>多くの変数宣言が必要なのですね。
掲示板のVBAの継続している回答者として、変数を宣言しないのは、みっともないのです。そうしないと指摘されることがあるからです。
>・入力セルとは、何を入れるのでしょうか?
> セルへの入力内容は、画像のファイル名を入力します
了解しましたが、もっとややこしいですね(^^;
>・次に、画像は一定のものですか?
> 一定のもので、"D:\写真\"というフォルダに複数の画像”・・・・.jpg"が入って います。
上の条件で、了解です。
>・画像が挿入される、という判定を画像でするのでしょうか?
> 判定は、入力セルの値と画像のファイル名の合致でおこないます。
>画像の判定で更に変数が必要でしょうか。
変数自体は関係がありませんが、画像の判定の件は、ちょっと保留にしていただきたいのです。理由は、ファイル名は、AlternativeTextに書き込むようにしましたが、今の段階では、セル位置の対応があるようですから、セル位置の対応にしました。問題があるようなら、おっしゃってください。今のコードでは、画像を移動すると、処理できなくなります。画像のNameプロパティには入れるのはやめました。同じものを入れると、ぶつかってしてしまうからです。
'シートモジュール
'--------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim PicName As String
Dim pic As Picture
Dim arAD As Variant
Dim c As Variant
'画像の場所
Const PICPATH As String = "D:\写真\"
'挿入セルの場所
Const arADD As String = "F2,F9,F16,F23,F30,F37,F44,F51"
arAD = Split(arADD, ",")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B3:B10")) Is Nothing Then Exit Sub
i = (Target.Row - 3) * 7 + 2
Application.ScreenUpdating = False
If Target.Value <> "" Then
PicName = Target.Value
'拡張子の判定
If InStr(1, PicName, ".jpg", 1) = 0 Then PicName = PicName & ".jpg"
'ファイルの有無
If Dir(PICPATH & PicName) = "" Then
MsgBox PicName & " は、見つかりません。"
Exit Sub
End If
With ActiveSheet.Pictures.Insert(PICPATH & PicName)
.Top = Cells(i, 6).Top
.Left = Cells(i, 6).Left
'ファイル名を封入
.ShapeRange.AlternativeText = PicName
End With
Else
ClearPIC Cells(i, 6)
End If
Range(arADD).ClearContents
Application.EnableEvents = False
For Each c In Range(arADD)
If IsPIC(c) = False Then
c.Value = "画像登録がありません."
End If
Next c
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'
Private Function IsPIC(ByVal rng As Range)
'画像がセルにあるか判定する関数プロシージャ
Dim pic As Picture
Dim flg As Boolean
flg = False
For Each pic In ActiveSheet.Pictures
With rng
If Not Intersect(pic.TopLeftCell, rng) Is Nothing = True Then
flg = True: Exit For
End If
End With
Next pic
IsPIC = flg
End Function
'
Private Function ClearPIC(ByVal rng As Range)
''画像を削除する関数プロシージャ
Dim pic As Picture
For Each pic In ActiveSheet.Pictures
With rng
If Not Intersect(pic.TopLeftCell, rng) Is Nothing = True Then
pic.Delete
End If
End With
Next pic
End Function
変更要点は部分は、順不同でよいので、思いつくまま箇条書きにして結構です。
ブロックごとに修正しますので、これ以上は、関数プロシージャか、イベント本体を分割してアップします。ただし、繰り返しで恐縮しますが、コメントアウトで解説するのは、コメントアウトもコードの一部ですので、後々、やりにくくなってしまいます。これは、謹んでお断りします。
大変、大変ありがとうございました。
私のイメージした動きになりました。あとは本を見ながら、加工アレンジしてみます。
正直、ここまで親切、丁寧にタダで教えて頂ける方がいらっしゃるとは思いませんでした。
今、私の会社で取引しているベンダーさんなら、3人日の請求はされていたような
内容と思います。(^^;
本当に心より感謝いたします。ありがとうございました。
No.2
- 回答日時:
こんにちは。
#1さんの言い方とは違いますが、掲示板は、あくまでも、質問している方のお手伝いするスタイルになっています。[丸投げ]という言葉が、どういうものか、また、ここのカテゴリの削除対象の規約にあるか分かりませんが、
しかし、質問が理路整然となっていれば、文章だけで、回答者が何も言わないでも、質問者に答えることは可能なのですが、今回のご質問では、不足した部分が多いのです。また、それ以上に、ご質問者さんが想像するよりも、遥かに難しい内容だからということもあるのですが。
それは、画像がセルの上に存在するかどうかは、画像の全部を当たらなければ判定できないのです。そういう判定のコードをイベントの中に置くというのは、あまり合理的なコードではありません。
>できれば、勉強の為に’コメント説明付のご回答をお願いします。
以下は、分からないところがあればお教えできますが、予め解説をいれるのはお断りします。理由は、ひとつは、回答は、教えるためではなく、あくまでも、自分のために書いているのですが、もうひとつは、必要以上のコメントを入れるというのは、自分のコーディング・スタイルを壊すことになるからです。コメントもひとつのコードの中にあるものです。あるレベルに達している人は、それなりに、自分のコーディング・スタイルを持っているものなのです。
>入力セルとは、何を入れるのでしょうか?
>次に、画像は一定のものですか?
>画像が挿入される、という判定を画像でするのでしょうか?
この部分がわかりませんので、こちらで、勝手に考えさせていただきました。なお、バージョンに依存する部分があるような気がします。今回は、Ver.2003 で開発しました。
'シートモジュール (シートタブから、コードの表示で貼り付ける)
'-----------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim pic As Picture
Dim arAD As Variant
Dim c As Variant
'画像の場所
Const PICNAME As String = "D:\My Pictures\goo.gif"
'挿入セルの場所
Const arADD As String = "F2,F9,F16,F23,F30,F37,F44,F51"
arAD = Split(arADD, ",")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B3:B10")) Is Nothing Then Exit Sub
i = (Target.Row - 3) * 7 + 2
Application.ScreenUpdating = False
If Target.Value <> "" Then
With ActiveSheet.Pictures.Insert(PICNAME)
.Top = Cells(i, 6).Top
.Left = Cells(i, 6).Left
End With
Else
ClearPIC Cells(i, 6)
End If
Range(arADD).ClearContents
Application.EnableEvents = False
For Each c In Range(arADD)
If IsPIC(c) = False Then
c.Value = "画像登録がありません."
End If
Next c
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Function IsPIC(ByVal rng As Range)
'画像がセルにあるか判定する関数
Dim pic As Picture
Dim flg As Boolean
flg = False
For Each pic In ActiveSheet.Pictures
With rng
If Not Intersect(pic.TopLeftCell, rng) Is Nothing = True Then
flg = True: Exit For
End If
End With
Next pic
IsPIC = flg
End Function
Private Function ClearPIC(ByVal rng As Range)
'画像を削除する関数プロシージャ
Dim pic As Picture
For Each pic In ActiveSheet.Pictures
With rng
If Not Intersect(pic.TopLeftCell, rng) Is Nothing = True Then
pic.Delete
End If
End With
Next pic
End Function
大変ご丁寧な説明ありがとうございました。
VBAにチャレンジしたばかりで、質問内容もチンプンカンプンになってしまい、
申し訳ございません。やはり、多くの変数宣言が必要なのですね。
私には、到底たどり着けないコードでした。
補足として、セルへの入力内容は、画像のファイル名を入力します。
>入力セルとは、何を入れるのでしょうか?
セルへの入力内容は、画像のファイル名を入力します
>次に、画像は一定のものですか?
一定のもので、"D:\写真\"というフォルダに複数の画像”・・・・.jpg"が入って います。
>画像が挿入される、という判定を画像でするのでしょうか?
判定は、入力セルの値と画像のファイル名の合致でおこないます。
画像の判定で更に変数が必要でしょうか。
ずうずうしい注文で、申し訳ありませんが、お時間の許す限りでご指導願います。
質問方法もやさしくお教えいただき感謝いたします。
No.1
- 回答日時:
質問文を工夫すること。
B3:B10の1つのセルに画像ファイル名を入力すると、シートの対応するセルの位置にその画像を表示したい。
質問が丸投げ(規約違反)になっている。その上回答者に注文まで着いている。
ーー
こんなの挿入ー図ーファイルからのマクロの記録をとれば骨格は判る。質問の処理のためにコードのどこを変えればよいか考えること。
マクロの記録ぐらいとって勉強しましたか。
(1)シートのChangeイベントで処理のコードを囲む
(2)入力セルと画像位置の対応のセルの割り出しの一方法(参考)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row >= 3 And Target.Row <= 10 Then
MsgBox Cells((Target.Row - 3) * 7 + 2, "F").Address
Else
MsgBox "範囲外"
End If
End Sub
をテストとしてやってみて、納得のこと。
(3)GOOGLEで
「エクセル 画像 挿入 VBA」で照会すればコード例もたくさん出る
事項だ。
Google照会などWEB照会して、勉強しましたか。
したのなら、質問が細かい点になるはず。
この回答への補足
ご回答ありがとうございました。
申し訳ありません。確かに質問文が不足していました。
しかも、B3:B10というのも間違えです。
B3入力時は、F2へ画像挿入 B4入力時は、F9へ画像挿入といった形にしたいのです。
御指導宜しくお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Excel(エクセル) エクセル、画像ファイル名の書かれたセル(複数個所)に画像を一括で表示させる方法 1 2023/04/19 00:19
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/04/21 13:46
- Excel(エクセル) エクセル表作成について 5 2023/03/12 13:25
- Excel(エクセル) エクセル関数のXlookupのフィルハンドル機能(類した機能でも可)を知りたいです。 3 2022/09/20 20:02
- Excel(エクセル) 【関数】選択した文字列にしたがって、文字を選んで表示する 2 2023/07/13 22:44
- Excel(エクセル) エクセルにサムネイル画像組み込み 2 2022/09/02 17:13
- Excel(エクセル) Excel 毎日手作業で時間がかかって、泣きたいです、、、VBAのプロの方、助けてください。。。 3 2022/10/25 04:26
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) ハイパーリンク で『指定されたファイルを開くことが出来ません』 3 2023/04/25 18:02
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelのチェックボックスの使い...
-
エクセルで指定したセルのどれ...
-
対象セル内(複数)が埋まった...
-
【エクセル】IF関数 Aまたは...
-
貼り付けで複数セルに貼り付けたい
-
エクセルのセルの枠を超えて文...
-
Excelで数式内の文字色を一部だ...
-
(Excel)数字記入セルの数値の後...
-
エクセル オートフィルタで絞...
-
複数のセルのいずれかに数字が...
-
EXCEL VBA セルに既に入...
-
Excelでのコメント表示位置
-
エクセル 足して割る
-
セルをクリック⇒そのセルに入力...
-
エクセルの一つのセルに複数の...
-
【Excel】 セルの色での判断は...
-
Excelで住所を2つ(町名迄と番...
-
excelの特定のセルの隣のセル指...
-
枠に収まらない文字を非表示に...
-
エクセル “13ヶ月”を“1年1ヶ月...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで指定したセルのどれ...
-
【エクセル】IF関数 Aまたは...
-
貼り付けで複数セルに貼り付けたい
-
対象セル内(複数)が埋まった...
-
Excelで数式内の文字色を一部だ...
-
セルをクリック⇒そのセルに入力...
-
Excelでのコメント表示位置
-
エクセル 足して割る
-
excelのCOUNTIF関数で、『範囲=...
-
EXCEL VBA セルに既に入...
-
エクセル オートフィルタで絞...
-
エクセルのセルの枠を超えて文...
-
(Excel)数字記入セルの数値の後...
-
エクセルの一つのセルに複数の...
-
【Excel】 セルの色での判断は...
-
Excel2003 の『コメント』の編...
-
エクセル “13ヶ月”を“1年1ヶ月...
-
複数のセルのいずれかに数字が...
-
枠に収まらない文字を非表示に...
-
excelの特定のセルの隣のセル指...
おすすめ情報