0
我正在构建一个每周时间表跟踪数据库。输入表单包含2个列表框。 “ListBox1”和“ListBox2”。 ListBox1允许用户选择一个特定的项目，一旦选择了一个项目 - 各种文本框都填充了信息。用户然后可以输入他们每天的工作时间。当用户点击一个提交按钮时，代码验证是否为所选项目分配了工作表 - 如果是 - 它会将输入的数据加载到工作表中，如果没有，则会创建一个新工作表。一旦输入数据，它将计算并自动发送通知电子邮件，如果符合某些标准。列表框更新顺序不正确
在这一点上 - 当点击“提交”按钮时，列表框2更新了该给定项目工作表中所有输入条目的内容。
我宁愿让ListBox 2更新为用户从ListBox 1中选择项目。我试着将相关代码移动到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
