Sub Loadimage()
fd = ThisWorkbook.Path & "\TEST01\"
Dim Sp As Shape
For Each Sp In sheet1.Shapes
If Sp.Type = 13 Then Sp.Delete
Next
For Each a In Range([B2], [B65536].End(xlUp))
fs = fd & a & ".jpg" ----可以同時顯示jpg.gif圖檔嗎?
If Dir(fs) <> "" Then sheet1.Shapes.AddPicture fs, msoFalse, msoTrue, a.Offset(, 1).Left, a.Top, a.Offset(, 1).Width, a.Height
Next
End Sub
謝謝各位幫忙作者: 准提部林 時間: 2019-4-19 12:07
fs = dir(fd & a & ".jpg")
if fs="" then fs = dir(fd & a & ".gif")
If fs <> "" Then sheet1.Shapes.AddPicture fd & fs, msoFalse, msoTrue, a.Offset(, 1).Left, a.Top, a.Offset(, 1).Width, a.Height作者: mybubble9987 時間: 2019-4-19 14:53
Private Sub load檔名()
Dim P As String
P = ThisWorkbook.Path & "\TEST01\"
ActiveSheet.UsedRange.Offset(1).Clear
Get_Picture P
End Sub
Private Sub Get_Picture(ByVal P As String)
Dim Fs, F As Variant
Set Fs = CreateObject("Scripting.FileSystemObject").GETFolder(P)
With ActiveSheet
For Each F In Fs.Files
If F Like "*.jpg" Then '指定副檔名
.Cells(Application.CountA(.[F:F]) + 1, "F") = F.Name
End If
Next
End With
For Each F In Fs.SubFolders
On Error Resume Next
Get_Picture F
Next
End Sub作者: 准提部林 時間: 2019-4-19 20:20
因為我參考的是這樣的寫法~
Private Sub Get_Picture(ByVal P As String)
Dim Fs, F As Variant
Set Fs = CreateObject("Scripting.FileSystemObject").GETFolder(P)
With ActiveSheet
For Each F In Fs.Files
If F Like "*.jpg" Then '指定副檔名----------->這邊沒辦法改成jpg. gif~(但或許本來就不能同時指定兩個東西~是我想得太簡單以為加上去就可以)
.Cells(Application.CountA(.[F:F]) + 1, "F") = F.Name
End If
Next
End With
For Each F In Fs.SubFolders
On Error Resume Next
Get_Picture F
Next
End Sub
