| |
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
|
|
γ
- 18/5/22(火) 20:43 -
mk
- 18/5/22(火) 17:53 -
よろずや
- 18/5/22(火) 17:12 -
hoyahoyamachine
- 18/5/21(月) 12:10 -
