VBA

社員名簿の作成です。
ExcelのB列に社員番号、C列に名前があります。
A列に顔写真をフォルダ内から取り出して貼り付けるマクロを教えてください。顔写真は「名前.jpg」となっています。

質問者からの補足コメント

• いけました。理由は、名前に「.jpg」が付いていたからでした。
  色々ありがとうございました。

  No.3の回答に寄せられた補足コメントです。 補足日時：2024/03/20 18:41

No.4 回答者： fujillin 回答日時： 2024/03/20 18:58

No3です。

＞理由は、名前に「.jpg」が付いていたからでした。
それはエラーの原因にはならないはずです。
そのようなデータがあっても、画像が表示されないだけで、処理はされますので。

ですので、エラーが発生したのなら、原因は他にあるはずです。

No.3 回答者： fujillin 回答日時： 2024/03/20 11:57

No2です。

＞mg = imgFolderPathのところでエラーとなります。
あらそうですか・・

ご指摘は、
　img = imgFolderPath & c.Offset(, 2).Text & ".jpg"
の一文であろうと思いますけれど・・
内容的に文字列を連結しているだけなので、エラーになり様がないですね。
当然ながら、当方の環境ではエラーにはなりません。

質問者様がどのような環境で、何を試したのかが不明ですけれど、エラーを発生させるなら変数imgを数値型で宣言しておくくらいしか思いつきません。
あるいは、変数c の設定をしていないか、妙な値を代入してあるとか・・

言ってみれば、
　a = 1 + 3
みたいな内容のセンテンスですので。
実行時に各変数の内容がどうなっているかを確認してみれば、理由がわかるのではないかと想像します。
それでもわからなければ、No2はダメ回答と見做して捨ててください。

この回答へのお礼

折り返し、ありがとうございます。
c.Offset(, 2)　この部分は、言い換えれば、cells(2,3)のことですよね？
違うとすれば、指定しているフォルダが違うのかな？
\がコピペしたら¥になりますけど、いいのかな？
素人ですみません…

お礼日時：2024/03/20 17:19

No.2 回答者： fujillin 回答日時： 2024/03/19 22:29

こんばんは

こんな感じでしょうか？
・1行目はタイトル行と仮定しています
・画像は回転していないものと仮定しています
・画像はセルに左寄せで、サイズ調整して貼り付けます

Sub Q13764919()
Dim c As Range, i As Long, img As String

'画像フォルダーのパス
Const imgFolderPath = "C:\Users\hoge\images\"

For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row
Set c = Cells(i, 1)
img = imgFolderPath & c.Offset(, 2).Text & ".jpg"
If Dir(img) <> "" Then
With ActiveSheet.Shapes.AddPicture(img, msoFalse, _
msoTrue, c.Left, c.Top, -1, -1)
.LockAspectRatio = True
.Placement = xlMove
.Height = c.Height
If .Width > c.Width Then
.Width = c.Width
.Top = c.Top + (c.Height - .Height) / 2
End If
End With
Else
c.Value = "No Image"
End If
Next i
End Sub

この回答へのお礼

ありがとうございます。
img = imgFolderPathのところでエラーとなります。

お礼日時：2024/03/20 09:08

No.1 回答者： mabo52 回答日時： 2024/03/19 22:12

私もVBA初心者です。

https://selifelog.com/blog-entry-1614.html
あたりが参考になるかもしれません。

上記HPのサンプルの，
Sub sample03()
Dim objShape As Object


Set objShape = ActiveSheet.Shapes.AddPicture( _
Filename:="c:¥temp¥image01.jpg", _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=ActiveCell.Left, _
Top:=ActiveCell.Top, _
Width:=ActiveCell.Width, _
Height:=ActiveCell.Height)

End Sub

を加工すれば，できそうな...。

１C列の名前をもとにファイル名を作成。
２ファイル名をもとに上記のサブを呼び出す。（引数に名前を渡すように変更）
３アクティブセルを次へ移動

みたいにすればいいかもです。

この回答へのお礼

ありがとうございます。参考にしてみます。

お礼日時：2024/03/20 09:54