- ベストアンサー
VBAを使ったエクセルでの画像複数表示
VBA初心者です。エクセルで商品カタログを作るため、品番に紐付いた商品画像ファイルをエクセル上に読み込む方法は他の回答から分かったのですが(http://oshiete1.goo.ne.jp/qa2880877.html)、見る限り「1シート=1商品」というものしか見つけられませんでした。同シート上に2つ以上の「品番⇒画像」という表示をするためのVBAはどのように組めばよろしいでしょうか? VBAもよく勉強しないで恐縮ですが、どなたかご回答いただけますでしょうか?宜しくお願い致します。
- daibon1209
- お礼率100% (3/3)
- オフィス系ソフト
- 回答数3
- ありがとう数5
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
>現行の「A列入力⇒B列表示」の発展系で、「XXに入力⇒XXに表示」 >というように個別に指定することは可能なのでしょうか? 可能です。 >fn = .Cells(i, 1).Value >Set r = .Cells(i, 2) ここで使っているCellsプロパティは Cells(行, 列)...で指定します。 この『列』である 1(A列) や 2(B列) を変更すれば良いです。 .Cells(i, "A").Value など文字列で指定する事もできます。 都度入力方式にしたいなら、変数を使って下記のようにします。 Sub try3() Dim r As Range '表示セル用 Dim fd As String 'フォルダ用 Dim fn As String '画像ファイル名用 Dim x1 As String 'ファイル名列用 Dim x2 As String '出力先列用 Dim n As Long '最下行用 Dim i As Long 'Loopカウンタ With Application x1 = .InputBox("ファイル名の列入力" & vbLf & "ex) A", Type:=2) If x1 = "False" Then Exit Sub x2 = .InputBox("出力先の列入力" & vbLf & "ex) B", Type:=2) If x2 = "False" Then Exit Sub End With If Len(x1) = 0 Or Len(x2) = 0 Then Exit Sub fd = FDselect("画像フォルダ選択") If Len(fd) = 0 Then Exit Sub On Error GoTo errHndlr With ActiveSheet n = .Cells(.Rows.Count, x1).End(xlUp).Row If n = 1 And Len(.Cells(1, x1).Value) = 0 Then Exit Sub Application.ScreenUpdating = False For i = 1 To n fn = .Cells(i, x1).Value If Len(fn) > 0 Then Set r = .Cells(i, x2) If Len(Dir(fd & fn)) > 0 Then With .Pictures.Insert(fd & fn).ShapeRange .LockAspectRatio = msoTrue .Left = r.Left .Top = r.Top .Height = r.Height End With End If End If Next End With errHndlr: Set r = Nothing Application.ScreenUpdating = True If Err.Number <> 0 Then MsgBox Err.Number & vbLf & Err.Description End Sub 'FolderSelectFunction Private Function FDselect(ByVal s As String) As String Dim obj As Object Dim ret As String Set obj = CreateObject("Shell.Application") _ .BrowseForFolder(0, s, 0) If obj Is Nothing Then Exit Function On Error Resume Next ret = obj.self.Path & "\" If Err.Number <> 0 Then ret = obj.Items.Item.Path & "\" Err.Clear End If On Error GoTo 0 Set obj = Nothing FDselect = ret End Function ただ、最初に書いてますが >>VBAもよく勉強しないで恐縮ですが、 >ではメンテナンスの時に困りますから、よく勉強してくださいね。
その他の回答 (2)
- end-u
- ベストアンサー率79% (496/625)
可能性としてはフォルダ名や拡張子が違う事などが考えられます。 また、『入力しても』とありますが 入力後自動で実行されるわけではなく、 入力してリストアップした後に、マクロを実行しなければいけません。 (おわかりかと思いますが念の為) それでは、拡張子込みでファイル名を書き出してテストしてみましょう。 Sub test() Dim r As Range '表示セル用 Dim fd As String 'フォルダ用 Dim fn As String '画像ファイル名用 Dim i As Long '行カウントアップ用 fd = "D:\image\" With ActiveSheet .UsedRange.ClearContents .Pictures.Delete Application.ScreenUpdating = False fn = Dir(fd & "*.jpg") '拡張子を変更する必要があれば変更のこと Do Until Len(fn) = 0 i = i + 1 .Cells(i, 1).Value = fn Set r = .Cells(i, 2) With .Pictures.Insert(fd & fn).ShapeRange .LockAspectRatio = msoTrue .Left = r.Left .Top = r.Top .Height = r.Height End With fn = Dir() Loop End With Set r = Nothing Application.ScreenUpdating = True End Sub 上記はアクティブなシートをクリアして、A1セルから下へ "D:\image\"フォルダ直下の拡張子jpgファイルの一覧を書き出します。 それと同時にB列に画像を読み込みます。 読み込みが成功したら、ファイル名を確認してみてください。 一応、前回のコードを拡張子込みでリストアップしたものに対応させるように変更すると Sub try2() Dim r As Range '表示セル用 Dim fd As String 'フォルダ用 Dim fn As String '画像ファイル名用 Dim n As Long '最下行用 Dim i As Long 'Loopカウンタ fd = "D:\image\" With ActiveSheet n = .Cells(.Rows.Count, 1).End(xlUp).Row If n = 1 And Len(.Cells(1, 1).Value) = 0 Then Exit Sub Application.ScreenUpdating = False For i = 1 To n fn = .Cells(i, 1).Value If Len(fn) > 0 Then Set r = .Cells(i, 2) If Len(Dir(fd & fn)) > 0 Then With .Pictures.Insert(fd & fn).ShapeRange .LockAspectRatio = msoTrue .Left = r.Left .Top = r.Top .Height = r.Height End With End If End If Next End With Set r = Nothing Application.ScreenUpdating = True End Sub こんな感じです。
お礼
早々のご回答ありがとうございます。 イメージ通り画像が出るようになりました!ありがとうございます。 また、お時間あるときに教えていただければありがたいのですが、 現行の「A列入力⇒B列表示」の発展系で、「XXに入力⇒XXに表示」 というように個別に指定することは可能なのでしょうか? 違うフォーマットのカタログも作る必要がありまして、その際に 非常に重宝しそうです。
- end-u
- ベストアンサー率79% (496/625)
こんにちは。 A1セルから下へ、画像ファイル名のC:\Users\Public\Pictures\Sample Pictures\xxx.jpg などの xxx という、拡張子を除いた名前だけが入力されているとします。 そのA列をLoopして、隣のB列に、セルの高さに合わせて画像を配置します。 事前に、ファイル名を入力し、その行高を広げておいてください。 コード内でフォルダは固定させています。変更必要です。 Sub try() Dim r As Range '表示セル用 Dim fd As String 'フォルダ用 Dim fn As String '画像ファイル名用 Dim n As Long '最下行用 Dim i As Long 'Loopカウンタ fd = "C:\Users\Public\Pictures\Sample Pictures\" '変更要 With ActiveSheet n = .Cells(.Rows.Count, 1).End(xlUp).Row If n = 1 And Len(.Cells(1, 1).Value) = 0 Then Exit Sub Application.ScreenUpdating = False For i = 1 To n fn = .Cells(i, 1).Value & ".jpg" If Len(fn) > 4 Then Set r = .Cells(i, 2) If Len(Dir(fd & fn)) > 0 Then With .Pictures.Insert(fd & fn).ShapeRange .LockAspectRatio = msoTrue .Left = r.Left .Top = r.Top .Height = r.Height End With End If End If Next End With Set r = Nothing Application.ScreenUpdating = True End Sub >VBAもよく勉強しないで恐縮ですが、 ではメンテナンスの時に困りますから、よく勉強してくださいね。
お礼
早速ご回答ありがとうございました。 非常に分かり易く御説明いただいており、手順も明確なのですが、 入力しても画像が表示されません。。 画像フォルダはローカルディスクD直下の「image」フォルダに 入れているため、 fd = "D:\image\" と変更はしました。 A列には「image」フォルダ内に入っているJPEGデータファイル の拡張子を除いたファイル名を入力しました。 何か間違えてますでしょうか?
関連するQ&A
- エクセルvbaでインターネットの履歴を書き出したい
http://oshiete1.goo.ne.jp/qa5082258.html でも質問したものですが、 エクセルvbaでインターネットの履歴をシートに書き出すことは可能でしょうか? For Each...Next ステートメントとかで 取得できそうな気もしないでもないような、、、 何かわかる方よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで、テキストボックスに値を入れる(3)
質問がバラバラになってしまってすみません! エクセルVBAで、テキストボックスに値を入れる(1)の 回答13で、 データシートの何行目~何行目までを印刷させる方法(Sheet7にボタン) をさせるには、どうしたら良いでしょうか?宜しくお願いします。 前回のURL:http://oshiete1.goo.ne.jp/kotaeru.php3?qid=79173 http://oshiete1.goo.ne.jp/kotaeru.php3?qid=85389
- ベストアンサー
- オフィス系ソフト
- 画像を使ったアンケートにご協力下さい。
最近、画像にはまっております。皆様の素晴しい画像を拝借してちょっとしたテストです。 質問は簡単で以下のNEKOGABURIの回答を順々に見て頂いて、この質問の意図が理解できるまでに何枚の画像を見たのかを答えて頂きたい。 http://oshiete1.goo.ne.jp/qa4814745.html http://oshiete1.goo.ne.jp/qa4814279.html http://oshiete1.goo.ne.jp/qa4813877.html http://oshiete1.goo.ne.jp/qa4814850.html http://oshiete1.goo.ne.jp/qa4814537.html http://oshiete1.goo.ne.jp/qa4814457.html http://oshiete1.goo.ne.jp/qa4810439.html http://oshiete1.goo.ne.jp/qa4779535.html 回答は「~枚」って感じで宜しくお願いいたします。 ※解答欄にネタばれはしないでくださいね。多くの人にデフォルトの状態で見て頂きたいもので。
- 締切済み
- アンケート
- エクセルの表を綺麗に画像にしたい
http://oshiete1.goo.ne.jp/qa3094703.html?ans_count_asc=1 の方法を使用してエクセルの表を画像にしたのですが はっきりと綺麗に見えてくれません。 何か解決策はないでしょうか? やはり直接Photoshopなどでこまごま作るしかないのでしょうか? よろしくお願いしますm(__)m
- ベストアンサー
- オフィス系ソフト
- エクセルで画像のハイパーリンクを一括表示させる方法
エクセルに貼り付けた画像にハイパーリンクをしています。 過去の質問を調べ、セルの文字に張ったハイパーリンクのURLを一括で読み取る方法はわかったのですが、画像に張ったハイパーリンクを一括で読み取る方法はありますか? もし、ありましたら教えて下さい。 よろしくお願いします 参考にした過去の質問 http://oshiete1.goo.ne.jp/qa1545446.html
- ベストアンサー
- オフィス系ソフト
- エクセル 関数を自動的に入力するVBAで困っています
VBA初心者です。 エクセルの入力シートで行ごとにデータを下記のように入力しています。 A B C 1 日付 品番 商品 2 10/25 10 りんご 3 10/26 20 みかん 4 5 6 2行目から順にデータを入力すると自動的にC列にVBAで VLOOKUP関数をセットして商品を検索したいのですが 上手くできませんでした。 教えてください。よろしくお願いします。
- 締切済み
- その他(プログラミング・開発)
- エクセルVBAで複数のファイルをひとつにまとめる
はじめまして。 VBA初心者で恐縮なのですが、教えてください。 ブックAAAがあるフォルダ内に複数ある「***.xls」の全てのフイルのシート「A」内の特定のセル(A1:F30)の文字列を、全てブックAAAの1つのシートの特定の列(A:F)に重ねてまとめたいと思っています。 但し、シート「A」は非表示となっていて、また、「***.xls」のファイルは全て「ブックの保護」がかかっているため、シート「A」を表示させるためにはパスワードの入力が必要となります。 これをVBAを使って実行することは可能でしょうか。複雑で手に負えず行き詰っています。 どなたかご存知の方いらっしゃいましたらご教授願います。 エクセル2007を使用しております。
- 締切済み
- Visual Basic
- EXCELで、複数シートの同じセルを一覧にして表示する方法
EXCELで、複数シートの同じセル(たとえば、複数シートのB5)を、べつの1枚のシートに特定の列に表示する方法を教えてください。シートには名前が付いていますが、コピーしたい順に左から並んでいます。 下記にINDIRECT関数を使用する方法が記載されていましたが、マクロを使用した方法を教えてください。 マクロに関しては全くの素人ですが宜しくお願いいたします。 http://oshiete1.goo.ne.jp/qa1727203.html
- 締切済み
- Windows XP
- EXCELのVBAで画像並べ替え
EXCEL2007のVBAを使って、GUIでシート内の縦に並んだ画像を表示して選択し、 矢印の「↑」「↓」をクリックして並び順を替えれるようにしたいと思っております。 EXCEL2003まではフリーソフトの「画像操作.xla」を使って出来ていたのですが、 EXCEL2007以降のバージョンでは使えなくなりました。 まずは、ユーザーフォームの中にシート中の縦に並んだ画像をプレビューとして表示するには どのようにすればいいのでしょうか? 参考になるサイトや書籍などでもかまいませんので、ご教授お願い致します。
- 締切済み
- その他MS Office製品
- VBAで抽出した画像の数枚をフォームに表示
VBAで指定したURLにある画像を抽出し、その画像をExcelシートに貼るものを作りましたが、そのうち3枚くらいをユーザフォーム上にも表示したいのですが、どのように記述したらよいでしょうか? 教えていただけたら幸いです。
- 締切済み
- Excel(エクセル)
お礼
ご回答ありがとうございます。 おんぶにだっこで恐縮です。VBA勉強します!