大话人生

  IT博客 :: 首页 :: 新随笔 :: 联系 :: 聚合  :: 管理 ::
  299 随笔 :: 0 文章 :: 73 评论 :: 0 Trackbacks

今天帮一朋友做了个excel的工资表转工资条的宏编程程序

前提:
需要录入50个人的工资条,且每个工资条必须具备25列数据,如图1

目的:
需要把如图1的工资表里的数据转做成图2的工资条的模板

(图1)


(图2)


步骤:
1.把图1表的数据导入一个新的excel表中,为了不破坏原表:)
2.在新的excel表中点击‘开发工具’->‘查看代码’
3.放入代码入当前excel的sheet表中
4.点击‘开发工具’->‘宏’->‘执行’
5.生成工资条成功


VBA代码如下:

Sub 生成工资条()

Cells.Select

'选择整个表去掉表格线

Range("F1").Activate

'Selection.Borders(xlDiagonalDown).Line

Style = 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

Rows("2:2").Select

'选择第2行

Selection.Insert Shift:=xlDown

'在第2行前插入一行,保持第2行

'为选中状态

num = 150

'总人数×3,如工资表中有50人则

为50×3即num = 150

col = 25

'工资表的栏数,如工资表有25栏则

'col=25

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

posted on 2008-11-19 14:25 大话人生 阅读(1794) 评论(0)  编辑 收藏 引用 所属分类: 开发
只有注册用户登录后才能发表评论。