Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2475 / 76734

←次へ　｜　前へ→


	【79902】指定のフォルダから画像を取込むマクロ

hiro - 18/5/21(月) 22:38 -


	引用なし

	パスワード

ExcelＶＢＡ　修行中のものです。お世話になります。
さて、標題のとおり画像を取り組むマクロをネットで拾ってきて、使っているのですが、いまいち理解できない部分がありますので質問させて頂きます。
※マクロ自体は正常に稼働します。

【不明な部分】
fileName = Dir(myPath.Items.Item.Path + "\")

この部分ですが、fileNameには一体、どういったﾊﾟｽが入ることに
なるでしょうか？

ちなみに前段の・・・・
' フォルダ選択画面を表示
Set shell = CreateObject("Shell.Application")
Set myPath = shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\")
Set shell = Nothing

では、「C:\画像フォルダ」　を選択しております。

【マクロの全文】

' 指定したフォルダにある画像ファイルを読み込み、EXCELに貼り付ける。
'
Sub EggFunc_pasteDirImage()

' 変数定義
Dim fileName As String
Dim targetCol As Integer
Dim targetRow As Integer
Dim targetCell As Range
Dim shell, myPath
Dim pos As Integer
Dim extention As String
Dim isImage As Boolean

' 選択セルを取得
targetCol = ActiveCell.Column
targetRow = ActiveCell.Row

' フォルダ選択画面を表示
Set shell = CreateObject("Shell.Application")
Set myPath = shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\")
Set shell = Nothing
　　
' フォルダを選択したら...
If Not myPath Is Nothing Then
　　　　
fileName = Dir(myPath.Items.Item.Path + "\")
　　　　
Do While fileName <> ""
　　　　　
' ファイル拡張子の判別
isImage = True
pos = InStrRev(fileName, ".")
If pos > 0 Then
Select Case LCase(Mid(fileName, pos + 1))
Case "jpeg"
Case "jpg"
Case "gif"
Case Else
isImage = False
End Select
Else
isImage = False
End If
　　　　　　
' 拡張子が画像であれば
If isImage = True Then
　　　　　　　　
' 貼り付け先を選択
Cells(targetRow, targetCol).Select
Set targetCell = ActiveCell
　　　　　　　　
' 画像読込み
ActiveSheet.Pictures.Insert(myPath.Items.Item.Path + "\" + fileName).Select
　　　　　　　　
' 画像が大きい場合、画像サイズをセル幅に合わせる
If Selection.Width > targetCell.Width Or Selection.Height > targetCell.Height Then
If Selection.Width / targetCell.Width > Selection.Height / targetCell.Height Then
Selection.Height = Selection.Height * (targetCell.Width / Selection.Width)
Selection.Width = targetCell.Width
Else
Selection.Width = Selection.Width * (targetCell.Height / Selection.Height)
Selection.Height = targetCell.Height
End If
End If
　　　　　　　　　　　　　　　
' 貼り付け先行を+1
targetRow = targetRow + 1
　　　　　　　　
End If
fileName = Dir()
　　　　
Loop
　　　　
MsgBox "画像の読込みが終了しました"
　
End If

End Sub

6 hits

▼

【79902】指定のフォルダから画像を取込むマクロ hiro 18/5/21(月) 22:38