返回列表 上一主題 發帖

vba插入圖片問題

vba插入圖片問題

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

插入圖片.rar (30.5 KB)

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE


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


程式碼應該如何做修改?

插入圖片.rar (30.71 KB)

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE


  請問如果我調整插入的圖片大小,程式碼應該要在哪裡修改??

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

感恩的心......

TOP

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

TOP

        靜思自在 : 有智慧才能分辨善惡邪正;有謙虛才能建立美滿人生。
返回列表 上一主題