Board logo

標題: vba插入圖片問題 [打印本頁]
作者: h99949    時間: 2014-2-21 14:19     標題: vba插入圖片問題

想請問大家
圖片存放路徑為  D:\catalogue\A.JPG
當A2儲存格為A時，B2儲存格自動插入A.JPG的圖片
當A3儲存格為B時，B3儲存格則自動插入名稱為B.JPG的圖片
但當A4儲存格為C時，則因為路徑內無C.JPG的圖片時顯示空白
程式碼應該如何做修改?
作者: GBKEE    時間: 2014-2-21 15:03

回復 1# h99949
  1. Option Explicit
  2. Sub ChangeSize()
  3.     Dim Mypath As String, E As Range, MyPic As Object
  4.     Mypath = "D:\catalogue\"
  5.     With Sheets("工作表1")
  6.         .Pictures.Delete
  7.         For Each E In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
  8.         'For Each  : 依序處裡集合的成員
  9.         '集合的成員: .Range("a2") 到 .Range("a" & .Rows.Count).End(xlUp))的儲存格
  10.                                      '(從最儲存格底部的列往到有資料的儲存格)
  11.             If Dir(Mypath & E & ".jpg") <> "" Then
  12.                 Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
  13.                 With MyPic
  14.                     .ShapeRange.LockAspectRatio = msoFalse
  15.                     .Left = E.Cells(1, 2).Left
  16.                     .Top = E.Cells(1, 2).Top
  17.                     .Width = E.Cells(1, 2).Width
  18.                     .Height = E.Cells(1, 2).Height
  19.                 End With
  20.             End If
  21.         Next
  22.     End With
  23. End Sub
複製代碼
作者: h99949    時間: 2014-2-21 17:57

回復 2# GBKEE


圖片存放路徑為  D:\catalogue\A.JPG
當A2儲存格為A時，B2儲存格自動插入A.JPG的圖片
當A3儲存格為B時，B3儲存格則自動插入名稱為B.JPG的圖片
但當A4儲存格為C時，則因為路徑內無C.JPG的圖片時顯示空白
如果要再追加輸入D儲存格，E儲存格自動插入圖片
                      跟輸入G儲存格，H儲存格自動插入圖片


程式碼應該如何做修改?
作者: GBKEE    時間: 2014-2-21 18:23

回復 3# h99949
  1. Option Explicit
  2. Sub ChangeSize()
  3.     Dim Mypath As String, E As Range, i As Integer ', MyPic As Object
  4.     Mypath = "D:\catalogue\"
  5.     With Sheets("工作表1")
  6.         .Pictures.Delete
  7.         For i = 1 To 7 Step 3   'A欄 ->1,D欄 ->4,G欄 ->7
  8.             For Each E In .UsedRange.Columns(i).Cells  ' 'A欄 ->1,D欄 ->4,G欄 ->7
  9.                 If Dir(Mypath & E & ".jpg") <> "" Then
  10.                     'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
  11.                     With .Pictures.Insert(Mypath & E & ".jpg")
  12.                         .ShapeRange.LockAspectRatio = msoFalse
  13.                         .Left = E.Cells(1, 2).Left
  14.                         .Top = E.Cells(1, 2).Top
  15.                         .Width = E.Cells(1, 2).Width
  16.                         .Height = E.Cells(1, 2).Height
  17.                     End With
  18.                 End If
  19.             Next
  20.         Next
  21.     End With
  22. End Sub
複製代碼
作者: h99949    時間: 2014-2-24 10:23

回復 4# GBKEE


  請問如果我調整插入的圖片大小,程式碼應該要在哪裡修改??
作者: GBKEE    時間: 2014-2-25 15:12

回復 5# h99949
  1. Option Explicit
  2. Sub ChangeSize()
  3.     Dim Mypath As String, E As Range, i As Integer ', MyPic As Object
  4.     Mypath = "D:\catalogue\"
  5.     With Sheets("工作表1")
  6.         .Pictures.Delete
  7.         For i = 1 To 7 Step 3   'A欄 ->1,D欄 ->4,G欄 ->7
  8.             For Each E In .UsedRange.Columns(i).Cells  ' 'A欄 ->1,D欄 ->4,G欄 ->7
  9.                
  10.                 E.ColumnWidth = 25      '調整儲存格寬度
  11.                 E.RowHeight = 50        '調整儲存格高度
  12.                
  13.                 If Dir(Mypath & E & ".jpg") <> "" Then
  14.                     'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
  15.                     With .Pictures.Insert(Mypath & E & ".jpg")
  16.                         .ShapeRange.LockAspectRatio = msoFalse
  17.                         .Left = E.Cells(1, 2).Left
  18.                         .Top = E.Cells(1, 2).Top
  19.                         .Width = E.Cells(1, 2).Width   '=儲存格寬度
  20.                         .Height = E.Cells(1, 2).Height '=儲存格高度
  21.                     End With
  22.                 End If
  23.             Next
  24.         Next
  25.     End With
  26. End Sub
複製代碼
作者: aa12312399    時間: 2015-10-17 17:26

感恩的心......
作者: jackyliu    時間: 2023-3-12 16:15

請問 若將圖片改插入L欄, 欄位寬度與高度從第6行開始設定,要改哪?
附註說明: A欄一樣紀錄圖檔名



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