返回列表 上一主題 發帖

程式碼-jpg.gif 同時顯示

程式碼-jpg.gif 同時顯示

各位好~我有一行程式碼不知道能不能這樣同時執行

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


謝謝各位幫忙
SofyShih

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
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 2# 准提部林

謝謝你的指點!!!
SofyShih

TOP

回復 2# 准提部林

版主大大你好~~~(首先非常感謝這個版~讓我找到很多很實用的資料~)
我還在一行一行學著怎麼看巨集裡面的程式碼~所以等級非常非常的低....

我發現自己已經把昨天的問題~巨集內容改掉了~~~
所以現在如果要參考大大給的建議答案~~還真不知道該從哪邊開始插入改起.......(有很努力的在學!一邊改一邊學~所以基礎太差)

附上我後來又改的巨集~請問能幫我看一下嗎?非常感謝你撥空指導

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
SofyShih

TOP

回復 4# mybubble9987

看不懂要做什麼???
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 4# mybubble9987


    妳可能要把妳的問題再詳細說明一下,讓版大好迅速了解妳需求,把主要時間放在幫妳撰寫或指正使之符合妳的最終應用。
    否則單丟程式碼,真的不是那麼容易洞悉一個人的想法。

TOP

回復 6# ChuckBucket

謝謝你的建議~我可能寫得太複雜了~所以造成大家不了解~~!!
SofyShih

TOP

回復 5# 准提部林

謝謝准提部林大大還撥空看我的問題~~~
簡單的來說~~~~就是雖然您提供給我程式碼~
但我卻不知道該從哪邊開始插入改起.....畢竟程度太低~~~當寫法完全不一樣時~就不知道怎麼改...

因為我參考的是這樣的寫法~
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
   

最後再次謝謝你們熱心的回覆
SofyShih

TOP

回復 8# mybubble9987

If F Like "*.jpg"  Or F Like "*.gif" Then
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 9# ML089

謝謝你的指導說明歐~~~我試成功了!!
而且連~部大幫我改的也試成功了!!!對初學者來說~能改對一個東西就很開心~;P
SofyShih

TOP

        靜思自在 : 我們最大的敵人不是別人.可能是自己。
返回列表 上一主題