excel 報價表單上輸入不同的Item如何帶入不同的圖片
- 帖子
- 44
- 主題
- 13
- 精華
- 0
- 積分
- 70
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2014-2-19
- 最後登錄
- 2015-10-30
|
excel 報價表單上輸入不同的Item如何帶入不同的圖片
請問各位高手,我在excel 表單上的圖片(Image)
想依照表單上輸入不同的Item帶入不同的圖片(圖片儲存在D:\catalogue裡)
程式碼應該要怎麼寫?? |
-
-
報價單.rar
(27.66 KB)
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
|
2#
發表於 2014-2-19 09:49
| 只看該作者
本帖最後由 GBKEE 於 2014-2-19 14:35 編輯
回復 1# h99949 - Const 預設照片網址 = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg"
- Const 預設照片 = "d:\照片.gif"
- Private Sub UserForm_Initialize() '開啟表單初始程式
- 下載網路圖片
- With Image1
- .Picture = LoadPicture(預設照片) '載入圖片
- .PictureSizeMode = fmPictureSizeModeZoom '圖片模式
- End With
- TextBox1.SetFocus
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '表單關閉
- Kill 預設照片 '刪除
- End Sub
- Private Sub TextBox1_Change()
- If TextBox1.Value = "" Then Exit Sub
- Dim cell As Range
- Set cell = Sheets("雜菜鍋").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
- If Not cell Is Nothing Then
- If Dir("D:\catalogue\" & cell & ".*") <> "" Then
- Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*"))
- End If
- TextBox2.Value = cell.Offset(, 1).Value
- TextBox3.Value = cell.Offset(, 2).Value
- TextBox4.Value = cell.Offset(, 3).Value
- TextBox5.Value = cell.Offset(, 4).Value
- TextBox6.Value = cell.Offset(, 5).Value
- TextBox7.Value = cell.Offset(, 32).Value
- TextBox8.Value = cell.Offset(, 33).Value
- Else
- Image1.Picture = LoadPicture(預設照片)
- TextBox2.Value = ""
- TextBox3.Value = ""
- TextBox4.Value = ""
- TextBox5.Value = ""
- TextBox6.Value = ""
- TextBox7.Value = ""
- TextBox8.Value = ""
- End If
- End Sub
- Private Sub TextBox1_AfterUpdate()
- If TextBox2.Value = "" Then
- TextBox2.SetFocus
- Else
- CommandButton2.SetFocus
- End If
- End Sub
- Private Sub 下載網路圖片()
- Dim xml As Object '用來取得網頁資料
- Dim stream 'As ADODB.stream '用來儲存二進位檔案
- Set xml = CreateObject("Microsoft.XMLHTTP")
- Set stream = CreateObject("ADODB.stream")
- xml.Open "GET", 預設照片網址, 0
- xml.send
- With stream
- .Open
- .Type = 1
- .write xml.ResponseBody
- If Dir(預設照片) <> "" Then Kill 預設照片
- .SaveToFile (預設照片)
- .Close
- End With
- Set xml = Nothing
- Set stream = Nothing
- End Sub
複製代碼 |
|
|
|
|
|
|
- 帖子
- 44
- 主題
- 13
- 精華
- 0
- 積分
- 70
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2014-2-19
- 最後登錄
- 2015-10-30
|
3#
發表於 2014-2-19 13:11
| 只看該作者
你好,圖片是放在電腦的D:\catalogue裡並不是網址裡,請問程式該如何修改? |
|
|
|
|
|
|
- 帖子
- 44
- 主題
- 13
- 精華
- 0
- 積分
- 70
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2014-2-19
- 最後登錄
- 2015-10-30
|
4#
發表於 2014-2-19 13:17
| 只看該作者
|
|
|
|
|
|
- 帖子
- 44
- 主題
- 13
- 精華
- 0
- 積分
- 70
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2014-2-19
- 最後登錄
- 2015-10-30
|
5#
發表於 2014-2-19 13:45
| 只看該作者
回復 2# GBKEE
可以將預設的照片改成電腦裡的圖片嗎? |
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
|
6#
發表於 2014-2-19 14:05
| 只看該作者
本帖最後由 GBKEE 於 2014-2-19 14:37 編輯
回復 5# h99949
圖片是放在電腦的D:\catalogue裡並不是網址裡,請問程式該如何修改?
圖片不是固定的它是可以依輸入的資料不同作變化
可以將預設的照片改成電腦裡的圖片嗎?- Const 預設照片 = "d:\照片.gif" '這不是電腦裡的圖片嗎
- Private Sub TextBox1_Change()
- If TextBox1.Value = "" Then Exit Sub
- Dim cell As Range
- Set cell = Sheets("雜菜鍋").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
- If Not cell Is Nothing Then
- If Dir("D:\catalogue\" & cell & ".*") <> "" Then
- '*** 在電腦的D:\ 已更正 D:\catalogue ******
- ' *** 依 TextBox1.Value 有變化 ******
- Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*"))
- 'TextBox1.Value-> "d:\catalogue\" & Dir("D:\catalogue\" & cell & ".*")
- End If
- Else
- Image1.Picture = LoadPicture(預設照片)
- End If
複製代碼 |
|
|
|
|
|
|
- 帖子
- 44
- 主題
- 13
- 精華
- 0
- 積分
- 70
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2014-2-19
- 最後登錄
- 2015-10-30
|
7#
發表於 2014-2-20 22:48
| 只看該作者
回復 6# GBKEE
版主你好,已經以用了,謝謝
但我想在表單輸入Item後帶出來的相關資料,可以在表單上修改後直接儲存到相對應的儲存格上,程式應該如何做修改呢? |
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
|
8#
發表於 2014-2-21 10:15
| 只看該作者
本帖最後由 GBKEE 於 2014-2-21 13:57 編輯
回復 7# h99949 - Option Explicit '強制宣告變數
- Option Base 1 '陣列的索引值,指定下限值為 1
- Const 預設照片網址 = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg" '指定常數
- Const 預設照片 = "d:\照片.gif"
- Dim Rng As Range, Text_Ar(), AR(), Rng_Text As String
- Private Sub UserForm_Initialize() '開啟表單初始程式
- Dim i As Integer
- For i = 1 To 7
- ReDim Preserve Text_Ar(1 To i)
- Set Text_Ar(i) = Me.Controls("TextBox" & i + 1) '將控制項"TextBox?" 置入陣列中
- Next
- AR = Array(1, 2, 3, 4, 5, 32, 33) '貨號資料的位置
- TextBox1.SetFocus
- 下載網路圖片
- With Image1
- .Picture = LoadPicture(預設照片) '載入圖片
- .PictureSizeMode = fmPictureSizeModeZoom '圖片模式
- End With
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '表單關閉
- Kill 預設照片 '刪除
- End Sub
- Private Sub TextBox1_Change()
- Dim i As Integer
- If TextBox1.Value = "" Then Exit Sub
- Set Rng = Sheets("雜菜鍋").Columns(1).Find(TextBox1.Value, lookat:=xlWhole)
- If Not Rng Is Nothing Then
- If Dir("D:\catalogue\" & Rng & ".*") <> "" Then
- Image1.Picture = LoadPicture("d:\catalogue\" & Dir("D:\catalogue\" & Rng & ".*"))
- End If
- Rng_Text = "" '清除 記憶資料
- For i = 1 To UBound(AR)
- Rng_Text = Rng_Text & Rng.Offset(, AR(i)) '記憶資料
- Text_Ar(i).Text = Rng.Offset(, AR(i)).Value '導入資料在TextBox?
- 'Rng.Offset(, i).Text :儲存格顯示的數字格式
- 'Rng.Offset(, i).Value :儲存格真正的數字
- '顯示的數字格式,不一定等於,真正的數字.
- Next
- Else
- Image1.Picture = LoadPicture(預設照片)
- For i = 1 To UBound(AR)
- Text_Ar(i).Text = ""
- Next
- End If
- End Sub
- Private Sub TextBox1_AfterUpdate()
- If TextBox2.Value = "" Then
- TextBox2.SetFocus
- Else
- CommandButton2.SetFocus
- End If
- End Sub
- Private Sub CommandButton1_Click()
- Dim s As String, i As Integer
- If Rng Is Nothing Then
- s = "貨號中沒有 " & TextBox1
- ElseIf Rng_Text = Join(Text_Ar, "") Then
- s = "貨號" & TextBox1 & "資料沒有修改 !!"
- End If
- If s = "" Then
- If MsgBox(TextBox1 & "修改資料 !!", 32 + vbYesNo) = vbYes Then
- For i = 1 To UBound(AR)
- Rng.Offset(, AR(i)).Value = Text_Ar(i) '導入TextBox?數字(文字型態)到Rng
- Rng.EntireRow = Rng.EntireRow.Value '數字(文字型態)轉為 數字(數字型態)
- Next
- End If
- End If
- End Sub
- Private Sub 下載網路圖片()
- Dim xml As Object '用來取得網頁資料
- Dim stream 'As ADODB.stream '用來儲存二進位檔案
- Set xml = CreateObject("Microsoft.XMLHTTP")
- Set stream = CreateObject("ADODB.stream")
- xml.Open "GET", 預設照片網址, 0
- xml.send
- With stream
- .Open
- .Type = 1
- .write xml.ResponseBody
- If Dir(預設照片) <> "" Then Kill 預設照片
- .SaveToFile (預設照片)
- .Close
- End With
- Set xml = Nothing
- Set stream = Nothing
- End Sub
- Private Sub cal_Click()
- Dim x As Integer, y As Integer, s As String
- x = Val(mypv) '單價
- y = Val(myrate)
- If y <> 0 Then s = Round(x / y, 2) '匯率
- ratepay.Caption = s
- End Sub
複製代碼 |
|
|
|
|
|
|
- 帖子
- 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)
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
|
10#
發表於 2014-2-21 11:02
| 只看該作者
回復 9# h99949 - Option Explicit '強制宣告變數
- Option Base 1 '陣列的索引值,指定下限值為 1
- Const 預設照片網址 = "http://blog-imgs-27-origin.fc2.com/p/o/k/pokomin/TOTAL.jpg" '指定常數
- Const 預設照片 = "d:\照片.gif"
- Dim Rng As Range, Text_Ar(), AR(), Rng_Text As String '這裡有嗎?
複製代碼 |
|
|
|
|
|
|