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

h99949

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

h99949

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

GBKEE

回復 27# h99949

沒有IsText 這函數
Trim() :清除前後的空白字串
Trim(ComboBox1)<>"" -> 有字串

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

複製代碼

h99949

回復 25# GBKEE


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

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

h99949

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

GBKEE

回復 24# h99949
新增ITEM 有規則嗎?

h99949

回復 21# GBKEE

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

h99949

回復 21# GBKEE


    附上檔案

h99949

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

GBKEE

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

複製代碼