Board logo

標題: excel 報價表單上輸入不同的Item如何帶入不同的圖片 [打印本頁]
作者: h99949    時間: 2014-2-19 08:25     標題: excel 報價表單上輸入不同的Item如何帶入不同的圖片

請問各位高手,我在excel 表單上的圖片(Image)
想依照表單上輸入不同的Item帶入不同的圖片(圖片儲存在D:\catalogue裡)
程式碼應該要怎麼寫??
作者: GBKEE    時間: 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
複製代碼
作者: h99949    時間: 2014-2-19 13:11

你好,圖片是放在電腦的D:\catalogue裡並不是網址裡,請問程式該如何修改?
作者: h99949    時間: 2014-2-19 13:17

圖片不是固定的它是可以依輸入的資料不同作變化
作者: h99949    時間: 2014-2-19 13:45

回復 2# GBKEE
可以將預設的照片改成電腦裡的圖片嗎?
作者: GBKEE    時間: 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
複製代碼
作者: h99949    時間: 2014-2-20 22:48

回復 6# GBKEE
版主你好,已經以用了,謝謝
但我想在表單輸入Item後帶出來的相關資料,可以在表單上修改後直接儲存到相對應的儲存格上,程式應該如何做修改呢?
作者: GBKEE    時間: 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
複製代碼
作者: h99949    時間: 2014-2-21 10:49

回復 8# GBKEE
Private Sub TextBox1_Change()變數未定義該如何修改
作者: GBKEE    時間: 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  '這裡有嗎?
複製代碼
作者: h99949    時間: 2014-2-21 11:24

回復 10# GBKEE


    Dim Rng As Range, Text_Ar(), AR(), Rng_Text As String有這個
作者: h99949    時間: 2014-2-21 13:19

回復 10# GBKEE
作者: GBKEE    時間: 2014-2-21 13:56

回復 12# h99949
cell 改成 Rng
作者: h99949    時間: 2014-2-21 14:23

回復 13# GBKEE


    ok了,謝謝版主
作者: h99949    時間: 2014-2-21 14:43

回復 13# GBKEE


版主,在請問一下,在顯示格出現的數字的格式要顯示成有千分位(,)點的格是要在哪裡做修改
列如20000變成20,000
作者: GBKEE    時間: 2014-2-21 14:54

回復 15# h99949
  1. Private Sub CommandButton1_Click()
  2.     Dim s As String, i As Integer
  3.     If Rng Is Nothing Then
  4.         s = "貨號中沒有 " & TextBox1
  5.     ElseIf Rng_Text = Join(Text_Ar, "") Then
  6.         s = "貨號" & TextBox1 & "資料沒有修改 !!"
  7.     End If
  8.     If s = "" Then
  9.         If MsgBox(TextBox1 & "修改資料 !!", 32 + vbYesNo) = vbYes Then
  10.             For i = 1 To UBound(AR)
  11.                 With Rng.Offset(, AR(i))
  12.                     .Value = Text_Ar(i) '導入TextBox?數字(文字型態)到Rng
  13.                     .Value = .Value
  14.                     .NumberFormatLocal = "#,##0.00_ "
  15.                 End With
  16.             Next
  17.         End If
  18.     End If
  19. End Sub
複製代碼
作者: h99949    時間: 2014-2-21 16:07

回復 16# GBKEE


    可以了,謝謝
作者: h99949    時間: 2014-2-21 17:47

回復 16# GBKEE


版主,請問我在表單上修改後直接儲存到相對應的儲存格時,如果要在不影響到FOB-美金,FOB-歐元,總價,20呎櫃,40呎櫃內原本的算計公式時,並能即時顯示修改後計算的結果時
程式該如何修改
作者: GBKEE    時間: 2014-2-25 16:43

本帖最後由 GBKEE 於 2014-2-26 14:43 編輯

回復 18# h99949
完整版的資料 [新增],[修正],[刪除] 按鍵
找不路徑時修改  Const 預設照片 = "D:\客戶報價單\catalogue\GEIST.gif"


[attach]17599[/attach]
作者: h99949    時間: 2014-2-26 12:44

回復 19# GBKEE


版主不好意思,總價應該=(J:AA)的加總
                               追加欄位工時=30000*10/20/1000*D/C
程式碼應該在哪裏修改
試用後如果貨號從11個刪到第2個時會出現無法設定List屬性該如何修改
作者: GBKEE    時間: 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
複製代碼
作者: h99949    時間: 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
作者: h99949    時間: 2014-2-26 15:34

回復 21# GBKEE


    附上檔案
作者: h99949    時間: 2014-2-26 18:45

回復 21# GBKEE

版主你好,在新增ITEM時只能打數字新增,改成文字時就不能新增
這要如何修改???
作者: GBKEE    時間: 2014-2-27 06:48

回復 24# h99949
新增ITEM 有規則嗎?
作者: h99949    時間: 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
作者: h99949    時間: 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
作者: GBKEE    時間: 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
複製代碼
作者: h99949    時間: 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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)