[原创] 我有自动生成工资条的（宏）

xinpingdai2006

xinpingdai@yahoo.com.cn

zsxjjh

jjhzsx@126.com

千珏

hellojoyce_zj@hotmail.com Thank you...

huan1028

huan1028@126.com

竹林飞雪梦

能否给我来一份，mengyq2003@sina.com谢谢！

pico

请给我也发一个，谢谢！picojun@vip.sina.com

了度

现在我已把宏粘贴在这里了，需要的请自己复制吧 Sub 生成工资条() Cells.Select '选择整个表去掉表格线 Range("F1").Activate 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 Rows("2:2").Select '选择第2行 Selection.Insert Shift:=xlDown '在第2行前插入一行，保持第2行为选中状态 num = 900 '总人数×3，如工资表中有100人则为100×3即num=300 col = 48 '工资表的栏数，如工资表有17栏则 'col=17 num1 = 4 Do While num1 <= num '循环插入空行 Range(Cells(num1, 1), Cells(num1, col)).Select '选中第num1行的第1列到第col列 Selection.Insert Shift:=xlDown Selection.Insert Shift:=xlDown num1 = num1 + 3 Loop Range(Cells(1, 1), Cells(1, col)).Select Application.CutCopyMode = False '剪切复制模式无效 Selection.Copy '复制选择区域 Range("A2").Select '选择A2单元格 ActiveSheet.Paste '从A2单元格起粘贴内容 num2 = 5 Do While num2 <= num '循环插入标题行 Range(Cells(1, 1), Cells(1, col)).Select Application.CutCopyMode = False Selection.Copy Cells(num2, 1).Select ActiveSheet.Paste num2 = num2 + 3 Loop Range(Cells(2, 1), Cells(3, col)).Select Application.CutCopyMode = False Selection.Borders(xlDiagonalDown).LineStyle = xlNone '定义表格边框线、内线样式 Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDash .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlDash .Weight = xlThin .ColorIndex = xlAutomatic End With Selection.Copy Range(Cells(5, 1), Cells(6, col)).Select Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '接上行删除上行尾的连字符_，复制表格线样式 num3 = 8 Do While num3 <= num '循环复制表格线样式 Range(Cells(num3, 1), Cells(num3 + 1, col)).Select Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False num3 = num3 + 3 Loop Rows("1:1").Select '删除多余的一行 Selection.Delete End Sub

加勒比海盗

rice_liu119@hotmail.com 谢谢

zhaoze

zhaozhe@163.com 谢谢！！！！！

tsiph

tsiph@163.com 谢谢了！