[求助]如何制作 工资条 [求助]

笨小狼

<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 &lt;= 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 &lt;= 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 &lt;= 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>

瑾果

<P> 27qqHqaS.rar (26.45 KB, 下载次数: 111)

2004-9-27 17:12 上传

点击文件名下载附件
[求助]如何制作 工资条 [求助]

这是我以前下载luyigang会员制作的。</P>
<P>共同学习一下。。</P>

兰色幻想

<P>我用公式做的工资条</P>
BLWlpMhq.rar (16.37 KB, 下载次数: 128)

2004-9-25 17:13 上传

点击文件名下载附件
[求助]如何制作 工资条 [求助]

兰色幻想

<P>这么复杂，有点晕，用公式或排序的方法更方便些</P>