|
淘寶掃描上面二維碼關(guān)注最新兒童成長型多功能書桌！現(xiàn)在購買還有大禮相送！ 書接上文： 為了輸入時能逐步提示信息，在文本框控件和列表框控件中寫入下面的代碼。 Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger，ByVal Shift As Integer) Dimi As Integer DimLanguage As String DimmyStr As String Me.ListBox1.Clear WithMe.TextBox1 For i = 1 To Len(.Value) Select Case Asc(Mid$(.Value，i，1)) Case 48 To 56 Language = 'S' myStr = myStr & Mid$(.Value，i，1) Case Is <>，Is > 255 Language = 'Z' myStr = myStr & Mid$(.Value，i，1) Case Else Language = 'P' myStr = myStr & LCase(Mid$(.Value，i，1)) End Select Next EndWith WithSheet2 For i = 3 To .Range('A65536').End(xlUp).Row Select Case Language Case 'S' If Left(.Cells(i，1).Value，Len(myStr)) = myStr Then Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount- 1，0) = .Cells(i，1).Value Me.ListBox1.List(Me.ListBox1.ListCount- 1，1) = .Cells(i，2).Value End If Case 'Z' If Left(.Cells(i，2).Value，Len(myStr)) = myStr Then Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount- 1，0) = .Cells(i，1).Value Me.ListBox1.List(Me.ListBox1.ListCount- 1，1) = .Cells(i，2).Value End If Case Else If Left(.Cells(i，6).Value，Len(myStr)) = myStr Then Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount- 1，0) = .Cells(i，1).Value Me.ListBox1.List(Me.ListBox1.ListCount- 1，1) = .Cells(i，2).Value End If End Select Next EndWith End Sub 代碼解析： 文本框的KeyUp事件，在文本框中輸入姓名時根據(jù)輸入的內(nèi)容進行逐步提示，可以使用三種方法進行輸入，人員編號、中文字符和拼音首字母。 第7行到第19行代碼，使用字符串變量Language保存輸入的方式，字符串變量myStr保存輸入的內(nèi)容。 第21行到第42行代碼，根據(jù)輸入方法的不同，在Sheet2表的不同列中查找符合字符串變量myStr的單元格，并賦給列表框控件。 Private Sub TextBox1_KeyDown(ByVal KeyCode AsMSForms.ReturnInteger，ByVal Shift As Integer) If KeyCode= vbKeyReturn Then Sheet1.ListBox1.Activate EndIf End Sub 代碼解析： 文本框的KeyDown事件，在文本框中輸入查詢條件，當(dāng)列表框中出現(xiàn)符合條件的數(shù)據(jù)后按回車鍵后選擇列表框，方便輸入。 Private Sub ListBox1_GotFocus() On ErrorResume Next ListBox1.ListIndex= 0 End Sub 代碼解析： 列表框的GotFocus事件，當(dāng)列表框激活后選擇第一條條目，以便用戶按上下鍵進行選擇或按回車鍵后輸入到工作表中。 Private Sub ListBox1_KeyDown(ByVal KeyCode AsMSForms.ReturnInteger，ByVal Shift As Integer) On ErrorResume Next If KeyCode= vbKeyReturn Then Sheet1.Unprotect ActiveCell.Value = Me.ListBox1.Column(1) ActiveCell.Offset(，-1).Value = Me.ListBox1.Column(0) Me.ListBox1.Clear Me.TextBox1 = ““ Me.ListBox1.Visible = False Me.TextBox1.Visible = False Sheet1.Protect EndIf End Sub 代碼解析： 列表框的KeyDown事件，按回車鍵后將列表框中選擇的條目輸入到工作表中，并清除文本框和列表框的內(nèi)容后隱藏，以便下一次輸入。 Private Sub ListBox1_DblClick(ByVal Cancel AsMSForms.ReturnBoolean) On ErrorResume Next Sheet1.Unprotect ActiveCell.Value= Me.ListBox1.Column(1) ActiveCell.Offset(，-1).Value = Me.ListBox1.Column(0) Me.ListBox1.Clear Me.TextBox1= ““ Me.ListBox1.Visible= False Me.TextBox1.Visible= False Sheet1.Protect End Sub 代碼解析： 列表框的DblClick事件，雙擊列表框中選擇的條目，輸入到工作表中，并清除文本框和列表框的內(nèi)容后隱藏，以便下一次輸入。輸入時逐步提示信息請參閱▲114 。 步驟5，為了在輸入人員姓名后在Sheet1工作表的C列中寫入相應(yīng)的日工資標準，在Sheet1工作表的寫入下面的代碼。 Private Sub Worksheet_Change(ByVal Target As Range) Dimrng As Range Dimr As Integer On ErrorResume Next WithTarget If .Row > 4 And .Count = 1 Then If .Column = 1 Then r = Sheet2.Range('A63556').End(xlUp).Row For Each rng In Sheet2.Range('A3:A'& r) If rng.Text Like .Text Then .Offset(，2).Value = rng.Offset(，4).Value End If Next End If If .Column = 2 Then If .Text = ““ Then Application.EnableEvents = False Sheet1.Unprotect Rows(.Row).Delete Sheet1.Protect Application.EnableEvents = True End If End If #024 End If EndWith End Sub 代碼解析： Sheet1工作表的Change事件，當(dāng)輸入人員編號和人員姓名后，將對應(yīng)的日工資標準寫入到Sheet1工作表的C列中。 第6行代碼設(shè)置事件的觸發(fā)條件。 第7行到第14行代碼，刪除B列單元格中的人員姓名則同時刪除對應(yīng)的人員編號和日工資標準。 第18行到第29行代碼，檢查輸入的人員姓名是否重復(fù)。因為單位中可能有重復(fù)的人員姓名，但是人員編號是唯一的，所以根據(jù)人員編號檢查輸入的人員姓名是否重復(fù)。 第30行到第34行代碼，使用Like方法在根據(jù)人員編號在Sheet2表的A列中查找相對應(yīng)的人員編號，找到后將日工資標準寫入到Sheet1工作表的C列中。 在Sheet1工作表的B列中輸入人員姓名后效果。 步驟6，在某些情況下，可能需要輸入全部人員的姓名，比如在筆者單位每年的7、8月份要發(fā)放高溫加班工資，這時可以從Sheet2表中將所有人員的姓名和編號導(dǎo)入到Sheet1表中，需要在模塊中寫入下面的代碼。 Sub ImportName() Dimr1 As Integer Dimr2 As Integer Dimi As Long r1 =Sheet1.Range('B63556').End(xlUp).Row r2 =Sheet2.Range('B63556').End(xlUp).Row If MsgBox('確定要導(dǎo)入所有人員姓名嗎'，32 + vbYesNo，'系統(tǒng)提示') = vbNo Then Exit Sub Application.ScreenUpdating= False WithSheet1 .Select .Unprotect If r1 <= r2="" +="" 3="" then="" .rows(r1).resize(r2-="" r1="" +=""> For i = 5 To Sheet1.Range('B63556').End(xlUp).Row- 2 .Cells(i，1) = Sheet2.Cells(i - 2，1) .Cells(i，2) = Sheet2.Cells(i - 2，2) Next .Protect EndWith Application.ScreenUpdating= True End Sub 代碼解析： ImportName過程將Sheet2工作表的人員姓名導(dǎo)入到Sheet1工作表的B列單元格中。 第5、6行代碼，取得兩個工作表中現(xiàn)有數(shù)據(jù)的行號。 第12行代碼，根據(jù)兩個工作表中現(xiàn)有數(shù)據(jù)的行號決定在到Sheet1工作表需要插入的行數(shù)。 第13行第16行代碼，將Sheet2工作表的人員編號和人員姓名導(dǎo)入到Sheet1工作表的B列單元格中，因為在寫入的過程中同時會觸發(fā)工作表的Change事件，所以日工資標準無需導(dǎo)入。 如果有少量不需要計算的人員姓名可以在導(dǎo)入后刪除。 步驟7，如果在輸入時Sheet1工作表中已有數(shù)據(jù)，可以先進行清除，在模塊中寫入下面的代碼。 Sub DataClear() Dimr As Integer WithSheet1 .Select If MsgBox('是否清除加班費數(shù)據(jù)?'，32 + vbYesNo，'系統(tǒng)提示') = vbNo Then Exit Sub .Unprotect r = .Range('B63556').End(xlUp).Row If r >= 6 Then .Rows('5:' & r - 2).Delete End If r = .Range('B63556').End(xlUp).Row Union(.Cells(2，12)，.Range(.Cells(r，5)，.Cells(r，12))).ClearContents .Protect Application.GoTo Reference:=.Cells(5，4)，Scroll:=True EndWith End Sub 代碼解析： DataClear過程清除計算表中已有的數(shù)據(jù)。 步驟8，在VBE中插入一個窗體，用于計算加班費時選擇計算的月份并對Sheet2表的D、F、H和J列中輸入的加班班數(shù)計算應(yīng)發(fā)的加班費合計。 雙擊窗體寫入下面的代碼。 Private Sub UserForm_Initialize() SpinButton1.Value= Year(Date) SpinButton2.Value= Month(Date) TextBox1.Text= Year(Date) & '年' TextBox2.Text= Month(Date) & '月份' End Sub 代碼解析： 窗體的Initialize事件，在窗體初始化時文本框中顯示當(dāng)前的年月。 雙擊窗體中的SpinButton控件，寫入下面的代碼。 Private Sub SpinButton1_Change() TextBox1.Text= SpinButton1.Value & '年' End Sub Private Sub SpinButton2_Change() WithSpinButton2 Select Case .Value Case 1 To 12 TextBox2.Text = .Value &'月份' Case Is > 12 TextBox1.Text = Left(TextBox1.Text，4) + 1 & '年' .Value = 1 Case Is <> TextBox1.Text = Left(TextBox1.Text，4) - 1 & '年' .Value = 12 End Select EndWith End Sub 代碼解析： 使用SpinButton控件調(diào)節(jié)窗體中顯示的年月，請參閱▲140 。 雙擊窗體中的“確定”按鈕，寫入下面的代碼。 Private Sub CommandButton1_Click() Dimi As Integer Dimr As Integer WithSheet1 .Select r = .Range('B63556').End(xlUp).Row If .Cells(5，2) = ““ Then MsgBox '請把數(shù)據(jù)填寫完整后再計算!'，64，'系統(tǒng)提示' Unload Me Exit Sub End If For i = 5 To r - 2 If WorksheetFunction.CountIf(.Range('B5:B'& i)，.Cells(i，2)) > 1 Then If MsgBox(.Cells(i，2) & '輸入重復(fù)，是否繼續(xù)?'，36，'系統(tǒng)提示') =7 Then Unload Me Exit Sub End If End If Next .Unprotect .Cells(2，12) = TextBox2.Text For i = 5 To r - 1 .Cells(i，5) = Round(100 * .Cells(i，4)，2) .Cells(i，7) = Round(.Cells(i，3) * 1.5 *.Cells(i，6)，2) .Cells(i，9) = Round(.Cells(i，3) * 2 * .Cells(i，8)，2) .Cells(i，11) = Round(.Cells(i，3) * 3 * .Cells(i，10)，2) .Cells(i，12) = .Cells(i，5) + .Cells(i，7) + .Cells(i，9) + .Cells(i，11) Next .Cells(r，5) = WorksheetFunction.Sum(.Range('E5:E' &r - 1)) .Cells(r，7) = WorksheetFunction.Sum(.Range('G5:G' &r - 1)) .Cells(r，9) = WorksheetFunction.Sum(.Range('I5:I' &r - 1)) .Cells(r，11) = WorksheetFunction.Sum(.Range('K5:K' &r - 1)) .Cells(r，12) = WorksheetFunction.Sum(.Range('L5:L' &r - 1)) .Protect EndWith UnloadMe MsgBoxTextBox1.Text & TextBox2.Text & '的加班費已計算完畢!'，64，'系統(tǒng)提示' End Sub 代碼解析： 窗體中的“確定”按鈕的Click事件過程，計算Sheet1表中的加班費合計。 第7行到第11行代碼，檢查Sheet1表中是否已輸入人員姓名及加班班數(shù)。 第12行到第19行代碼，檢查Sheet1表中的人員編號是否重復(fù)。 第21行代碼，在Sheet1表中寫入所計算的月份。 第22行到第28行代碼，根據(jù)加班班數(shù)和相應(yīng)的系數(shù)計算加班費金額。 第29行到第33行代碼，計算合計欄的金額。 在Sheet1表中輸入人員姓名和加班天數(shù)后按窗體的“確定”按鈕后效果。 為了計算高溫加班工資，VBE中插入一個和計算加班費類似的窗體，雙擊窗體中的“確定”按鈕，寫入下面的代碼。 Private Sub CommandButton1_Click() Dimrng As Range Dimi As Integer Dimr As Integer WithSheet1 r = .Range('B63556').End(xlUp).Row .Select If .Cells(5，2) = ““ Then MsgBox '請把數(shù)據(jù)填寫完整后再計算!'，64，'系統(tǒng)提示' Unload Me Exit Sub End If For i = 5 To r - 2 If WorksheetFunction.CountIf(.Range('B5:B'& i)，.Cells(i，2)) > 1 Then If MsgBox(.Cells(i，2) & '輸入重復(fù)，是否繼續(xù)?'，36，'系統(tǒng)提示') =7 Then Unload Me Exit Sub End If End If Next Application.ScreenUpdating = False .Unprotect .Cells(2，12) = TextBox2.Text With Sheet2.Range('A:A') For i = 5 To r - 1 Set rng = .Find(What:=Cells(i，1).Value，_ After:=.Cells(.Cells.Count)，_ LookIn:=xlFormulas，_ LookAt:=xlWhole，_ SearchOrder:=xlByRows，_ SearchDirection:=xlNext，_ MatchCase:=False) If Not rng Is Nothing Then Sheet1.Cells(i，12) = Round(((Val(rng.Offset(0，2)) + Val(rng.Offset(0，3))) / 2)，2) End If Next End With .Cells(r，12) = WorksheetFunction.Sum(.Range('L5:L'& r - 1)) .Protect EndWith Application.ScreenUpdating= True UnloadMe MsgBoxTextBox1.Text & TextBox2.Text & '的高溫工資計算完畢!'，64，'系統(tǒng)提示' End Sub 代碼解析： 窗體中的“確定”按鈕的Click事件過程，計算Sheet1表中的高溫工資。 第8行到第12行代碼，檢查Sheet1表中是否已輸入人員姓名。 第13行到第20行代碼，檢查Sheet1表中的人員編號是否重復(fù)。 第23行代碼，在Sheet1表中寫入所計算的月份。 第24行到第37行代碼，根據(jù)Sheet1表中的人員編號在Sheet2表中查找對應(yīng)的“技能工資”和“崗位工資”并將其合計數(shù)的二分之一寫入到Sheet1表中。(筆者所在單位每年發(fā)一次高溫加班工資，為職工“技能工資”和“崗位工資”之和，分兩個月發(fā)放) 第38行代碼，計算合計欄的金額。 在Sheet1表中輸入人員姓名和加班天數(shù)后按窗體的“確定”按鈕后效果。 步驟8，加班費計算完畢后，需要進行匯總，以便統(tǒng)計全年的加班費總額。將Sheet3工作表重命名為“加班費匯總”并設(shè)置成格式，在A列和B列中分別寫入人員編號和姓名。 在模塊中寫入下面的代碼。 Sub DataSummary() DimMyMonth As String Dimc As Integer Dimrng As Range Dimr As Integer Dimi As Integer MyMonth= Sheet1.Cells(2，12).Value If MsgBox('是否匯總加班費數(shù)據(jù)?'，36，'系統(tǒng)提示') = 7 Then Exit Sub EndIf If Sheet1.Cells(5，12) = ““ Then MsgBox '沒有可匯總的數(shù)據(jù)，請先計算加班費!'，64，'系統(tǒng)提示' Exit Sub EndIf WithSheet3 r = .Range('A63556').End(xlUp).Row For i = 3 To 14 If .Cells(1，i).Value = MyMonth Then c = i Exit For End If Next If .Cells(r，c).Value > 0 Then If MsgBox(MyMonth & '加班費已經(jīng)匯總，是否繼續(xù)?'，36，'系統(tǒng)提示') = 7 Then Exit Sub End If End If .Unprotect Application.ScreenUpdating = False With .Range('A:A') For i = 5 To Sheet1.Range('A63556').End(xlUp).Row Set rng = .Find(What:=Sheet1.Cells(i，1).Text，_ After:=.Cells(.Cells.Count)，_ LookIn:=xlFormulas，_ LookAt:=xlWhole，_ SearchOrder:=xlByRows，_ SearchDirection:=xlNext，_ MatchCase:=False) If Not rng Is Nothing Then rng.Offset(，c - 1) = Val(rng.Offset(，c - 1)) + Val(Sheet1.Cells(i，12)) End If Next End With .Cells(r，c).ClearContents For i = 2 To r - 1 .Cells(r，c) = Val(.Cells(r，c)) + Val(.Cells(i，c)) Next For i = 2 To r .Cells(i，15) = WorksheetFunction.Sum(.Range('C' & i& ':N' & i)) Next Application.GoTo Reference:=.Cells(1，c)，Scroll:=True .Protect EndWith Application.ScreenUpdating= True MsgBoxMyMonth & '的加班費匯總完畢!'，64，'系統(tǒng)提示' End Sub 代碼解析： DataSummary過程將“加班費計算”表中計算好的加班費合計匯總到“加班費匯總”表中。 第8行代碼獲得需要匯總的月份。 第17行到第22行代碼，獲得需要匯總的月份在“加班費匯總”表中的列號。 第23行代碼到第27行代碼，如果“加班費匯總”表中相應(yīng)的列中已有合計金額，詢問是否繼續(xù)匯總，防止重復(fù)匯總。 第30行到第43行代碼，使用Find方法將加班費金額進行匯總。關(guān)于Find方法請參閱▲5-1。 第44行到第50行代碼在匯總表中重新計算每行每列的合計數(shù)。 第51行代碼使用GoTo方法選擇匯總表中相應(yīng)的單元格。關(guān)于GoTo方法請參閱▲2-3。 步驟9，加班費計算、匯總完畢后需要進行打印，首先在工作表窗口中單擊菜單“文件”→“頁面設(shè)置”，在“工作表”選項卡中將“頂端標題行”設(shè)置為“$1:$4”，然后在VBE中插入一個窗體。 雙擊窗體中的“打印”按鈕，寫入下面的代碼。 Private Sub CommandButton1_Click() Dimr As Byte Dimi As Integer Dimi1 As Integer Dimi2 As Integer Application.ScreenUpdating= False ActiveWindow.View= xlPageBreakPreview WithSheet1 r = .Range('B65536').End(xlUp).Row .ResetAllPageBreaks If .HPageBreaks.Count = 0 Then .Unprotect .Cells(100，2) = '123' i1 = .HPageBreaks(1).Location.Row .Cells(100，2) = ““ .Unprotect For i = r To i1 - 2 .Rows(r).Insert Next .Protect Else .HPageBreaks.Add Before:=.Range('B65536').End(xlUp).Offset(1，0) i1 = .HPageBreaks(1).Location.Row -5 i2 = .HPageBreaks(.HPageBreaks.Count).Location.Row- .HPageBreaks(.HPageBreaks.Count - 1).Location.Row .Unprotect For i = 1 To i1 - i2 .HPageBreaks(.HPageBreaks.Count).Location.Offset(-1，0).EntireRow.Insert Next .Protect End If EndWith ActiveWindow.View= xlNormalView Application.ScreenUpdating= True UnloadMe Sheet1.PrintOutCopies:=ComboBox1.Value End Sub 代碼解析： 打印窗體中“打印”按鈕的Click事件過程，打印“加班費計算表”。 第7行代碼，將窗口中的視圖設(shè)置為分頁預(yù)覽。應(yīng)用于Window對象的View屬性返回或設(shè)置在窗口中顯示的視圖，設(shè)置成xlPageBreakPreview為分頁預(yù)覽，xlNormalView則為普通視圖。 第11行代碼，判斷Sheet1表是否滿頁。HPageBreaks屬性返回 HPageBreaks集合，代表工作表上的水平分頁符，如果工作表中沒有水平分頁符說明沒有滿頁。 第13行到第15行代碼，在B列單元格中寫入字符取得Sheet1表中第一個分頁符的位置后再刪除。 第17行到第19行代碼，在Sheet1表中的B列合計欄中插入一定數(shù)量的空行使其滿頁。 第22行代碼，如果Sheet1表的打印內(nèi)容不止一頁，在最后一行插入一個分頁符。 第23行代碼，取得Sheet1表中滿頁的行數(shù)。 第24行代碼，取得Sheet1表最后一頁中的行數(shù)，兩者相減即能得到最后一頁中需插入的行數(shù)。 第26行到第28行代碼，在Sheet1表中的B列合計欄中插入一定數(shù)量的空行使其滿頁。 第32行代碼，將窗口中的視圖設(shè)置為普通視圖。 當(dāng)使用“打印”窗體打印Sheet1表時，將自動插入一定數(shù)量的空行使其滿頁打印。 步驟10，為了使用方便，需要在菜單欄中添加自定義菜單來使用各項功能，在模塊中寫入下面的代碼。 Sub AddNewMenu() DimHelpMenu As CommandBarControl DimNewMenu As CommandBarPopup WithApplication.CommandBars('Worksheet menu bar') .Reset Set HelpMenu = .FindControl(ID:=.Controls('幫助(&H)').ID) If HelpMenu Is Nothing Then Set NewMenu = .Controls.Add(Type:=msoControlPopup) Else Set NewMenu = .Controls.Add(Type:=msoControlPopup，Before:=HelpMenu.Index) End If With NewMenu .Caption = '加班費(&S)' With .Controls.Add(Type:=msoControlButton) .Caption = '導(dǎo)入數(shù)據(jù)' .OnAction = 'ImportWages' End With With .Controls.Add(Type:=msoControlButton) .Caption = '清除加班費' .OnAction = 'DataClear' End With With .Controls.Add(Type:=msoControlButton) .Caption = '批量導(dǎo)入人員' .OnAction = 'ImportName' End With With .Controls.Add(Type:=msoControlButton) .Caption = '計算加班費' .OnAction = 'DataCalculation' End With With .Controls.Add(Type:=msoControlButton) .Caption = '計算高溫工資' .OnAction = 'TemperatureCalculation' End With With .Controls.Add(Type:=msoControlButton) .Caption = '加班費匯總' .OnAction = 'DataSummary' End With With .Controls.Add(Type:=msoControlButton) .Caption = '打印加班費' .OnAction = 'HPageBreak' End With End With EndWith SetHelpMenu = Nothing SetNewMenu = Nothing End Sub Sub DelNewMenu() Application.CommandBars('Worksheetmenu bar').Reset End Sub 代碼解析： AddNewMenu過程在“幫助”菜單前添加一個自定義的“加班費”菜單。 DelNewMenu過程刪除自定義的“加班費”菜單。 為了工作簿打開時自動添加“加班費”菜單和關(guān)閉時自動刪除“加班費”菜單，需要在VBE中雙擊ThisWorkbook寫入下面的代碼。 Private Sub Workbook_Activate() CallAddNewMenu End Sub Private Sub Workbook_Deactivate() CallDelNewMenu End Sub 保存關(guān)閉工作簿，重新打開，將在菜單欄中添加自定義的“加班費”菜單，可以方便的使用加班費計算表中的各項功能。 |
|
|
