Question

我有一个用户表单用于由店主输入接收数据，我想设置一些必填字段用于填写。它们是用户名，部件号和接收文件的存储位置。我正在使用我的“ref”工作表的数据将项目添加到我的组合框中。我强迫组合框不接受该列表中的任何项目。（通过使用字段属性“matchrequired”为true）。我有4个命令按钮，用于保存和关闭，“添加项目”用于向当前发行说明添加新项目，新发行说明，清除R / N数据并再次请求，最后关闭，关闭表格。我的问题是如何强制VBA检查“USER”，“P / N”和“Location”中是否有任何数据，如果这三个字段至少有数据，则可以输入数据。我还希望代码能够检查QTY字段的条目并且只接受数字（例如1到5000之间）。使用DONE按钮一切正常，但对于两个（“添加项目”和“新发行说明”），返回了愚蠢的错误。在显示数据的msg框清除后，组合的项目将丢失或返回错误，因此......

我使用“addcmbo”将项目添加到组合控件。（仅当用户在我这里放置时，值在组合索引中重复，并且在消息框之后，此控件的项目仍然存在）。

如果您发现任何“不良做法”的方法，请告诉我。

'Receiving Rear Fuse' form

Sub addcmbo()
Application.ScreenUpdating = False
            Sheet2.Activate
        ' A/C data update
            For i = 2 To WorksheetFunction.CountA(Range("b:b"))
                If Sheets("Ref").Cells(i, 2) <> "" Then
                    RCVNG.cmbac.AddItem (Cells(i, 2))
                End If
            Next
        ' W/B data update
            For i = 2 To WorksheetFunction.CountA(Range("h:h"))
                If Sheets("Ref").Cells(i, 8) <> "" Then
                    RCVNG.Cmbwb.AddItem (Cells(i, 8))
                End If
            Next
        ' w/C data update
            For i = 2 To WorksheetFunction.CountA(Range("i:i"))
                If Sheets("Ref").Cells(i, 9) <> "" Then
                    RCVNG.Cmbwc.AddItem (Cells(i, 9))
                End If
            Next
        ' P/# data update
            For i = 2 To WorksheetFunction.CountA(Range("j:j"))
                If Sheets("Ref").Cells(i, 10) <> "" Then
                    RCVNG.Cmbpn.AddItem (Cells(i, 10))
                End If
            Next
                Sheet1.Activate
                Application.ScreenUpdating = True
End Sub
Private Sub btnCncl_Click()
    Unload Me
End Sub

Private Sub btnadditem_Click()

 '    Form fields Clear
    cmbac.Clear
    Cmbwb.Clear
    Cmbwc.Clear
    Cmbpn.Clear
'        cmbac.Value = ""
'        Cmbwb.Value = ""
'        Cmbwc.Value = ""
'        Cmbpn.Value = ""
    Txtqty.Value = ""
    txtSN.Value = ""
    Txtloc.Value = ""
    cmnt.Value = ""

'    Data entry sufficiency check
 If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
    MsgBox "Please Fill Required Fields " & Chr(10) & "   *  User" & Chr(10) & "   *  Part #" & Chr(10) & "   *  Location" & Chr(10) & " before Save!"
    Call addcmbo
   Else:
'    Data Entry
       Sheet1.Activate
       Dim oNewRow As ListRow
       ActiveSheet.Cells(1, 3).Select
       Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
        oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
        oNewRow.Range.Cells(1, 7).Value = txtrn.Value
        oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
        oNewRow.Range.Cells(1, 8).Value = cmbac.Value
        oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
        oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
        oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
        oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
        oNewRow.Range.Cells(1, 13).Value = txtSN.Value
        oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
        oNewRow.Range.Cells(1, 16).Value = cmnt.Value
    End If
End Sub

Private Sub btndone_Click()
'    Data entry sufficiency check
    If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
        MsgBox "Please Fill Required Fields " & Chr(10) & "   *  User" & Chr(10) & "   *  Part #" & Chr(10) & "   *  Location" & Chr(10) & " before Save!"
    Else:
'    Data Entry
    Sheet1.Activate
        ActiveSheet.Cells(1, 3).Select
        Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
        oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
        oNewRow.Range.Cells(1, 7).Value = txtrn.Value
        oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
        oNewRow.Range.Cells(1, 8).Value = cmbac.Value
        oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
        oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
        oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
    oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
    oNewRow.Range.Cells(1, 13).Value = txtSN.Value
    oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
    oNewRow.Range.Cells(1, 16).Value = cmnt.Value
Unload Me
End If

End Sub

Private Sub btnnewrn_Click()
Dim oNewRow As ListRow
'    Form fields Clear
    txtrn.Value = ""
    cmbac.Clear
    Cmbwb.Clear
    Cmbwc.Clear
    Cmbpn.Clear
    cmbac.Value = ""
    Cmbwb.Value = ""
    Cmbwc.Value = ""
    Cmbpn.Value = ""
    Txtqty.Value = ""
    txtSN.Value = ""
    Txtloc.Value = ""
    cmnt.Value = ""

'    Data entry sufficiency check
If cmbuser = "" Or Cmbpn = "" Or Txtloc = "" Then
    MsgBox "Please Fill Required Fields " & Chr(10) & "   *  User" & Chr(10) & "   *  Part #" & Chr(10) & "   *  Location" & Chr(10) & " before Save!"
    Call addcmbo
Else:
'    Data Entry
    Sheet1.Activate
    ActiveSheet.Cells(1, 3).Select
    Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
    oNewRow.Range.Cells(1, 6).Value = DTPicker.Value
    oNewRow.Range.Cells(1, 7).Value = txtrn.Value
    oNewRow.Range.Cells(1, 14).Value = cmbuser.Value
    oNewRow.Range.Cells(1, 8).Value = cmbac.Value
    oNewRow.Range.Cells(1, 10).Value = Cmbwb.Value
    oNewRow.Range.Cells(1, 9).Value = Cmbwc.Value
    oNewRow.Range.Cells(1, 11).Value = Cmbpn.Value
    oNewRow.Range.Cells(1, 12).Value = Txtqty.Value
    oNewRow.Range.Cells(1, 13).Value = txtSN.Value
    oNewRow.Range.Cells(1, 15).Value = Txtloc.Value
    oNewRow.Range.Cells(1, 16).Value = cmnt.Value
End If
End Sub

Private Sub lblpn_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim pn As String
Application.ScreenUpdating = False
Sheet2.Activate
emptyRow = WorksheetFunction.CountA(Range("j:j")) + 1
pn = inputbox("Type In new ''P/#'' please", "Add NEW P/#")
    Cells(emptyRow, 10).Value = pn
    RCVNG.Cmbpn.AddItem pn
End Sub

 Private Sub lblTeam_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim t As String
Application.ScreenUpdating = False
Sheet2.Activate
emptyRow = WorksheetFunction.CountA(Range("c:c")) + 1
t = inputbox("Type type Your Name Please", "Add name of NEW or Missing team member")
    Cells(emptyRow, 3).Value = t
    RCVNG.cmbuser.AddItem t
End Sub


Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Sheet2.Activate
DTPicker.SetFocus
DTPicker.Value = Date
'    empty fields
   shipreceive.Value = ""
    txtrn.Value = ""
    cmbuser.Clear
    cmbac.Clear
    Cmbwb.Clear
    Cmbwc.Clear
    Cmbpn.Clear
    Txtqty.Value = ""
    txtSN.Value = ""
    Txtloc.Value = ""
    cmnt.Value = ""
    ' Combo fields add item
    Call addcmbo
    ' User data update
    Application.ScreenUpdating = False
    Sheet2.Activate
    For i = 2 To WorksheetFunction.CountA(Range("c:c"))
        If Sheets("Ref").Cells(i, 3) <> "" Then
            RCVNG.cmbuser.AddItem (Cells(i, 3))
        End If
    Next
    Sheet1.Activate
    Application.ScreenUpdating = True
    End Sub

非常感谢，感谢您的帮助

以用户身份

0 个答案: