返回列表 上一主題 發帖

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

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

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

報價單.rar (27.66 KB)

本帖最後由 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

你好,圖片是放在電腦的D:\catalogue裡並不是網址裡,請問程式該如何修改?

TOP

圖片不是固定的它是可以依輸入的資料不同作變化

TOP

回復 2# GBKEE
可以將預設的照片改成電腦裡的圖片嗎?

TOP

本帖最後由 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

回復 6# GBKEE
版主你好,已經以用了,謝謝
但我想在表單輸入Item後帶出來的相關資料,可以在表單上修改後直接儲存到相對應的儲存格上,程式應該如何做修改呢?

TOP

本帖最後由 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

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

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

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

  46. Private Sub TextBox1_AfterUpdate()
  47.     If TextBox2.Value = "" Then
  48.         TextBox2.SetFocus
  49.     Else
  50.         CommandButton2.SetFocus
  51.     End If
  52. End Sub

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

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

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

TOP

回復 8# GBKEE
Private Sub TextBox1_Change()變數未定義該如何修改

未命名.JPG (196.99 KB)

未命名.JPG

TOP

回復 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

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