質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

838閲覧

指定先に複数枚の画像を貼り付けたい

kitagawasho

総合スコア28

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/12/11 06:14

前提・実現したいこと

保存されている画像をExcelシートの指定の場所に貼り付ける。

簡単な説明として、
・Excelには「input」「チェックシート」の2つのシートがあります。
・「input」には画像の格納先のパスを入力する場所(B4セル)とマクロ実行のボタンがあります。
・「チェックシート」には画像のファイル名(拡張子なし)がF列に書かれている。
・今回はG列に画像を貼り付けていきたい。その時、左(F列)の名前と画像の名前が一致したとき、G列に貼り付けたい。

発生している問題・エラーメッセージ

シートの移動をするだけで終わってしまう。 既存の似ているものを少し変更して作成しようとしているため 自分自身あまりプログラムの内容を理解できていないため修正箇所がわかりません。

該当のソースコード

VBA

1Private Sub CommandButton1_Click() 2 Call call_PasteImage 3End Sub 4 5'【Path取得セル】"INPUT"シート 6Public Const pathClm As Integer = 2 'B 7Public Const pathRow As Integer = 4 8 9Function call_PasteImage() 10Dim objShape As Object 11Dim strFileName As String 12Dim strImgName As String 13Dim ImagePath As String 14 15ImagePath= Cells(pathRow, pathClm) 16strFileName = Dir(ImagePath& "*.bmp") 17 18Sheets("チェックシート").Select 19 20 Do Until Len(strFileName) = 0 21 strImgName = Left(strFileName, Len(strFileName) - 4) 22 23 Cells.Find(What:=strImgName).Activate 24 ActiveCell.Offset(0, 1).Activate 25 26 Set objShape = ActiveSheet.Shapes.AddPicture( _ 27 fileName:=ImagePath_SYI & strFileName, _ 28 LinkToFile:=False, _ 29 SaveWithDocument:=True, _ 30 Left:=ActiveCell.Left, _ 31 Top:=ActiveCell.Top, _ 32 Width:=ActiveCell.Width, _ 33 Height:=ActiveCell.Height) 34 35 strFileName = Dir() 36 Loop 37 38End Function

試したこと

ここに問題に対して試したことを記載してください。

補足情報(FW/ツールのバージョンなど)

ここにより詳細な情報を記載してください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Y.H.

2019/12/11 07:51

B4セル には具体的にどのような値が入っているのでしょうか? "C:\temp\Images\"とかでしょうか?最後に"\"は付けてますか?
kitagawasho

2019/12/11 07:54

>B4セル には具体的にどのような値が入っているのでしょうか?C:\work\01_実作業 >最後に"\"は付けてますか? つけていないです。
kitagawasho

2019/12/11 08:40

すみません。1つ追加で質問さしてください。 現在エラー文で、 実行エラー’91’; オブジェクト変数またはWith変数が設定されていません。 となってしまいました。 Cells.Find(What:=strImgName).Activateの部分が色塗りされている状態です。 何が原因かわかりませんか?
Y.H.

2019/12/11 10:59

ここに書いても気付かれないので、質問を編集し質問に記載しましょう。
Y.H.

2019/12/12 03:23

>シートの移動をするだけで終わってしまう。 という発生している問題に対して私の回答では解決済みになりませんか? 別質問として後続の質問を立てられてますので、質問者さんご自身で自己回答として経緯を記載されこの質問は解決済みにされてはどうでしょうか。
guest

回答2

0

自己解決

strFileName = Dir(ImagePath& ".bmp")
上記の文を下記の文に変更
strFileName = Dir(Range("B4").Value & "
.jpg")

変更したことにより、パスが通り画像が貼られるようになった

投稿2019/12/12 04:06

kitagawasho

総合スコア28

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

以下のようにするとfindRangeNothingなどが入ってないでしょうか?
Cells.Findは検索したけど見つからなかった場合に、Nothingを返すのでActivateがエラーになります。

VBScript

1'Cells.Find(What:=strImgName).Activate 2'↓ 3Dim findRange as Range 4Set findRange = Cells.Find(What:=strImgName) 5findRange.Activate

B4セル には具体的にどのような値が入っているのでしょうか?C:\work\01_実作業
最後に""は付けてますか?

つけていないです。

以下のようにB4セルの値と、"*.bmp"を連結しているので、
B4セルの値がC:\work\01_実作業だと
C:\work\01_実作業*.bmpというファイルを探して存在しないため何も処理されないです。

VBScript

1strFileName = Dir(ImagePath& "*.bmp")

C:\work\01_実作業*.bmpというファイルを探さなければなりません。

B4セルの値の最後に\を付けるか、以下のようにしてください。

VBScript

1If Right(ImagePath,1) = "\" Then 2 strFileName = Dir(ImagePath& "*.bmp") 3Else 4 strFileName = Dir(ImagePath& "*.bmp") 5End If

投稿2019/12/11 08:01

編集2019/12/11 10:58
Y.H.

総合スコア7914

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問