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)

收藏 分享

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
29#
發表於 2014-2-27 16:28 | 只看該作者
回復 28# GBKEE

版主你好,我FOB美金的換算想改成=ROUND(總價/美金匯率/毛利率(追加TextBox38),2)
                                歐元的換算想改成=ROUND(總價/歐元匯率/毛利率(追加TextBox38),2)        
下面程式修改成這樣對嗎?
Private Sub TextBox7_Change()    '總價
    If Val(Trim(TextBox7)) <> 0 Then
        If Val(Trim(TextBox5)) <> 0 And Val(Trim(TextBox36)) = 0 And Val(Trim(TextBox38)) <> 0 Then TextBox36 = Application.WorksheetFunction.Round(TextBox7 / TextBox5 / TextBox38, 2)
        If Val(Trim(TextBox5)) <> 0 And Val(Trim(TextBox36)) = 0 And Val(Trim(TextBox38)) <> 0 Then TextBox38 = Application.WorksheetFunction.Round(TextBox7 / TextBox5 / TextBox38, 2)
                                                                                '=ROUND(總價/美元匯率/毛利率,2)
        If Val(Trim(TextBox6)) <> 0 And Val(Trim(TextBox37)) = 0 And Val(Trim(TextBox38)) <> 0 Then TextBox37 = Application.WorksheetFunction.Round(TextBox7 / TextBox6 / TextBox38, 2)
        If Val(Trim(TextBox6)) <> 0 And Val(Trim(TextBox37)) = 0 And Val(Trim(TextBox38)) <> 0 Then TextBox38 = Application.WorksheetFunction.Round(TextBox7 / TextBox6 / TextBox38, 2)
                                                                                '=ROUND(總價/歐元匯率/毛利率,2)

        
        
        If Val(Trim(TextBox36)) <> 0 Then TextBox5 = Application.WorksheetFunction.Round(TextBox7 / TextBox36 / TextBox38, 2) '總價*美元匯率*毛利率
        If Val(Trim(TextBox38)) <> 0 Then TextBox5 = Application.WorksheetFunction.Round(TextBox7 / TextBox36 / TextBox38, 2) '總價*美元匯率*毛利率
        
        If Val(Trim(TextBox37)) <> 0 Then TextBox6 = Application.WorksheetFunction.Round(TextBox7 / TextBox37 / TextBox38, 2) '總價*歐元匯率*毛利率
        If Val(Trim(TextBox38)) <> 0 Then TextBox6 = Application.WorksheetFunction.Round(TextBox7 / TextBox37 / TextBox38, 2) '總價*歐元匯率*毛利率
     
    ElseIf Val(Trim(TextBox7)) = 0 Then
        TextBox5 = ""
        TextBox6 = ""
    End If
    If Msg Then 防呆
End Sub
Private Sub TextBox36_Change()
    If Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox36)) <> 0 Then
        TextBox5 = Application.WorksheetFunction.Round(TextBox7 / TextBox36, 2)
        '=ROUND(總價/美元匯率/毛利率,2)
    ElseIf Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox5)) <> 0 Then
        TextBox5 = TextBox7
    End If
End Sub
Private Sub TextBox37_Change()
    If Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox37)) <> 0 Then
        TextBox6 = Application.WorksheetFunction.Round(TextBox7 / TextBox37, 2)
        '=ROUND(總價/歐元匯率/毛利率,2)
    ElseIf Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox6)) <> 0 Then
        TextBox6 = TextBox7
    End If
End Sub
Private Sub TextBox38_Change()
    If Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox36)) <> 0 And Val(Trim(TextBox38)) <> 0 Then
        TextBox5 = Application.WorksheetFunction.Round(TextBox7 / TextBox36 / TextBox38, 2)
        '=ROUND(總價/美元匯率/毛利率,2)
    ElseIf Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox5)) <> 0 Then
        TextBox5 = TextBox7
    End If
    If Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox37)) <> 0 And Val(Trim(TextBox38)) <> 0 Then
        TextBox6 = Application.WorksheetFunction.Round(TextBox7 / TextBox37 / TextBox38, 2)
        '=ROUND(總價/歐元匯率/毛利率,2)
    ElseIf Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox6)) <> 0 Then
        TextBox6 = TextBox7
    End If
End Sub

未命名.JPG (76.61 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兔年全勤獎章
28#
發表於 2014-2-27 15:00 | 只看該作者
回復 27# h99949

沒有IsText 這函數
Trim() :清除前後的空白字串
Trim(ComboBox1)<>"" -> 有字串
  1. If IsError(A) And Trim(ComboBox1)<>"" And InStr(AR(1) & ",", ",,") = 0 Then CommandButton1.Enabled = True
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
27#
發表於 2014-2-27 14:31 | 只看該作者
回復 25# GBKEE


版主你好,我將IsNumeric (檢查是否為數字)改 IsText這樣不對嗎

If IsError(A) And IsText(Trim(ComboBox1)) And InStr(AR(1) & ",", ",,") = 0 Then CommandButton1.Enabled = True

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
26#
發表於 2014-2-27 09:28 | 只看該作者
回復 25# GBKEE


    Sub 防呆()  '要給物件類別模組呼叫,不可用 Private
    Dim A As Variant, i As Integer, Rng As Range, AR(1 To 2)
    CommandButton1.Enabled = False          '不可新增
    CommandButton2.Enabled = False          '不可修改
    CommandButton3.Enabled = False          '不可刪除
    A = Application.Match(Val(ComboBox1), Application.Transpose(ComboBox1.List), 0)
    If (IsNumeric(A) And ComboBox1.ListIndex = -1) Or ComboBox1.ListIndex > -1 Then
        CommandButton3.Enabled = True       '可以刪除
    End If
    For i = 2 To 35
        If i <= 33 Then
            If i <= 7 Then AR(1) = AR(1) & "," & Trim(Controls("TextBox" & i))
            'Ar(1): 記錄 -> Description,箱,Cuft,FOB-美金,FOB-歐元,總價'在表單的資料
            If Controls("TextBox" & i).BackColor = vbRed Then
                CommandButton1.Enabled = False      '不可新增
                CommandButton2.Enabled = False      '不可修改
                Exit Sub                            '離開 [防呆]這程式
            End If
        End If
        If IsNumeric(A) Then AR(2) = AR(2) & Trim(Controls("TextBox" & i))  'Ar(2): 記錄 -> 表單的所有資料
    Next
    If IsError(A) And IsNumeric(Trim(ComboBox1)) And InStr(AR(1) & ",", ",,") = 0 Then CommandButton1.Enabled = True 是從這裡改嗎?
                    'IsError(A) :Trim(ComboBox1 不在 ComboBox1.LIST 中, 可以新增
                    'IsNumeric(Trim(ComboBox1)) 視數字                , 可以新增
                    'InStr(Ar(1) & ",", ",,") = 0 ->沒有空白          , 可以新增
    If IsNumeric(A) And Msg_Data <> AR(2) Then CommandButton2.Enabled = True '可以修改
End Sub

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
25#
發表於 2014-2-27 06:48 | 只看該作者
回復 24# h99949
新增ITEM 有規則嗎?
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
24#
發表於 2014-2-26 18:45 | 只看該作者
回復 21# GBKEE

版主你好,在新增ITEM時只能打數字新增,改成文字時就不能新增
這要如何修改???

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
23#
發表於 2014-2-26 15:34 | 只看該作者
回復 21# GBKEE


    附上檔案

報價表單-2.rar (29.48 KB)

TOP

h99949

帖子
44 
主題
13 
精華
0 
積分
70 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-2-19 
最後登錄
2015-10-30 
22#
發表於 2014-2-26 15:30 | 只看該作者
回復 21# GBKEE

版主你好,我FOB美金的換算想改成=ROUND(總價/美金匯率/毛利率(追加TextBox38),2)
                                歐元的換算想改成=ROUND(總價/歐元匯率/毛利率(追加TextBox38),2)        
下面的程式要如何追加毛利率(追加TextBox38)這各欄位
Private Sub TextBox7_Change()    '總價
    If Val(Trim(TextBox7)) <> 0 Then
        If Val(Trim(TextBox5)) <> 0 And Val(Trim(TextBox36)) = 0 Then TextBox36 = Application.WorksheetFunction.Round(TextBox7 / TextBox5, 2)
                                                                                '=ROUND(總價/美金匯率/毛利率(追加),2)
        If Val(Trim(TextBox6)) <> 0 And Val(Trim(TextBox37)) = 0 Then TextBox37 = Application.WorksheetFunction.Round(TextBox7 / TextBox6, 2)
                                                                                '=ROUND(總價/美金匯率/毛利率(追加),2)
        If Val(Trim(TextBox36)) <> 0 Then TextBox5 = Application.WorksheetFunction.Round(TextBox7 / TextBox36, 2) '總價*美元匯率
        If Val(Trim(TextBox37)) <> 0 Then TextBox6 = Application.WorksheetFunction.Round(TextBox7 / TextBox37, 2) '總價*歐元匯率
    ElseIf Val(Trim(TextBox7)) = 0 Then
        TextBox5 = ""
        TextBox6 = ""
    End If
    If Msg Then 防呆
End Sub
Private Sub TextBox36_Change()
    If Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox36)) <> 0 Then
        TextBox5 = Application.WorksheetFunction.Round(TextBox7 / TextBox36, 2)
        '=ROUND(G2/30,2)
    ElseIf Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox5)) <> 0 Then
        TextBox5 = TextBox7
    End If
End Sub
Private Sub TextBox37_Change()
    If Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox37)) <> 0 Then
        TextBox6 = Application.WorksheetFunction.Round(TextBox7 / TextBox37, 2)
        '=ROUND(G2/40,2)
    ElseIf Val(Trim(TextBox7)) <> 0 And Val(Trim(TextBox6)) <> 0 Then
        TextBox6 = TextBox7
    End If
End Sub

未命名.JPG (76.61 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兔年全勤獎章
21#
發表於 2014-2-26 14:48 | 只看該作者
回復 20# h99949
無法設定List屬性
  1. Private Sub Item_List()   '建立ComboBox1的List
  2.     Dim AR
  3.     Set Sh = Sheets("雜菜鍋")
  4.     With Sh
  5.         If .Range("a1").End(xlDown).Row = .Rows.Count Then
  6.             ComboBox1.Clear
  7.         Else
  8.             AR = .Range("a2:a" & .Range("a1").End(xlDown).Row).Value
  9.             If .Range("a1").End(xlDown).Row = 2 Then AR = Array(AR)
  10.             ComboBox1.List = AR
  11.         End If
  12.     End With
  13. End Sub
複製代碼
追加欄位工時=30000*10/20/1000*D/C
  1. Option Explicit  '物件模組程式碼
  2. Public WithEvents Text_A As MSForms.TextBox
  3. Public WithEvents Text_B As MSForms.TextBox
  4. Private Sub Text_A_Change()
  5.     Dim S As Integer
  6.     With Text_A
  7.          With .Parent
  8.             '追加欄位工時 = 30000 * 10 / 20 / 1000 * D / C
  9.             If IsNumeric(.TextBox3) And IsNumeric(.TextBox4) Then
  10.                
  11.                 S = CLng(30000) * 10 / 20 / 1000 * .TextBox4 / .TextBox3
  12.                 .TextBox27 = Application.WorksheetFunction.Round(S, 2)
  13.             Else
  14.                 .TextBox27 = ""
  15.             End If
  16.         End With
  17.         '******************************************
  18.         S = Val(Replace(UCase(.Name), "TEXTBOX", ""))
  19.         If (IsNumeric(.text) And Val(.text) > 0) Or (.Name = "TextBox2" And Trim(.text) <> "") Then
  20.             Select Case S
  21.                 Case 2 To 4
  22.                      .BackColor = &HE0E0E0
  23.                 Case Else
  24.                     .BackColor = vbYellow
  25.             End Select
  26.         Else
  27.             .BackColor = vbRed
  28.         End If
  29.         If .Parent.Msg Then .Parent.防呆
  30.     End With
  31. End Sub
  32. Private Sub Text_B_Change()   '總價的加總
  33.     Dim i As Integer, S
  34.     With Text_B
  35.         For i = 8 To 27  '****'追加欄位工時
  36.             If IsNumeric(.Parent.Controls("TextBox" & i)) Or Trim(.Parent.Controls("TextBox" & i)) = "" Then
  37.                 S = S + Val(.Parent.Controls("TextBox" & i))
  38.             End If
  39.         Next
  40.         .Parent.TextBox7 = IIf(S = 0, "", Int(S))
  41.         If IsNumeric(.text) Or Trim(.text) = "" Then
  42.             .BackColor = &HE0E0E0
  43.         Else
  44.             .BackColor = vbRed
  45.         End If
  46.        If .Parent.Msg Then .Parent.防呆
  47.     End With
  48. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人生沒有所有權，只有生命的使用權。
123
返回列表 上一主題