2015-05-04 89 views
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 

回答

0

您應該使用ListBox1_ChangeListBox1_BeforeUpdate

這裏是微軟VBA的截圖,你可以使用頂部的兩個下拉列表選擇一個對象和相關事件

Where can you select events?

Private Sub ListBox1_Click()是存在的所以我不知道你的問題是什麼