如下是“生成工资条格式”、“打印预览”、“清空内容”的三个功能实现:
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