こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル★複数画像を一括挿入するマクロについて

仕事でエクセルを使っています。商品番号順に複数の商品画像を一括挿入したいと思っています。
仕入れに使う画像なので、その日によって並べたい種類や枚数も違います。

そこで、下記マクロを参考にさせていただいて、まさにこのように上から下へ画像を並べたいのですが、
http://pc.nikkeibp.co.jp/article/NPC/20071101/286186/?P=1

なぜか画像を挿入すると、指定した画像が全部重なって表示されます。
(dataシートの一番下の画像が一番上になる順番で重なっています。)
画像貼り付けの場所も、サンプルだとpictureシートのB2にぴったり合うはずが、私がコード通りするとB4の途中から貼り付けられてしまいます。

位置の修正だけでもできないかと思って、若干修正したのですが、画像を上から下へ順番に貼り付ける方法がどうしてもわかりません!(ちなみにエクセル2007使用中です)

どなたか詳しい方、ご教授お願いいたします!

-----------------------------------------------------------------------------
一応自分なりに修正したマクロを貼り付けます。マクロ初心者で至らぬ点も多いかと思いますが何卒よろしくお願いいたします。

Sub MakeThumbnail()
Dim myDataCnt As Long
Dim myNo As Long
Dim i As Long
Dim myRow As Long
Dim myName As String

myDataCnt = Worksheets("data").Range("A1").End(xlDown).Row
myNo = 1
myRow = 2

Worksheets("picture").Select
Do Until myNo > myDataCnt
myName = Worksheets("data").Cells(myNo, 1).Value

Cells(myRow, 2).Select
ActiveSheet.Pictures.Insert(myName).Select

With Selection
.Left = Range("A1").Left
.Top = Range("A1").Top
.ShapeRange.LockAspectRatio = msoTrue '縦横比を固定するコマンド
.ShapeRange.Width = 30 '縦横比固定、幅のみを指定する
End With
myRow = myRow + 1
myNo = myNo + 1
Loop

End Sub

投稿日時 - 2011-12-06 13:49:28

QNo.7174421

すぐに回答ほしいです

質問者が選んだベストアンサー

1.画像がどこに保存してあるのか確認します
  先日のご相談でしたが下記の回答2を参考にしてください。
 http://oshiete1.nifty.com/qa7169328.html

2.データシートのどこにデータがあるのかイマイチ不明ですが,仮にA1から記入してあるとします
 #通常は1行目は表のタイトル行にして,2行目からデータを記入するものですが


3.データシートには「画像のファイル名」が拡張子付きで正しく記入してあるとします
 pict1.jpgといった具合に。

4.「どこに」画像を貼りたいのか,相変わらずご説明がありません。



作成例:
sub macro2()
 dim myPath as string
 dim r as long

’準備
 mypath = "c:\どこかのフォルダ\画像フォルダ\"
 worksheets("Picture").select
 on error resume next

’画像の拾い上げと挿入
 for r = 1 to worksheets("data").range("A65536").end(xlup).row
  with activesheet.pictures.insert(mypath & worksheets("data").cells(r, "A").value)
   .top = cells(r+1, "B").top
   .left = cells(r+1, "B").left
   .shaperange.lockaspectratio = msotrue
   .width = 30
  end with
 next r
end sub

投稿日時 - 2011-12-06 17:12:52

お礼

ご回答ありがとうございました!おかげ様でうまく出来ました!

画像は、「C:\Users\ユーザー名\Dropbox\商品画像」というフォルダに入っておりました。
貼り付けたい場所は、picture(白紙シート)でしたので、教えていただいたとおり「dataシート」に「"商品番号".jpg」を並べて記載してマクロを実行したところ、思い通りの動作で大変うまくできました!!!
ありがとうございます!

つたない説明で至らないところが多かったにもかかわらず、大変親切に教えてくださりありがとうございました!!

投稿日時 - 2011-12-06 17:32:50

ANo.3

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

ブックを,画像を入れてあるのと同じフォルダに放り込む
マクロに慣れたら,画像フォルダの場所を直接指定しても良い

sub macro1()
 dim myPath as string
 dim myFile as string
 dim r as long
 dim p as long

’準備
 mypath = thisworkbook.path & "\"
 myfile = dir(mypath & "*.jpg")
 r = 1   ’開始行
 p = 2   ’貼り付け行ピッチ
 worksheets("Pictrue").select

’画像の拾い上げと挿入
 do until myfile = ""
  with activesheet.pictures.insert(mypath & myfile)
   .top = cells(r, "A").top
   .left = cells(r, "A").left
   .shaperange.lockaspectratio = msotrue
   .width = 30
  end with
  r = r + p
  myfile = dir()
 loop
end sub

マクロを実行すると,フォルダにある画像を吸い上げてPictrueシートに貼り付ける。

投稿日時 - 2011-12-06 15:09:11

補足

ありがとうございます。
ご教授いただいたマクロを実行してみたところ、教えていただいたとおりフォルダに入っている画像が全部並んで貼り付けることができました。

しかし、やりたいことですが、毎日貼りたい画像が違うので(1000以上ある商品の中から仕入れしたい商品の画像だけを貼り付けたい関係で)、dataシートに書いてある画像だけ貼り付けたいのです。

恥ずかしながら、上記マクロでどのようにdataシートの商品を指定をしたらいいのかわかりません。。
「mypath = thisworkbook.path & "\"」を
「mypath =Worksheets("data").Range("A1").End(xlDown).Row」と
書き換えればよろしいでしょうか?不勉強で申し訳ないです。

投稿日時 - 2011-12-06 16:19:53

お礼

大変助かりました!ありがとうございました!

投稿日時 - 2011-12-06 18:20:02

ANo.1

コメントに注意事項 記載いたしました。



Sub MakeThumbnail()
Dim myDataCnt As Long
Dim myNo As Long
Dim i As Long
Dim myRow As Long
Dim myName As String

myDataCnt = Worksheets("data").Range("A1").End(xlDown).Row
myNo = 1
myRow = 2

Worksheets("picture").Select
Do Until myNo > myDataCnt
myName = Worksheets("data").Cells(myNo, 1).Value

Cells(myRow, 2).Select
ActiveSheet.Pictures.Insert(myName).Select

With Selection
'.Left = Range("A1").Left 'コレらを指定することにより
'.Top = Range("A1").Top '毎回A1にインサートするので駄目です
.ShapeRange.LockAspectRatio = msoTrue '
.ShapeRange.Height = 76.5 '高さ指定が抜けてます
.ShapeRange.Width = 102# '
End With
myRow = myRow + 6 '1 は駄目です
myNo = myNo + 1
Loop

End Sub

投稿日時 - 2011-12-06 14:30:53

お礼

早速のご返信ありがとうございます!

ご教授いただいた箇所の削除と、高さ指定、最終4行目を+6に
の合計3箇所
修正してみましたが、画像がやはり重なったままで、A4とB4にまたがって挿入されてしまいます。
エクセル自体の設定でなにかまずいのでしょうか?

投稿日時 - 2011-12-06 14:44:50

あなたにオススメの質問