[發問] 求助有關輸入檔名直接跳出照片的程式

apple99152

大家好:

因本身非資訊出生 非常不了解程式 希望可以求助:
如何在＂清單＂Ｃ欄及Ｅ欄，輸入檔名， （例如　F1.JPG 、R1.JPG）
就能夠分別在＂照片１＂及”照片2”活頁簿自動跳出照片的方法?

下載 (46.92 KB)
清單

2015-4-30 14:25

下載 (36.56 KB)
照片1

2015-4-30 14:25

下載 (64.21 KB)
照片2

2015-4-30 14:25

請各位幫忙，感謝！

軟體: Office Excel
版本: 2013

apple99152

回復 1# apple99152

照片儲存資料夾為
    D:\TEST

lpk187

回復 2# apple99152

以下程式碼是對岸的一位老師的教學範例，我修改了一下來符合你的要求，試試

1. Public Sub 照片1()
   
2. For Each shap In Sheets("照片1").Shapes
   
3.     If shap.Type <> 8 Then shap.Delete
   
4. Next
   
5. For Each Rng In Sheets("照片1").Range("C2", Range("c2").End(xlDown))
   
6.     Pat = "D:\TEST\" & Rng
   
7.     Set rngs = Cells(Rng.Row, "C")
   
8.     Sheets("照片1").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
   
9. Next
   
10. For Each Rng In Sheets("照片1").Range("E2", Range("E2").End(xlDown))
    
11.     Pat = "D:\TEST\" & Rng
    
12.     Set rngs = Cells(Rng.Row, "E")
    
13.     Sheets("照片1").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
    
14. Next
    
15. End Sub
    
16. 
    
17. Public Sub 照片2()
    
18. For Each shap In Sheets("照片2").Shapes
    
19.     If shap.Type <> 8 Then shap.Delete
    
20. Next
    
21. For Each Rng In Sheets("照片2").Range("B2", Range("B2").End(xlToRight))
    
22.     Pat = "D:\TEST\" & Rng
    
23.     Set rngs = Cells(2, Rng.Column)
    
24.     Sheets("照片2").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
    
25. Next
    
26. For Each Rng In Sheets("照片2").Range("B5", Range("B5").End(xlToRight))
    
27.     Pat = "D:\TEST\" & Rng
    
28.     Set rngs = Cells(5, Rng.Column)
    
29.     Sheets("照片2").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
    
30. Next
    
31. End Sub

複製代碼