123
返回列表 上一主題 發帖

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

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-2-19 08:25 | 只看該作者

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

請問各位高手,我在excel 表單上的圖片(Image)
想依照表單上輸入不同的Item帶入不同的圖片(圖片儲存在D:\catalogue裡)
程式碼應該要怎麼寫??

報價單.rar (27.66 KB)

收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2014-2-19 09:49 | 只看該作者
本帖最後由 GBKEE 於 2014-2-19 14:35 編輯

回復 1# h99949
  1. Const 預設照片網址 = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg"
  2. Const 預設照片 = "d:\照片.gif"
  3. Private Sub UserForm_Initialize()  '開啟表單初始程式
  4.     下載網路圖片
  5.      With Image1
  6.         .Picture = LoadPicture(預設照片)          '載入圖片
  7.         .PictureSizeMode = fmPictureSizeModeZoom  '圖片模式
  8.      End With
  9.      TextBox1.SetFocus
  10. End Sub
  11. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '表單關閉
  12.     Kill 預設照片 '刪除
  13. End Sub
  14. Private Sub TextBox1_Change()
  15.     If TextBox1.Value = "" Then Exit Sub
  16.     Dim cell As Range
  17.     Set cell = Sheets("雜菜鍋").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
  18.     If Not cell Is Nothing Then
  19.         If Dir("D:\catalogue\" & cell & ".*") <> "" Then
  20.             Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*"))
  21.         End If
  22.         TextBox2.Value = cell.Offset(, 1).Value
  23.         TextBox3.Value = cell.Offset(, 2).Value
  24.         TextBox4.Value = cell.Offset(, 3).Value
  25.         TextBox5.Value = cell.Offset(, 4).Value
  26.         TextBox6.Value = cell.Offset(, 5).Value
  27.         TextBox7.Value = cell.Offset(, 32).Value
  28.         TextBox8.Value = cell.Offset(, 33).Value
  29.     Else
  30.        Image1.Picture = LoadPicture(預設照片)
  31.         TextBox2.Value = ""
  32.         TextBox3.Value = ""
  33.         TextBox4.Value = ""
  34.         TextBox5.Value = ""
  35.         TextBox6.Value = ""
  36.         TextBox7.Value = ""
  37.         TextBox8.Value = ""
  38.     End If
  39. End Sub
  40. Private Sub TextBox1_AfterUpdate()
  41.     If TextBox2.Value = "" Then
  42.         TextBox2.SetFocus
  43.     Else
  44.         CommandButton2.SetFocus
  45.     End If
  46. End Sub
  47. Private Sub 下載網路圖片()
  48.     Dim xml As Object     '用來取得網頁資料
  49.     Dim stream            'As ADODB.stream   '用來儲存二進位檔案
  50.     Set xml = CreateObject("Microsoft.XMLHTTP")
  51.     Set stream = CreateObject("ADODB.stream")
  52.         xml.Open "GET", 預設照片網址, 0
  53.         xml.send
  54.     With stream
  55.         .Open
  56.         .Type = 1
  57.         .write xml.ResponseBody
  58.         If Dir(預設照片) <> "" Then Kill 預設照片
  59.         .SaveToFile (預設照片)
  60.         .Close
  61.     End With
  62.     Set xml = Nothing
  63.     Set stream = Nothing
  64. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
3#
發表於 2014-2-19 13:11 | 只看該作者
你好,圖片是放在電腦的D:\catalogue裡並不是網址裡,請問程式該如何修改?

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
4#
發表於 2014-2-19 13:17 | 只看該作者
圖片不是固定的它是可以依輸入的資料不同作變化

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
5#
發表於 2014-2-19 13:45 | 只看該作者
回復 2# GBKEE
可以將預設的照片改成電腦裡的圖片嗎?

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2014-2-19 14:05 | 只看該作者
本帖最後由 GBKEE 於 2014-2-19 14:37 編輯

回復 5# h99949
圖片是放在電腦的D:\catalogue裡並不是網址裡,請問程式該如何修改?
圖片不是固定的它是可以依輸入的資料不同作變化
可以將預設的照片改成電腦裡的圖片嗎?
  1. Const 預設照片 = "d:\照片.gif"  '這不是電腦裡的圖片嗎
  2. Private Sub TextBox1_Change()
  3.     If TextBox1.Value = "" Then Exit Sub
  4.     Dim cell As Range
  5.     Set cell = Sheets("雜菜鍋").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
  6.     If Not cell Is Nothing Then  
  7.         If Dir("D:\catalogue\" & cell & ".*") <> "" Then  
  8.              '*** 在電腦的D:\ 已更正 D:\catalogue     ******
  9.             ' *** 依 TextBox1.Value 有變化 ******
  10.             Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*"))
  11.             'TextBox1.Value-> "d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*")
  12.         End If
  13.     Else
  14.        Image1.Picture = LoadPicture(預設照片)
  15.      End If
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
7#
發表於 2014-2-20 22:48 | 只看該作者
回復 6# GBKEE
版主你好,已經以用了,謝謝
但我想在表單輸入Item後帶出來的相關資料,可以在表單上修改後直接儲存到相對應的儲存格上,程式應該如何做修改呢?

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2014-2-21 10:15 | 只看該作者
本帖最後由 GBKEE 於 2014-2-21 13:57 編輯

回復 7# h99949
  1. Option Explicit         '強制宣告變數
  2. Option Base 1           '陣列的索引值,指定下限值為 1
  3. Const 預設照片網址 = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg" '指定常數
  4. Const 預設照片 = "d:\照片.gif"
  5. Dim Rng As Range, Text_Ar(), AR(), Rng_Text As String

  7. Private Sub UserForm_Initialize()   '開啟表單初始程式
  8.     Dim i As Integer
  9.     For i = 1 To 7
  10.         ReDim Preserve Text_Ar(1 To i)
  11.         Set Text_Ar(i) = Me.Controls("TextBox" & i + 1) '將控制項"TextBox?" 置入陣列中
  12.     Next
  13.     AR = Array(1, 2, 3, 4, 5, 32, 33)   '貨號資料的位置
  14.     TextBox1.SetFocus
  15.     下載網路圖片
  16.     With Image1
  17.         .Picture = LoadPicture(預設照片)          '載入圖片
  18.         .PictureSizeMode = fmPictureSizeModeZoom  '圖片模式
  19.     End With
  20. End Sub

  22. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '表單關閉
  23.     Kill 預設照片 '刪除
  24. End Sub

  26. Private Sub TextBox1_Change()
  27.     Dim i As Integer
  28.     If TextBox1.Value = "" Then Exit Sub
  29.     Set Rng = Sheets("雜菜鍋").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
  30.     If Not Rng Is Nothing Then
  31.         If Dir("D:\catalogue\" & Rng & ".*") <> "" Then
  32.            Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & Rng & ".*"))
  33.         End If
  34.         Rng_Text = ""                                              '清除 記憶資料
  35.         For i = 1 To UBound(AR)
  36.             Rng_Text = Rng_Text & Rng.Offset(, AR(i))   '記憶資料
  37.             Text_Ar(i).Text = Rng.Offset(, AR(i)).Value '導入資料在TextBox?
  38.             'Rng.Offset(, i).Text  :儲存格顯示的數字格式
  39.             'Rng.Offset(, i).Value :儲存格真正的數字
  40.             '顯示的數字格式,不一定等於,真正的數字.
  41.         Next
  42.     Else
  43.        Image1.Picture = LoadPicture(預設照片)
  44.         For i = 1 To UBound(AR)
  45.             Text_Ar(i).Text = ""
  46.         Next
  47.     End If
  48. End Sub

  50. Private Sub TextBox1_AfterUpdate()
  51.     If TextBox2.Value = "" Then
  52.         TextBox2.SetFocus
  53.     Else
  54.         CommandButton2.SetFocus
  55.     End If
  56. End Sub

  58. Private Sub CommandButton1_Click()
  59.     Dim s As String, i As Integer
  60.     If Rng Is Nothing Then
  61.         s = "貨號中沒有 " & TextBox1
  62.     ElseIf Rng_Text = Join(Text_Ar, "") Then
  63.         s = "貨號" & TextBox1 & "資料沒有修改 !!"
  64.     End If
  65.     If s = "" Then
  66.         If MsgBox(TextBox1 & "修改資料 !!", 32 + vbYesNo) = vbYes Then
  67.             For i = 1 To UBound(AR)
  68.                 Rng.Offset(, AR(i)).Value = Text_Ar(i) '導入TextBox?數字(文字型態)到Rng
  69.                 Rng.EntireRow = Rng.EntireRow.Value '數字(文字型態)轉為 數字(數字型態)
  70.             Next
  71.         End If
  72.     End If
  73. End Sub

  75. Private Sub 下載網路圖片()
  76.     Dim xml As Object     '用來取得網頁資料
  77.     Dim stream            'As ADODB.stream   '用來儲存二進位檔案
  78.     Set xml = CreateObject("Microsoft.XMLHTTP")
  79.     Set stream = CreateObject("ADODB.stream")
  80.         xml.Open "GET", 預設照片網址, 0
  81.         xml.send
  82.     With stream
  83.         .Open
  84.         .Type = 1
  85.         .write xml.ResponseBody
  86.         If Dir(預設照片) <> "" Then Kill 預設照片
  87.         .SaveToFile (預設照片)
  88.         .Close
  89.     End With
  90.     Set xml = Nothing
  91.     Set stream = Nothing
  92. End Sub

  94. Private Sub cal_Click()
  95.     Dim x As Integer, y As Integer, s As String
  96.     x = Val(mypv)                       '單價
  97.     y = Val(myrate)
  98.     If y <> 0 Then s = Round(x / y, 2)  '匯率
  99.     ratepay.Caption = s
  100. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
9#
發表於 2014-2-21 10:49 | 只看該作者
回復 8# GBKEE
Private Sub TextBox1_Change()變數未定義該如何修改

未命名.JPG (196.99 KB)

未命名.JPG

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2014-2-21 11:02 | 只看該作者
回復 9# h99949
  1. Option Explicit         '強制宣告變數
  2. Option Base 1           '陣列的索引值,指定下限值為 1
  3. Const 預設照片網址 = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg" '指定常數
  4. Const 預設照片 = "d:\照片.gif"
  5. Dim Rng As Range, Text_Ar(), AR(), Rng_Text As String  '這裡有嗎?
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
123
返回列表 上一主題