如下是“生成工资条格式”、“打印预览”、“清空内容”的三个功能实现:
Sub CtoPrt() '生成工资条格式 Dim mycount As Integer Dim prows As Integer Dim srows As Integer mycount = 0 prows = Sheets("打印").Cells(Rows.Count, 1).End(xlUp).Row srows = Sheets("源数据").Cells(Rows.Count, 1).End(xlUp).Row '清空打印表数据 If prows > 1 Then Application.EnableEvents = False Range(Rows(2), Rows(prows)).ClearContents Application.EnableEvents = True End If '清空打印表格式 Sheets("打印").Cells.Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone With Selection.Interior .ColorIndex = 0 .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With Application.ScreenUpdating = False '第一人的工资条直接复制 Sheets("源数据").Select Rows("1:2").Select Selection.Copy Sheets("打印").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycount = 1 '从第二人开始 For i = 3 To srows prows = Sheets("打印").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("打印").Select Rows(2).Select Selection.Copy Rows(prows).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("源数据").Select Rows(i).Select Selection.Copy Sheets("打印").Select Rows(prows + 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False mycount = mycount + 1 Next i Application.ScreenUpdating = False Dim rnum As Integer Dim cnum As Integer rnum = Sheets("打印").Cells(Rows.Count, 1).End(xlUp).Row cnum = Sheets("打印").Cells(2, Columns.Count).End(xlToLeft).Column If rnum > 2 And cnum > 1 Then Application.EnableEvents = False Range(Cells(2, 1), Cells(rnum, cnum)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Application.EnableEvents = True End If MsgBox "源数据共计" & srows - 1 & "人工资记录,已成功处理" & mycount & "人的工资条格式。", vbOKOnly + 64, "提示" End Sub Sub prtpre() '打印预览 Dim rnum As Integer Dim cnum As Integer rnum = Sheets("打印").Cells(Rows.Count, 1).End(xlUp).Row cnum = Sheets("打印").Cells(2, Columns.Count).End(xlToLeft).Column If rnum > 2 And cnum > 1 Then Application.EnableEvents = False Sheets("打印").Range(Cells(2, 1), Cells(rnum, cnum)).PrintPreview Application.EnableEvents = True Else MsgBox "该表格没有可用记录,不能预览。", vbOKOnly + 64, "提示" End If End Sub Sub clcontents() '清空内容 Sheets("打印").Cells.ClearContents Sheets("打印").Cells.Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone With Selection.Interior .ColorIndex = 0 .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With End Sub