|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
<P>我使用VBA制作工资条。 请看看怎么我的这个程序应该如何修改。 始终无法正常生成工资条。感谢。 工资表 图片如下</P>
<P> <img src="attachments/dvbbs/2004-9/2004925164621562.jpg" border="0" onclick="zoom(this)" onload="if(this.width>document.body.clientWidth*0.5) {this.resized=true;this.width=document.body.clientWidth*0.5;this.style.cursor='pointer';} else {this.onclick=null}" alt="" /></P>
<P>————————————————————————————————————</P>
<P> Sub 生成工资条()</P>
<P> Cells.Select</P>
<P> '选择整个表去掉表格线</P>
<P> Range("F1").Activate</P>
<P> Selection.Borders(xlDiagonalDown).LineStyle = xlNone</P>
<P> Selection.Borders(xlDiagonalUp).LineStyle = xlNone</P>
<P> Selection.Borders(xlEdgeLeft).LineStyle = xlNone</P>
<P> Selection.Borders(xlEdgeTop).LineStyle = xlNone</P>
<P> Selection.Borders(xlEdgeBottom).LineStyle = xlNone</P>
<P> Selection.Borders(xlEdgeRight).LineStyle = xlNone</P>
<P> Selection.Borders(xlInsideVertical).LineStyle = xlNone</P>
<P> Selection.Borders(xlInsideHorizontal).LineStyle = xlNone</P>
<P> Rows("4:6").Select</P>
<P> '选择第2行</P>
<P> Selection.Insert Shift:=xlDown</P>
<P> '在第2行前插入一行，保持第2行</P>
<P>
num = 150</P>
<P> '总人数×3，如工资表中有100人则</P>
<P> 为100×3即num = 300</P>
<P> col = 16</P>
<P> '工资表的栏数，如工资表有17栏则</P>
<P> 'col=17</P>
<P> num1 = 4</P>
<P> Do While num1 <= num</P>
<P> '循环插入空行</P>
<P> Range(Cells(num1, 1), Cells(num1, col)).Select</P>
<P> '选中第num1行的第1列到第col列</P>
<P> Selection.Insert Shift:=xlDown</P>
<P> Selection.Insert Shift:=xlDown</P>
<P> num1 = num1 + 3</P>
<P> Loop</P>
<P> Range(Cells(1, 1), Cells(1, col)).Select</P>
<P> Application.CutCopyMode = False</P>
<P> '剪切复制模式无效</P>
<P> Selection.Copy</P>
<P> '复制选择区域</P>
<P> Range("A2").Select</P>
<P> '选择A2单元格</P>
<P> ActiveSheet.Paste</P>
<P> '从A2单元格起粘贴内容</P>
<P> num2 = 5</P>
<P> Do While num2 <= num</P>
<P> '循环插入标题行</P>
<P> Range(Cells(1, 1), Cells(1, col)).Select</P>
<P> Application.CutCopyMode = False</P>
<P> Selection.Copy</P>
<P> Cells(num2, 1).Select</P>
<P> ActiveSheet.Paste</P>
<P> num2 = num2 + 3</P>
<P> Loop</P>
<P> Range(Cells(2, 1), Cells(3, col)).Select</P>
<P> Application.CutCopyMode = False</P>
<P> Selection.Borders(xlDiagonalDown).LineStyle = xlNone</P>
<P> '定义表格边框线、内线样式</P>
<P> Selection.Borders(xlDiagonalUp).LineStyle = xlNone</P>
<P> With Selection.Borders(xlEdgeLeft)</P>
<P> .LineStyle = xlDouble</P>
<P> .Weight = xlThick</P>
<P> .ColorIndex = xlAutomatic</P>
<P> End With</P>
<P> With Selection.Borders(xlEdgeTop)</P>
<P> .LineStyle = xlDouble</P>
<P> .Weight = xlThick</P>
<P> .ColorIndex = xlAutomatic</P>
<P> End With</P>
<P> With Selection.Borders(xlEdgeBottom)</P>
<P> .LineStyle = xlDouble</P>
<P> .Weight = xlThick</P>
<P> .ColorIndex = xlAutomatic</P>
<P> End With</P>
<P> With Selection.Borders(xlEdgeRight)</P>
<P> .LineStyle = xlDouble</P>
<P> .Weight = xlThick</P>
<P> .ColorIndex = xlAutomatic</P>
<P> End With</P>
<P> With Selection.Borders(xlInsideVertical)</P>
<P> .LineStyle = xlDash</P>
<P> .Weight = xlThin</P>
<P> .ColorIndex = xlAutomatic</P>
<P> End With</P>
<P> With Selection.Borders(xlInsideHorizontal)</P>
<P> .LineStyle = xlDash</P>
<P> .Weight = xlThin</P>
<P> .ColorIndex = xlAutomatic</P>
<P> End With</P>
<P> Selection.Copy</P>
<P> Range(Cells(5, 1), Cells(6, col)).Select</P>
<P> Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False</P>
<P> '接上行删除上行尾的连字符</P>
<P> </P>
<P> num3 = 8</P>
<P> Do While num3 <= num</P>
<P> '循环复制表格线样式</P>
<P> Range(Cells(num3, 1), Cells(num3 + 1, col)).Select</P>
<P> Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False</P>
<P> num3 = num3 + 3</P>
<P> Loop</P>
<P> Rows("1:1").Select</P>
<P> '删除多余的一行</P>
<P> Selection.Delete</P>
<P> End Sub</P>
<P>
</P> |
-
[求助]如何制作 工资条 [求助]
![[求助]如何制作 工资条 [求助]](https://files-c.excelhome.net/forum/dvbbs/2004-9/2004925164621562.jpg "[求助]如何制作 工资条 [求助]")
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2004-9-25 16:47
