見よう見まねで「全商品画像」フォルダにある画像をJAN入力すると画像がエクセルシートに表示されるものを作成しています。下記は問題なく実行できるのですが、画像が1つのみの表示となります。
エクセルの表はC3,D3,E3,F3,G3,H3,I3, C8,D8,E8,F8,G8,H8,I8 それぞれにJANを入力すると
M4,O4,P4,Q4,R4,S4,T4 M9,O9,P9,Q9,R9,S9,T9 のセルにそれぞれの画像が入るようにしたいです。
私の技術では下記式を複数回コピペしてそれぞれのセル位置を書き換えることしかできません。
For Next を使ってやれればといろいろ調べましたが、さっぱりわかりませんでした。
どなたかアドバイスをお願いします。よろしくお願いします。
Private Sub Worksheet_Change(ByVal Target As Range)
Const trgR As String = "C3" 'JANを入力するセル
Const insR As String = "M4" '挿入画像の左上のセル
Const Path As String = "C:\Users\画像管理\全商品画像\" 'ファイルの格納フォルダ
Const pic As String = ".jpg" '「.(半角)」+ファイルの拡張子"
Dim shp As Shape
Dim buf As String
If Target.Address(0, 0) = trgR Then
For Each shp In ActiveSheet.Shapes '既に表示されている画像を削除する処理
If Not Intersect(Range(insR), Range(shp.TopLeftCell, _
shp.BottomRightCell)) Is Nothing Then
shp.Delete
End If
Next
Range(insR).Select
buf = Dir(Path & Target.Value & pic)
If buf <> "" Then '入力したファイル名があるかチェック
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)
.Height = 93
.Left = .Left + (Selection.Width - .Width) / 2
End With
Else
End If
End If
Target.Offset(1, 0).Select
No.6ベストアンサー
- 回答日時:
#5訂正
なんとなく
'Selectしていないので不要?
'Target.Offset(1, 0).Select と書いてしまいましたが
そのままの
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)・・・
なので セルを選択しないとダメですね
忘れていました、どうしましょう・・
①か②で対応してください
①
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)
の上にinpicCell.Selectを加えるか・・
inpicCell.Selectを加えた場合、
'Target.Offset(1, 0).Select も 実行するようにしてください
②
.Left = .Left + (inpicCell.Width - .Width) / 2
を
.Left = inpicCell.Left + (inpicCell.Width - .Width) / 2
とする
貼り付けた画像の.Leftは初めは貼り付けたセルの.Leftと同じ
なので inpicCell.Leftとすればターゲットセルの位置になりますね
できましたーーー!
このたびは大変お手数をおかけし、また親切に教えていただき、本当にありがとうございました。厚く厚く御礼申し上げます。
No.5
- 回答日時:
やっぱり、説明が下手ですみません・・
コードに説明と添削を加えました。
イベントプロシージャ内ではありますが #4の回答と照らしながら
ブレークポイントなどを設置してステップ実行などで各値、メソッドを確認してみてください
画像のサイズなどは、記載コードのまま、画像リンクされますが・・むしろ良いのかも
Private Sub Worksheet_Change(ByVal Target As Range)
'TargetとOffsetで行うため下記不要
'Dim trgR As String, insR As String
'Const trgR As String = "C3" 'JANを入力するセル
'Const insR As String = "M4" '挿入画像の左上のセル
If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
'OFFSET(lgR ,intC)引き数設定
Dim lgR As Long, intC As Integer
'C列の場合は10列右、それ以外は11列右
If Target.Column = 3 Then intC = 10 Else intC = 11
'入力セルの1行下
lgR = 1
'画像フォルダ・拡張子取得設定
Const Path As String = "C:\Users\画像管理\全商品画像\" 'ファイルの格納フォルダ
Const pic As String = ".jpg" '「.(半角)」+ファイルの拡張子"
Dim shp As Shape
Dim buf As String
Dim inpicCell As Range
'画像挿入セルRange(insR)を入力セルの相対位置Target.Offset(lgR, intC)で変数にセット
Set inpicCell = Target.Offset(lgR, intC)
'Intersect(Target, Range("C3:I3, C8:I8"))で行っているので検証不要
'If Target.Address(0, 0) = trgR Then
For Each shp In ActiveSheet.Shapes '既に表示されている画像を削除する処理
If Not Intersect(inpicCell, Range(shp.TopLeftCell, _
shp.BottomRightCell)) Is Nothing Then
shp.Delete
End If
Next
buf = Dir(Path & Target.Value & pic)
If buf <> "" Then '入力したファイル名があるかチェック
'Range(insR)を入力セルの相対位置 Target.Offset(lgR, intC) 変数inpicCellで代用
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)
.Height = 93
.Left = .Left + (inpicCell.Width - .Width) / 2
End With
Else
End If
End If
'Selectしていないので不要?
'Target.Offset(1, 0).Select
End Sub
不要(書き換え)旧コードはコメントにして残していますので参考にしてください また、環境を作ってテストしていませんので、検証はコピーブックなどで行って下さい
変数は変更したりしていますが、メソッドなどはすでに使われていますので説明は割愛しますが、自身で内容(ロジック・意味)を確認してください。
上手くいかないかも知れませんのでダメな時は知らせてください
ボタンで行う場合の改造は #4を再度確認してトライしてみてください
ありがとうございます!素晴らしいです、C3,E3と入力していくと画像貼付動作します。
ただ2点だけございました。。
・画像はJAN右10列に行かず、真下に行ってしまいます。
Dim lgR As Long, intC As Integer
'C列の場合は10列右、それ以外は11列右
If Target.Column = 3 Then intC = 10 Else intC = 11
'入力セルの1行下
lgR = 1
・既に表示されている画像の削除がうまくいきませでした。。
自分なりに考えたのですが、情けないことにわかりません。。
No.4
- 回答日時:
#3です
②の方法で良いのかな?
すでに書きましたが、
実行範囲制御、定数の見直しなどで対応できると思います
(すでに使われている関数、メソッドのみです)
実行範囲を考えましょう
現状実行分岐は If Target.Address(0, 0) = trgR Then ですね
trgRの値が実行ごとに変われば良いのですが・・これはConst 定数ですね
変数にすれば書き換えられますが・・なんか矛盾があるような・・
例えば Targetが変更されたセルなので trgR=Target.Address(0, 0)
で変数に代入・・のちに分岐? すべてTrueになりますね
C3セルの場合 そもそも Target = Range(trgR)ですからね
そこで、コード内にもあります
If Not Intersect(xxx,yyy) Is Nothing Then を使います
コードの意味は既に使われているので割愛します
例を示すと C3,D3,E3,F3,G3,H3,I3, C8,D8,E8,F8,G8,H8,I8 の入力で実行なので
If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
実行したいコードはこの中に入ります
End If
これで対象入力セルのチェンジで実行出来そうです
次に考える必要があるのは出力セル これも変わりますので・・
どうしましょう。これもすでに使われている Target.Offset(1, 0).Select
Offsetを使います。同様に割愛
入力と出力の関係を確認しましょう。。規則性がありますね良かった
C列に入力時10列右のセル 行は入力セルの1つ下
C列以外は11列右・・・
これもケースによって値が違うので変数に入れるのが簡単
後はそのままでも良さそう・・かな
まとめ
Const trgR As String = "C3" 'JANを入力するセル
Const insR As String = "M4" '挿入画像の左上のセル
これらに関係するコードを見直す
If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
で分岐 if 内はTarget が Range(trgR) と同じ
Offsetを使い画像出力セルを特定する
C3を入力した時の対象セルは Target.Offset(1, 10)
これは Range(insR) と同じ
これが出来れば ボタンなどからまとめて実行 For Next は超簡単です
If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
処理
End If
を
標準モジュールに
For Each Target In Range("C3:I3, C8:I8")
処理
Next
で流用出来ると思います(シートオブジェクトを加える)などはしてください
文才はなく説明べたなのでコードを書いた方が簡単ですけれど
取り合えず説明にチェレンジしてみました。。分らない所は追記してください
No.3
- 回答日時:
こんにちは
示されているコードとなさりたい事を読むと For Next ではないような気がします
現在、C3セルに入力するとM4セルに画像が挿入されるで間違えありませんか
そうすると、まだD3などには、まだJANが入っていないのではないでしょうか
望まれている処理手順はどちらでしょうか
①すべてのJANを入力した後にボタンなどでまとめて処理をする場合
For Nextなど繰り返し処理
②入力の度に画像を挿入する場合は
現在のPrivate Sub Worksheet_Change(ByVal Target As Range)内の
実行範囲制御、定数の見直しなどで対応できると思います
回答ありがとうございます。
記載したVBAはセルC3にJANを入れるとセルM4に画像が出てきます。ただ、1つの設定なので、となりのセル(D3)にJANを入れたらN4に画像がでるようにしたいのです。他のセルも同様にJANに入力するたびに画像が出てくるようにしたいのです。
No.2
- 回答日時:
・・・For~Next・・・
繰り返し処理は、カウンターを回してそのカウンターの値がいくつになったら繰り返し処理を終われ、という構文になります。
そして、このカウンターの値を利用するのが一般的。
For i=1 to 10
Print 100+i
Next i
こんな感じで10個の連続した数字を表示するとかね。
……たぶん、これは理解されていると思います。
(基本中の基本ですからね)
で、次。
・・・セルの指定の仕方・・・
M4セルを指定する場合、
Range("M4")
のようにセル番地を文字列で指定する方法と、
Cell(4,13)
のように行と列を指定する方法があります。
……お気づきですね。
ということで、「Range」ではなく「Cell」を使えば楽に指定できることが分かると思います。
まあ、M列が13列目とか数える必要があって面倒かもしれないけど、
それさえクリアしてしまえばプログラム(Visual Basic for Application の頭文字をとってVBAです)を簡単に作ることができます。
No.1
- 回答日時:
カウンター変数でセル座標を変えるだけです。
セル座標をコンスタントにするのは使いづらくなるだけなので止めたほうが良い。繰り返し処理(For Next)|VBA入門
https://excel-ubara.com/excelvba1/EXCELVBA316.html
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
貼り付けで複数セルに貼り付けたい
-
(Excel)数字記入セルの数値の後...
-
【エクセル】IF関数 Aまたは...
-
エクセルで指定したセルのどれ...
-
エクセルのセルの枠を超えて文...
-
Excelで数式内の文字色を一部だ...
-
エクセルvba (ByVal Targ...
-
【Excel】 セルの色での判断は...
-
Excel 例A(1+9) のように番地の...
-
Excelでのコメント表示位置
-
エクセルの一つのセルに複数の...
-
エクセル 足して割る
-
エクセル オートフィルタで絞...
-
対象セル内(複数)が埋まった...
-
Excelで住所を2つ(町名迄と番...
-
エクセルでオブジェクトを常に...
-
セルをクリック⇒そのセルに入力...
-
Excel2003 の『コメント』の編...
-
枠に収まらない文字を非表示に...
-
Excelで6桁の文字列を時刻に変...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
貼り付けで複数セルに貼り付けたい
-
【エクセル】IF関数 Aまたは...
-
Excelで数式内の文字色を一部だ...
-
エクセルで指定したセルのどれ...
-
(Excel)数字記入セルの数値の後...
-
枠に収まらない文字を非表示に...
-
セルをクリック⇒そのセルに入力...
-
Excelでのコメント表示位置
-
対象セル内(複数)が埋まった...
-
【Excel】 セルの色での判断は...
-
エクセル オートフィルタで絞...
-
エクセル “13ヶ月”を“1年1ヶ月...
-
Excel 例A(1+9) のように番地の...
-
エクセルのセルの枠を超えて文...
-
エクセル 足して割る
-
excelの特定のセルの隣のセル指...
-
エクセルの一つのセルに複数の...
-
Excel for Mac使用中ポインタが...
-
エクセルで住所と建物名を分け...
-
EXCEL VBA セルに既に入...
おすすめ情報
お世話になっています。
教えていただいたもので書き直したのですが、↓回答いただいた中のこの部分がどのようにすればいいのかがわかりません。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
まとめ
Const trgR As String = "C3" 'JANを入力するセル
これらに関係するコードを見直す
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
上記以外書き直したものでC3にJANを入れると画像が指定場所に出てきます。D3にJANを入れると当然反応しないのですが、「Const trgR As String = "C3" 」←これをどう書けばD3やE3も反応するようになるのでしょうか?
お忙しいと存じますが、ご教示いただければ幸いです。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー