標題: [發問] 如何匯入不特定的圖片檔 [打印本頁]

---

作者: luke    時間: 2012-5-3 23:50     標題: 如何匯入不特定的圖片檔

各位大大

如何從資料夾匯入B欄所對應的同名圖片名稱
(B欄名稱為自行填入)

至C欄的儲存格內並符合該儲存格大小?
(若無圖片則跳過直到無圖片檔如#4,#8,#12-#14和#18沒有圖片檔就要跳過)

煩請先進 大大指導
[attach]10799[/attach]

---

作者: oobird    時間: 2012-5-4 00:28

本帖最後由 oobird 於 2012-5-4 00:30 編輯

1. Private Sub CommandButton1_Click()
   
2.     Dim shp As Shape, c As Range
   
3.     On Error Resume Next
   
4.     For Each shp In ActiveSheet.Shapes
   
5.         If Not shp.Type = 12 Then shp.Delete
   
6.     Next
   
7. 
   
8.     For Each c In Range("b2", [b65536].End(3))
   
9.         On Error Resume Next
   
10.         c(1, 2).Select
    
11.         Set p = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\TEST16\" & c & ".gif")
    
12.         With p
    
13.             .Name = c.Value
    
14.             .Height = c(1, 2).Height
    
15.             .Width = c(1, 2).Width
    
16.             .Placement = xlMoveAndSize
    
17.          End With
    
18.     Next
    
19. 
    
20. End Sub

複製代碼

---

作者: Hsieh    時間: 2012-5-4 09:02

本帖最後由 Hsieh 於 2012-5-4 09:05 編輯

回復 1# luke

1. Sub Loadimage()
   
2. fd = ThisWorkbook.Path & "\TEST16\"
   
3. Dim Sp As Shape
   
4. For Each Sp In Sheet1.Shapes
   
5.   If Sp.Type = 13 Then Sp.Delete
   
6. Next
   
7. For Each a In Range([B2], [B65536].End(xlUp))
   
8. fs = fd & a & ".gif"
   
9. If Dir(fs) <> "" Then Sheet1.Shapes.AddPicture fs, msoFalse, msoTrue, a.Offset(, 1).Left, a.Top, a.Offset(, 1).Width, a.Height
   
10. Next
    
11. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)