Question

这是我第一次问问题，希望我能提供足够的信息。我有一个表格，该表格有15个相同的行供用户填写，因为他们扫描相应的2D条形码并且应该匹配。每个角色包括以下内容：

文本框[ERP1]，文本框[Code1]，文本框[Show1] 下一行：文本框[ERP2]，文本框[Code2]，文本框[Show2] 总共有15行。

我已经为第1行编写了代码（见下文），它运行得很好。但是，我必须手动复制并替换xxx1到xxx2的代码（请参见下文），并重复15次。我不确定是否有更好的方法可以做到这一点。谁能提出更好的方法？谢谢！

Private Sub ERP1_AfterUpdate()

If Me.ERP1 = "CALC16" Then
     Me!Code1.Enabled = True
        Me!Code1.Locked = False
        Me!Code1.SetFocus
        Else
        If IsNull(Me.ERP1.Value) Then
         Me!Code1.Enabled = False
        Me!Code1.Locked = True
        Else
        Me!Code1.Enabled = False
        Me!Code1.Locked = True
        MsgBox ("Scanned Wrong Location / Order!")
End If
End If
End Sub

Private Sub Code1_AfterUpdate()
Dim Vcode As String
Dim Vbatch As String
Dim VExp As String
Dim nline As String
nline = Chr(10) & Chr(13)

Vcode = extract_code(Code1)
Vbatch = extract_batch(Code1)
VExp = Format(extract_expdate(Code1), "dd/mm/yyyy")

If Vcode = Me.ERP1 Then

Dim StrSQLER As String
StrSQLER = "[A_KitID] = '" & [KitNo] & "' AND [A_ItemCode] = '" & Vcode & "'"

Dim ActBatch As String
Dim ActExp As String
ActBatch = DLookup("[A_Batch]", "Active", StrSQLER)
ActExp = DLookup("[A_Exp]", "Active", StrSQLER)

    If (Vbatch = ActBatch) And (VExp = ActExp) Then
    Me.show1.Value = "OK!"
    Me.show1.BackColor = RGB(203, 226, 200)
    Me.show1.ForeColor = RGB(0, 0, 0)

     Me!ERP2.Enabled = True
        Me!ERP2.Locked = False
        Me!ERP2.SetFocus


    Else
    Me.show1.Value = "X"
    Me.show1.BackColor = RGB(233, 38, 51)
    Me.show1.ForeColor = RGB(255, 255, 255)
    MsgBox ("Batch and Expiry Does not match with System Record" & nline & "Current Recorded Batch: " & ActBatch & nline & "Current Recorded Expiry Date: " & ActExp & nline & nline & "Please update kit content if appropriate")


    Exit Sub
    End If

Else
MsgBox ("Scanned Item does not match with the location")
Exit Sub
End If
End Sub

Private Sub ERP2_AfterUpdate()

If Me.ERP2 = "LIGN18" Then
     Me!Code2.Enabled = True
        Me!Code2.Locked = False
        Me!Code2.SetFocus
        Else
        If IsNull(Me.ERP2.Value) Then
         Me!Code2.Enabled = False
        Me!Code2.Locked = True
        Else
        Me!Code2.Enabled = False
        Me!Code2.Locked = True
        MsgBox ("Scanned Wrong Location / Order!")
End If
End If
End Sub

Private Sub Code2_AfterUpdate()
Dim Vcode As String
Dim Vbatch As String
Dim VExp As String
Dim nline As String
nline = Chr(10) & Chr(13)

Vcode = extract_code(Code2)
Vbatch = extract_batch(Code2)
VExp = Format(extract_expdate(Code2), "dd/mm/yyyy")

If Vcode = Me.ERP2 Then

Dim StrSQLER As String
StrSQLER = "[A_KitID] = '" & [KitNo] & "' AND [A_ItemCode] = '" & Vcode & "'"

Dim ActBatch As String
Dim ActExp As String
ActBatch = DLookup("[A_Batch]", "Active", StrSQLER)
ActExp = DLookup("[A_Exp]", "Active", StrSQLER)

    If (Vbatch = ActBatch) And (VExp = ActExp) Then
    Me.show2.Value = "OK!"
    Me.show2.BackColor = RGB(203, 226, 200)
    Me.show2.ForeColor = RGB(0, 0, 0)

     Me!ERP3.Enabled = True
        Me!ERP3.Locked = False
        Me!ERP3.SetFocus


    Else
    Me.show2.Value = "X"
    Me.show2.BackColor = RGB(233, 38, 51)
    Me.show2.ForeColor = RGB(255, 255, 255)
    MsgBox ("Batch and Expiry Does not match with System Record" & nline & "Current Recorded Batch: " & ActBatch & nline & "Current Recorded Expiry Date: " & ActExp & nline & nline & "Please update kit content if appropriate")


    Exit Sub
    End If

Else
MsgBox ("Scanned Item does not match with the location")
Exit Sub
End If
End Sub

访问VBA循环代码

0 个答案: