ここから本文です

以前教えていただいたコードを元にしてフォルダの写真を一括で取り込んでいます。

get********さん

2019/3/119:18:51

以前教えていただいたコードを元にしてフォルダの写真を一括で取り込んでいます。

Sub 画像一括取込()
Dim i As Integer
Dim fName, pict, mySp As Shape
Dim myAD1 As String
Dim myAD2 As String

Application.ScreenUpdating = False
fName = Application.GetOpenFilename("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , MultiSelect:=True)
Application.ScreenUpdating = False

If IsArray(fName) Then
For i = 1 To UBound(fName)
Set pict = ActiveSheet.Shapes.AddPicture( _
Filename:=fName(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=Selection.Width, _
Height:=Selection.Height)
ActiveCell.Offset(19, 0).Activate
Next i
End If

Application.ScreenUpdating = True
End Sub

B2:B19 B21:B38 ...と19行おきに結合した所に写真を挿入しています。
この時、B2:B19に写真を取り込んだら D3にフォルダ名 D5にサブフォルダ名 D7にサブフォルダの下のフォルダ名(この中に写真が入っています。)
というようにフォルダ名を表示したいのですが、Dir関数を使えば出来そうなんですが、あちこち記事を見ましたが理解できませんでした。
よろしくお願いします。

閲覧数:
22
回答数:
1
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

taihenda****さん

2019/3/122:08:16

Sub 画像一括取込()
Dim i As Integer, j As Long, k As Long, n As Long, myF
Dim fName, pict, mySp As Shape
Dim myAD1 As String
Dim myAD2 As String
Application.ScreenUpdating = False
fName = Application.GetOpenFilename("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , MultiSelect:=True)
Application.ScreenUpdating = False
If IsArray(fName) Then
For i = 1 To UBound(fName)
k = 5
myF = Split(fName(i), "\")
n = UBound(myF)
For j = n - 1 To n - 3 Step -1
Selection(1).Offset(, 2).Offset(k) = myF(j)
k = k - 2
Next
Set pict = ActiveSheet.Shapes.AddPicture( _
Filename:=fName(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=Selection.Width, _
Height:=Selection.Height)
ActiveCell.Offset(19, 0).Activate
Next i
End If
Application.ScreenUpdating = True
End Sub

質問した人からのコメント

2019/3/1 22:24:33

こんな短時間でズバリの事が出来てしまうなんて驚きです。
私の考えていたとおりの動作でした、ありがとうございました。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる