画像を指定セルに貼り付けたい

Question

前提・実現したいこと

１つのシート上に、30枚程の写真を指定セルに貼り付けていくツールを作成したいです。
フォルダ内にある写真を【ファイル名】で指示して【指定セル】に貼り付けたいです。

現在はセル位置を下記の記述で指定しています。

Sub 写真貼付()

Worksheets("写真").Shapes.AddPicture _
Filename:="C:\Users\Desktop\フォルダ名\ファイル名.JPG", _
      LinkToFile:=False, _
          SaveWithDocument:=True, _
          Left:=0, _
          Top:=363, _
          Width:=437, Height:=325

Worksheets("写真").Shapes.AddPicture _
Filename:="C:\Users\Desktop\フォルダ名\ファイル名.JPG", _
      LinkToFile:=False, _
          SaveWithDocument:=True, _
          Left:=0, _
          Top:=726, _
          Width:=437, Height:=325

’本来はこの後大量に続く。。。。

End Sub

---

30枚以上の写真を貼り付けていくので、いちいち座標を指示をするのではなく
セル指定にして貼り付けていきたいです。
（つまり現在は30枚分手打ちで座標を記述している）

【理想の形】
Left:=0, _
Top:=363, _

の部分が

RANGE("A1")

と指定できる。

【補足】
・写真サイズとセルサイズはぴったりなのでA１セルの左端、もしくは中央に貼り付けられたら最高です。
・初心者でやっとここまでできたので大幅に変えずにできると幸いです。
（AddPictureを使用していたい）

初心者ですが、何卒宜しくお願い致します。

Answer 1

Range("")からLeftとTopを持ってくればいいですね。

方法１：一旦Rangeオブジェクトを退避

Dim r As Range
Set r = Range("A1")
Worksheets("写真").Shapes.AddPicture _
Filename:="C:\Users\Desktop\フォルダ名\ファイル名.JPG", _
      LinkToFile:=False, _
          SaveWithDocument:=True, _
          Left:=r.Left, _
          Top:=r.Top, _
          Width:=437, Height:=325

方法２：直接Rangeを指定

Worksheets("写真").Shapes.AddPicture _
Filename:="C:\Users\Desktop\フォルダ名\ファイル名.JPG", _
      LinkToFile:=False, _
          SaveWithDocument:=True, _
          Left:=Range("A1").Left, _
          Top:=Range("A1").Top, _
          Width:=437, Height:=325

Comments

[noncha930]

一瞬でできました,,,感動です。。
本当にありがとうございます！

追加で質問よろしいでしょうか。

現在わざわざフォルダパスを記述して、そのフォルダ内でしかツールが稼働しない仕様になっています。

▼原因箇所
Filename:="C:\Users\Desktop\フォルダ名\ファイル名.JPG",

フォルダを気にせずに稼働するようにするためにはどのような記述にしたらよろしいでしょうか。
ご教授いただけると幸いですm(_ _)m

[ttyp03]

Excelと同じフォルダに入っているということでしょうか。

[ttyp03]

Excelと同じフォルダに画像があるなら、パスを書かなければカレントフォルダを見てくれます。
Filename:="ファイル名.JPG",

[ttyp03]

画像がどこにあっても動くようにする、ということだと無理ではないですが、現実的に実装が大変かと思います。
ファイルがどこにあるかをPC内を検索しないといけないので。

[ttyp03]

それとも全部のAddPictureにフルパスで指定したくない、ということなら、変数にパスを格納しておいて、AddPictureの時に結合すればよいです。
Dim path As String
path = "C:\Users\Desktop\フォルダ名\"
～
Filename:=path & "ファイル名.JPG",

[noncha930]

A、B、Cとフォルダに写真がたくさん入っていて、
マクロが組んであるエクセルを
各フォルダに格納したうえでマクロを実装させたい、という感じです。

いろいろ書いていただいたのに理解できず申し訳ないです。

[noncha930]

"C:\Users\Desktop\フォルダ名\ファイル名.JPG",

この部分を変数にして、今エクセルが入っているフォルダ！

というような記述に変えたいです。ｍ（__）ｍ

[ttyp03]

＞この部分を変数にして、今エクセルが入っているフォルダ！
これなら最初に書いた方法で大丈夫です。
Filename:="ファイル名.JPG",
ファイル名は固定ってことでいいんですよね？
（A,B,Cどのフォルダにも同じファイルが入っている）

[ttyp03]

それとも、ファイル名を指定せずにExcelと同じフォルダにある画像を全部貼り付ける、でしょうか。

[noncha930]

Worksheets("写真").Shapes.AddPicture _
Filename:="1-1.JPG", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Range("A3").Left, _
Top:=Range("A3").Top, _
Width:=437, Height:=325

Worksheets("写真").Shapes.AddPicture _
Filename:="C:\Users\ngy_haken5\Desktop\写真貼付け\1-2.JPG", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Range("A28").Left, _
Top:=Range("A28").Top, _
Width:=437, Height:=325

Worksheets("写真").Shapes.AddPicture _
Filename:="C:\Users\ngy_haken5\Desktop\写真貼付け\1-3.JPG", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Range("A53").Left, _
Top:=Range("A53").Top, _
Width:=437, Height:=325

[noncha930]

これがずっと続く感じになります・・

教えちただいた通り
Filename:="1-1.JPG", _
にしたところ、写真が貼付けされなくなってしまいました。。

[ttyp03]

C:\Users\ngy_haken5\Desktop\写真貼付け、にExcelファイルは置いてあるんでよね？

[noncha930]

はい！

[noncha930]

写真も入っています

[ttyp03]

こちらの環境ではできているので、Excelを一旦閉じて開きなおしてみてください。

[noncha930]

何度か開きなおしておりますが直りません・・。

[ttyp03]

ダメですか。。。なんでだろう。
ではおまじないで以下を入れてみてください。
ChDir ThisWorkbook.Path
写真貼付関数の最初のところでよいです。

[noncha930]

Sub 写真貼付()

Sheets("写真").Select

On Error Resume Next
''''''''''''''''''''''''''''''''''''''''''''''''''''1ページめ
Worksheets("写真").Shapes.AddPicture _
Filename:="1-1.JPG", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Range("A3").Left, _
Top:=Range("A3").Top, _
Width:=437, Height:=325

Worksheets("写真").Shapes.AddPicture _
Filename:="1-2.JPG", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Range("A28").Left, _
Top:=Range("A28").Top, _
Width:=437, Height:=325

Worksheets("写真").Shapes.AddPicture _
Filename:="1-3.JPG", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Range("A53").Left, _
Top:=Range("A53").Top, _
Width:=437, Height:=325

[noncha930]

パス指定すると貼り付けられます。。

もう一度状況を整理してお伝えすると

デスクトップ上に
【写真貼付け】というフォルダ

そのフォルダの中に
エクセル・写真が格納されている

です。

[ttyp03]

ChDir ThisWorkbook.Path
これはやってみました？

[noncha930]

おまじない見落としていました・・

おまじないを入力したところできました！！

[noncha930]

これはどういった意味になるのでしょうか。

質問ばかりすみません。。

[ttyp03]

いえいえ。
ChDirという関数は、カレントフォルダを変更する命令になります。
おそらく別の処理か何かでカレントフォルダが変更されている、もしくはブックの起動方法がショートカットか何かで別のフォルダから起動されているなど、カレントフォルダがExcelファイルがある場所を指していなかったのが原因になります。
なのでブックが置いてあるパスを取得して、カレントフォルダをそのパスに変更するようにしました。

[noncha930]

なるほど。。。

本当に助かりました！提出時刻に間に合わせることができました
大変感謝しております！！

本当にありがとうございました！！！