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

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

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

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

受付中

セル内の値を含むサブフォルダの写真を張り付ける(ループ処理)

ing0706
ing0706

総合スコア0

VBA

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

2回答

0評価

0クリップ

200閲覧

投稿2022/05/06 05:55

質問です。

以下に親フォルダに含まれるサブフォルダの写真をループ処理で行順に張り付けるコードを作っています。
現状以下コードにて親フォルダ内のすべてのサブフォルダの画像を上から行順に張り付けるコードはできております。
セル(y, 2)の列にサブフォルダーの名前を入力してあるのですが、
親フォルダーのパス + セル内の値 (親フォルダーのパスはInputBoxにて入力)
のファイルパスでサブフォルダーを参照して貼り付けることは可能でしょうか。

よろしくお願いいたします。

Sub テスト写真貼り付け()

Dim alert As VbMsgBoxResult Dim root_dir As String Dim fso As Object Dim sub_dirs As Object Dim sub_dir As Object Dim y As Long alert = MsgBox("実行してよろしいですか?", vbYesNo + vbQuestion, "実行確認") If alert = vbYes Then MsgBox "親フォルダのパスを入力してください。" '←「はい」ボタンをクリックしたときの処理。 End If ' 親フォルダのパス root_dir = InputBox("親フォルダーのパス名の入力" + Chr(10) + "例:C:\Users\xxxx\Desktop\テスト_写真", "親フォルダー確認") If root_dir = "" Then Exit Sub ' フォルダ内のサブフォルダをスキャン Set fso = CreateObject("Scripting.FileSystemObject") Set sub_dirs = fso.GetFolder(root_dir).SubFolders y = 5 For Each sub_dir In sub_dirs ' このサブフォルダについて処理 'y = importImagesFromOneSubDir(sub_dir, y, root_dir) Call imagesFromSubFolder(sub_dir, y) Next

End Sub

Private Function imagesFromSubFolder(sub_dir As Object, ByRef ref_y As Long)

Dim file_name As String 'MsgBox sub_dir.Name ' このフォルダ内の画像をすべて列挙 file_name = Dir(sub_dir & "\*.*") Do While file_name <> "" ' このファイルの拡張子を調べる If isImageFile(file_name) Then 'If file_name <> "" Then すべてのファイルを通す(検証用) ' 画像であれば,取り込んで次の行へ Call importImageFile(sub_dir & "\" & file_name, ref_y) '//フルパスと行数を渡す Debug.Print ref_y & ":" & sub_dir & "\" & file_name ref_y = ref_y + 1 '参照渡しの変数をインクリメント End If ' 次のファイルを取得 file_name = Dir() Loop

End Function

Private Function isImageFile(file_name)

' ピリオドは後ろから何文字目か pos_period = InStrRev(file_name, ".") If pos_period > 0 Then ' 拡張子を切り出し file_ext = LCase(Mid(file_name, pos_period + 1)) ' 画像の拡張子か?(小文字で指定可) If _ file_ext = "jpg" Or _ file_ext = "jpeg" Or _ file_ext = "bmp" Or _ file_ext = "gif" Or _ file_ext = "png" _ Then ' 画像であると判定 ret = True Else ret = False End If Else ret = False End If isImageFile = ret

End Function

'引数 画像ファイル(フルパス), 行数
Private Sub importImageFile(file_name, y)
Dim file_path As String
Dim MyShape As Shape

ActiveSheet.Cells(y, 11).Select Set MyShape = ActiveSheet.Shapes.AddPicture( _ fileName:=file_name, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left + 3.4, _ Top:=Selection.Top + 3, _ Width:=Application.CentimetersToPoints(5.4), _ Height:=Application.CentimetersToPoints(4.05))

End Sub

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

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

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

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

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

meg_

2022/05/06 06:41

> 親フォルダ マクロファイルがあるフォルダの上位フォルダ、という意味でしょうか? > サブフォルダの写真 サブフォルダ内に存在する画像ファイル(jpegとか)のことでしょうか?

まだ回答がついていません

会員登録して回答してみよう

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

ただいまの回答率
87.20%

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

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

質問する

関連した質問

同じタグがついた質問を見る

VBA

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