我正在構建一個每週時間表跟蹤數據庫。輸入表單包含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