Question

我正在构建每周时间表跟踪数据库。输入表单包含2个列表框。＆＃34; ListBox1中＆＃34;和＆＃34; ListBox2＆＃34; 。 ListBox1允许用户选择一个特定的项目，一旦选择了一个项目 - 各种文本框都填充了信息。然后，用户可以输入他们的每日工作时间。当用户单击提交按钮时，代码验证是否为所选项目分配了工作表 - 如果是 - 它将输入的数据加载到工作表中，如果不存在则会创建新工作表。输入数据后，如果满足某些条件，它将计算并自动发送通知电子邮件。

此时 - 当＆＃34;提交＆＃34;时，ListBox 2会更新该给定项目工作表的所有输入条目的内容。单击按钮。

当用户从ListBox 1中选择项目时，我宁愿更新ListBox 2。我已经尝试将相关代码移动到Listbox1_Click（）例程，但无济于事。

我对此非常陌生，所以任何建议都会受到高度赞赏。

目前的工作代码。

Private Sub CommandButton1_Click()
'activateSheet(Weeklyhours As String)
'Sheets(Weeklyhours).Select
'ActiveSheet.Range("I2").Select = TxtMonhours.Text
'ActiveSheet.Range("j2").Select = TxtTueshours.Text
Dim Total As Double
Dim i As Integer
Dim PO As String
Dim CoRequest As Integer

'Make sure correct worksheet is selected to store data
'Application.Workbooks("TestDataBase.xlsx")

'Add a sheet for the PO Number
PO_Sheet_Name = txtPO.Text
CoRequest = txtPOhours.Value * 0.2
MsgBox "Safety hours level = " & CoRequest
Safetyhrs.Text = "FYI - Hours Warnings will commence below " & CoRequest & " hours."
'Check to see if a sheet already exists
For rep = 1 To (Worksheets.Count)
    If LCase(Sheets(rep).Name) = LCase(PO_Sheet_Name) Then 'If a sheet exists activate it and confirm hours are available
     Sheets(PO_Sheet_Name).Activate
        'Confirm hours left.
        MsgBox "Hrs available = " & txthrsavail.Value
        If txthrsavail.Value <> "0" Or txthrsavail.Value < "0" Then
          'Find last row
            LastRow = Worksheets(PO_Sheet_Name).Cells(65000, 9).End(xlUp).Row
            FirstRow = Worksheets(PO_Sheet_Name).Cells(2, 9).Row
            i = LastRow + 1
            'MsgBox LastRow

            Cells(LastRow + 1, 8).Value = txtPO.Text
            Cells(LastRow + 1, 9).Value = txtweek.Text
            Cells(LastRow + 1, 10).Value = TxtMonhours.Text
            Cells(LastRow + 1, 11).Value = TxtTuehours.Text
            Cells(LastRow + 1, 12).Value = TxtWedhours.Text
            Cells(LastRow + 1, 13).Value = TxtThurhours.Text
            Cells(LastRow + 1, 14).Value = Txtfrihours.Text
            Cells(LastRow + 1, 15).Value = txtSathrs.Text
            Cells(LastRow + 1, 16).Value = txtSunhrs.Text
            'Add total hours for week
            Cells(LastRow + 1, 18).Activate
                   ActiveCell.FormulaR1C1 = "=SUM(RC[-8]:RC[-2])"


            'Calculate total hours todate
            Total = Application.sum(Sheets(PO_Sheet_Name).Range("r3:r" & i))
            MsgBox "Total hours consumed = " & Total & "Hrs."
            txtweektotal.Text = Cells(LastRow + 1, 18)
            txthoursused.Text = Total
            txthrsavail.Text = txtPOhours.Value - Total

            Cells(LastRow + 1, 20).Value = txthrsavail.Text
            ' Upade table
            With Me.ListBox2
                    .ColumnCount = 14
                    .ColumnWidths = "70;55;55;55;55;55;55;55;55;20;45;10;55;55"
                    .RowSource = Sheets(PO_Sheet_Name).Range("h2:t" & i).Address
            End With

            'Issue Status Check
                If txthrsavail.Value < CoRequest And txthrsavail.Value > "0" Or txthrsavail.Value = CoRequest And txthrsavail.Value > "0" Then

                     MsgBox "There are only " & txthrsavail.Value & " hours remaining plesase notify your supervisor"

                Call Mail_ActiveSheet

                ElseIf txthrsavail.Value = "0" Or txthrsavail.Value < "0" Then

                MsgBox "No Hours are available on this PO - please speak to your manager and stop all work", vbCritical

                End If
              End If
             Exit Sub

    End If


Next 'If no sheet exists - create a sheet that matches the PO number
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(ActiveSheet.Name).Name = PO_Sheet_Name
      MsgBox "Creating PO Sheet as it does not Exist"
       'Enter Header Lines for spreadsheet
        Range("H2").Select
            ActiveCell.FormulaR1C1 = "PO Number"
        Range("I2").Select
             ActiveCell.FormulaR1C1 = "Weekend"
        Range("J2").Select
             ActiveCell.FormulaR1C1 = "Monday"
        Range("K2").Select
              ActiveCell.FormulaR1C1 = "Tuesday "
        Range("L2").Select
             ActiveCell.FormulaR1C1 = "Wednesday "
        Range("M2").Select
             ActiveCell.FormulaR1C1 = "Thursday "
        Range("N2").Select
                ActiveCell.FormulaR1C1 = "Friday"
        Range("O2").Select
             ActiveCell.FormulaR1C1 = "Sathurday "
        Range("P2").Select
             ActiveCell.FormulaR1C1 = "Sunday"
        Range("R2").Select
             ActiveCell.FormulaR1C1 = "Total"
        Range("T2").Select
             ActiveCell.FormulaR1C1 = "Hours Remaining"

'Enter Data
'Find last row
        LastRow = Worksheets(PO_Sheet_Name).Cells(65000, 9).End(xlUp).Row
        FirstRow = Worksheets(PO_Sheet_Name).Cells(2, 9).Row
        i = LastRow + 1
        'MsgBox LastRow

 'Enter data to rows
        Cells(LastRow + 1, 8).Value = txtPO.Text
        Cells(LastRow + 1, 9).Value = txtweek.Text
        Cells(LastRow + 1, 10).Value = TxtMonhours.Text
        Cells(LastRow + 1, 11).Value = TxtTuehours.Text
        Cells(LastRow + 1, 12).Value = TxtWedhours.Text
        Cells(LastRow + 1, 13).Value = TxtThurhours.Text
        Cells(LastRow + 1, 14).Value = Txtfrihours.Text
        Cells(LastRow + 1, 15).Value = txtSathrs.Text
        Cells(LastRow + 1, 16).Value = txtSunhrs.Text
        ' 'Add total hours for week
        Cells(LastRow + 1, 18).Activate
               ActiveCell.FormulaR1C1 = "=SUM(RC[-8]:RC[-2])"

        'Calculate total hours todate
        Total = Application.sum(Sheets(PO_Sheet_Name).Range("r3:r" & i))

        txtweektotal.Text = Cells(LastRow + 1, 18)
        txthoursused.Text = Total
        txthrsavail.Text = txtPOhours.Value - Total

        Cells(LastRow + 1, 20).Value = txthrsavail.Text
 'issue status check
      If txthrsavail.Value < CoRequest And txthrsavail.Value > "0" Then

        MsgBox "There are only " & txthrsavail.Value & "available plesase notify your supervisor"
 'send mail update
      Call Mail_ActiveSheet


      ElseIf txthrsavail.Value = "0" Or txthrsavail.Value < "0" Then


        MsgBox "You have no hours left on PO - Please contact your manager and stop all work", vbCritical
      End If
 'Load history
    With Me.ListBox2
     .ColumnCount = 14
     .ColumnWidths = "70;55;55;55;55;55;55;55;55;20;45;10;55;55"
     .RowSource = Sheets(PO_Sheet_Name).Range("h2:t" & i).Address
    End With
ActiveWorkbook.Save
End Sub

目前的ListBox1代码。 [我已经注释了我放置Me.ListBox2命令的位置，因为它无法正常运行。]

Private Sub ListBox1_Click()
Dim Total As Long
Dim i As Integer
Dim PO As String
Dim CoRequest As Integer

PO_Sheet_Name = txtPO.Text
Sheets("Projects Sheet").Range("k3").Value = ListBox1.Value
txtsponsor.Text = Sheets("Projects Sheet").Range("L3")
txtPOhours.Text = Sheets("Projects Sheet").Range("M3")
txtPO.Text = Sheets("Projects Sheet").Range("N3")
'Find last row
           ' LastRow = Worksheets(PO_Sheet_Name).Cells(65000, 9).End(xlUp).Row
            'FirstRow = Worksheets(PO_Sheet_Name).Cells(2, 9).Row
           ' i = LastRow + 1


' With Me.ListBox2
   '     .ColumnCount = 14
    '    .ColumnWidths = "70;55;55;55;55;55;55;55;55;20;45;10;55;55"
    '    .RowSource = Sheets(PO_Sheet_Name).Range("h2:r" & i).Address
'  End With

Answer 1

您应该使用ListBox1_Change或ListBox1_BeforeUpdate

以下是MicroSoft VBA的屏幕截图，您可以使用两个下拉列表来选择对象和关联的事件：

Where can you select events?

然而Private Sub ListBox1_Click()已经存在，所以我不知道你的问题是什么

列表框更新顺序不正确

1 个答案: