帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Win7
軟體版本: Office2013
閱讀權限: 10
性別: 女
註冊時間: 2019-4-13
最後登錄: 2021-10-15

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2019-4-17 10:55 | 只看該作者

程式碼-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

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2843
主題: 10
精華: 0
積分: 2899
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-10-18

2^#

發表於 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

TOP

mybubble9987

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Win7
軟體版本: Office2013
閱讀權限: 10
性別: 女
註冊時間: 2019-4-13
最後登錄: 2021-10-15

3^#

發表於 2019-4-19 14:53 | 只看該作者

回復 2# 准提部林

謝謝你的指點!!!

SofyShih

TOP

mybubble9987

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Win7
軟體版本: Office2013
閱讀權限: 10
性別: 女
註冊時間: 2019-4-13
最後登錄: 2021-10-15

4^#

發表於 2019-4-19 15:09 | 只看該作者

回復 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

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2843
主題: 10
精華: 0
積分: 2899
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-10-18

5^#

發表於 2019-4-19 20:20 | 只看該作者

回復 4# mybubble9987

看不懂要做什麼???

TOP

ChuckBucket

中學生 Rank: 2

帖子: 10
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: WIN10
軟體版本: Office 20xx
閱讀權限: 20
性別: 男
來自: 桃園市
註冊時間: 2019-2-21
最後登錄: 2022-9-30

論壇贊助勳章

6^#

發表於 2019-4-19 20:53 | 只看該作者

回復 4# mybubble9987

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

TOP

mybubble9987

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Win7
軟體版本: Office2013
閱讀權限: 10
性別: 女
註冊時間: 2019-4-13
最後登錄: 2021-10-15

7^#

發表於 2019-4-22 08:58 | 只看該作者

回復 6# ChuckBucket

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

SofyShih

TOP

mybubble9987

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Win7
軟體版本: Office2013
閱讀權限: 10
性別: 女
註冊時間: 2019-4-13
最後登錄: 2021-10-15

8^#

發表於 2019-4-22 09:05 | 只看該作者

回復 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

ML089