返回列表 上一主題 發帖

如何於excel的報價表單上輸入不同的Item帶入不同的圖片

回復 3# kimie0_0
適用於你1#的檔案
  1. Sub Ex_AutoAddPic()
  2.     Dim Rng(1 To 2) As Range, Rng_First As String, MyPcName As String, Picture_Path As String
  3.     Picture_Path = "D:\photo\"
  4.     With ActiveSheet
  5.         For Each Shp In .Shapes
  6.             If Shp.Type = msoPicture Then Shp.Delete
  7.         Next
  8.         Set Rng(1) = .Cells.Find("Item no:", lookat:=xlWhole, SearchOrder:=xlByRows) 'xlByRows(循列)或 xlByColumns(循欄) 搜尋

  9.         If Not Rng(1) Is Nothing Then
  10.             Rng_First = Rng(1).Address      '第一個尋找到 "Item no:" 的位置
  11.             Do
  12.                 MyPcName = Picture_Path & Rng(1).Cells(1, 2) & ".jpg"
  13.                 If Dir(MyPcName, vbDirectory) <> "" Then
  14.                     Set Rng(2) = Rng(1).Cells(-7)          '上移8列的Cells位置
  15.                     With .Pictures.Insert(MyPcName)
  16.                         .Top = Rng(2).Top                  '插入圖片的頂點,位於工作表從第一列頂端至該範圍頂端的距離
  17.                         .Left = Rng(2).Left                '插入圖片的左邊,位於工作表從 A 欄左限至該範圍左限的距離
  18.                         .Height = Rng(2).Resize(8).Height  '插入圖片的範圍的高度
  19.                         .Width = Rng(2).Resize(, 2).Width  '插入圖片的範圍的寬度
  20.                     End With
  21.                 End If
  22.                 Set Rng(1) = .Cells.FindNext(Rng(1))   '下一個要尋找的字串
  23.             Loop Until Rng_First = Rng(1).Address      '回到第一個尋找到 "Item no:" 的位置
  24.         End If
  25.     End With
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 6# kimie0_0
"Item no:" 旁的儲存格你有填入圖片名稱嗎?
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 9# kimie0_0
測試的Excel檔案 與1#  報價單.rar中的Excel檔案一樣嗎?
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 修行要繫緣修心,藉事練心,隨處養心。
返回列表 上一主題