工资条代码...

Excel VBA实现工资条打印效果..网上找的一些不好用,让朋友给写的...好简化一下我们人事的工作,记录一下,随用随取... VBA的强悍,不用我多说做这方面的工作流的开发应用等,前途还是"靓靓的",....
ExpandedBlockStart.gif ContractedBlock.gif Private   Sub CopyHead_Click() Sub CopyHead_Click()
InBlock.gif    
InBlock.gif    endRows_Num 
= InputBox("请输入工资条结束行:" + Chr(13+ Chr(13+ "输入数字就可以了""输入")
InBlock.gif   
InBlock.gif    
If endRows_Num = "" Then
InBlock.gif        
End
InBlock.gif    
End If
InBlock.gif    
InBlock.gif    nrow 
= 3
InBlock.gif    
For x = 1 To endRows_Num - nrow
InBlock.gif          
InBlock.gif     
InBlock.gif        Rows(
"2:2").Select   '选择标头行
InBlock.gif
        Selection.Copy       '复制
InBlock.gif
        
InBlock.gif        nrow 
= nrow + 1
InBlock.gif        Rows(
Trim(Str(nrow)) + ":" + Trim(Str(nrow))).Select    '选择插入目标行
InBlock.gif
        
InBlock.gif        
If Trim(Cells(nrow, 1)) = "工号" Or Trim(Cells(nrow, 1)) = "" Then   '检查目标行内容的正确性!
InBlock.gif
            MsgBox ("程序发现目标行的内容不符,请检查后再运行些程序!")
InBlock.gif            
End
InBlock.gif        
End If
InBlock.gif        
InBlock.gif        
InBlock.gif        Selection.Insert Shift:
=xlDown                          '插入复制行
InBlock.gif
        Application.CutCopyMode = False
InBlock.gif        
InBlock.gif        Rows(
Trim(Str(nrow)) + ":" + Trim(Str(nrow))).Select
InBlock.gif        Selection.Insert Shift:
=xlDown                        '插入一行空白行
InBlock.gif
        Selection.RowHeight = 5                                '空白行的行高
InBlock.gif
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone     '把空白行的线条去掉
InBlock.gif
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
InBlock.gif        Selection.Borders(xlEdgeLeft).LineStyle 
= xlNone
InBlock.gif        Selection.Borders(xlEdgeRight).LineStyle 
= xlNone
InBlock.gif        Selection.Borders(xlInsideVertical).LineStyle 
= xlNone
InBlock.gif        nrow 
= nrow + 2
InBlock.gif    
Next
InBlock.gif   
InBlock.gif    
ExpandedBlockEnd.gif
End Sub

工资条代码..._第1张图片
工资条代码..._第2张图片

你可能感兴趣的:(工资条代码...)