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

kimie0_0

最近在建立報價單．，但由於產品太多，發給客人也在同一報價單上有多個ｉｔｅｍ，　單是一張報價單要用到一個小時(十分吃力）
想問一下各位高手,
怎樣編寫程式可以依照表單上輸入不同的Item帶入不同的圖片
(圖片儲存在D:\photo裡)
程式碼應該要怎麼寫??

rouber590324

dear sir
1.於插入-名稱-定義  建立一名稱
1.1例 X = INDEX(SHEET2!$BB,MATCH(SHEET1!$A$1,SHEET2!$AA,0))
1.2 SHEET2  B欄放圖  A欄KEY IN  1  2  3 ......
1.3 SHEET1!$A$1 依需求條件產生  1 或 2 或 3 .(判斷選取SHEET2對應A欄之B欄之 那一圖)
1.4 建立 TextBox1 放於指定處=X . 即可依變圖示

kimie0_0

但我的圖片放在D:\photo裡
因為圖片太多, 有辨法用VBA的方法嗎?
謝謝

rouber590324

試試如下

Sub Macro1()
Sheet2.Select
[a1].Select
Set a = ActiveSheet.Pictures.Insert("D:\photo\a.jpg")
   Sheet2.Rows(1).RowHeight = a.Height
   Sheet2.Columns(1).ColumnWidth = a.Width / 5.67
End Sub

GBKEE

回復 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. 
   
10.         If Not Rng(1) Is Nothing Then
    
11.             Rng_First = Rng(1).Address      '第一個尋找到 "Item no:" 的位置
    
12.             Do
    
13.                 MyPcName = Picture_Path & Rng(1).Cells(1, 2) & ".jpg"
    
14.                 If Dir(MyPcName, vbDirectory) <> "" Then
    
15.                     Set Rng(2) = Rng(1).Cells(-7)          '上移8列的Cells位置
    
16.                     With .Pictures.Insert(MyPcName)
    
17.                         .Top = Rng(2).Top                  '插入圖片的頂點,位於工作表從第一列頂端至該範圍頂端的距離
    
18.                         .Left = Rng(2).Left                '插入圖片的左邊,位於工作表從 A 欄左限至該範圍左限的距離
    
19.                         .Height = Rng(2).Resize(8).Height  '插入圖片的範圍的高度
    
20.                         .Width = Rng(2).Resize(, 2).Width  '插入圖片的範圍的寬度
    
21.                     End With
    
22.                 End If
    
23.                 Set Rng(1) = .Cells.FindNext(Rng(1))   '下一個要尋找的字串
    
24.             Loop Until Rng_First = Rng(1).Address      '回到第一個尋找到 "Item no:" 的位置
    
25.         End If
    
26.     End With
    
27. End Sub

複製代碼

kimie0_0

圖片還是沒有出來

wufonna

回復 7# kimie0_0

ThisWorkbook.Path & "\新資料夾 (3)\
D:\photo\

大大 是不是路徑的問題
G 版大的程式
我用可以 ^0^

GBKEE

回復 6# kimie0_0
"Item no:" 旁的儲存格你有填入圖片名稱嗎?

kimie0_0

謝謝大家指教！
電腦剛壞掉，換了台MACBOOKAIR
試過用上面所寫的程式還是不行
嗚嗚嗚:'(

下載 (108.42 KB)

2014-12-4 23:50

圖片現在放在Macintosh HD _ 使用者 _ kimie _ 文件"

GBKEE

回復 9# kimie0_0
測試的Excel檔案 與1#  報價單.rar中的Excel檔案一樣嗎?