Sub make_wage()
Debug.Print ("=====================================================")
' 先把整个工资表个copy过来
Cells.Select
Selection.Copy
Sheets("工资条").Select
Cells.Select
ActiveSheet.Paste
' 不管发生什么错误都继续执行
On Error Resume Next
'XRan 酱油的 把总共多少行计算出来
'YRan 表头
'ZRan 间隔行
Dim XRan As Range, YRan As Range, ZRan As Range, RowNum As Integer, i As Integer
Dim Down, N '标题行数
Down = MsgBox("工资表表头是否设计好?" & vbCrLf & " " & vbCrLf & "★表头将直接套用到工资条中★", vbQuestion + vbYesNo, "功能提示")
If Down = vbNo Then
Sheets("工资表").Select
Range("A1:C1").Select
Exit Sub
End If
Down = MsgBox("是否制作工资条?", vbQuestion + vbYesNo, "功能提示")
If Down = vbNo Then
Sheets("工资表").Select
Range("A1:C1").Select
Exit Sub
End If
'指定标题的列数
' Do loop 是如果不满足 就一直给循环下去 满足后运行loop
Do
N = InputBox("请指定表头行数!" & vbCrLf & " " & vbCrLf & "“确定”后依数据量耐心等候…………", "提示", 1)
If IsNumeric(N) Then
Exit Do
Else
Down = MsgBox("给定为非整数!!" & vbCrLf & "是否重新指定?", vbExclamation + vbYesNo, "错误")
If Down = vbNo Then
Sheets("工资表").Select
Range("A1:C1").Select
Exit Sub
End If
End If
Loop
N = CInt(N)
'先按标题数N插入N+1行空行
Set XRan = Cells(N + 1, 2) 'B列要确保为非空列
Do
'这一句不懂 但是 这一段代码就是没一行之间都插入 N+1个空格
XRan.Offset(1, 0).Rows("1:" & N + 1).EntireRow.Insert Shift:=xlDown
Set XRan = XRan.End(xlDown)
RowNum = ActiveSheet.UsedRange.Rows.Count
Debug.Print ("XRan.Row ==" & XRan.Row)
Debug.Print ("RowNum == " & RowNum)
Loop While XRan.Row < RowNum
'再复制标题列
RowNum = ActiveSheet.UsedRange.Rows.Count
Rows("1:" & N).Select
Selection.Copy
Set YRan = Rows(N + 3 & ":" & 2 * N + 2)
' i = 那个数 然后 最大数 为 RowNum 每一次的跨度是 N+2
For i = 2 * (N + 2) + 1 To RowNum Step N + 2
Set YRan = Union(YRan, Rows(i & ":" & i + N - 1))
Next
YRan.Select
Debug.Print ("RowNum2222 == " & RowNum)
ActiveSheet.Paste
'最后设定好数据间的距离
Set ZRan = Rows(N + 2)
For i = 2 * (N + 2) To RowNum Step N + 2
Set ZRan = Union(ZRan, Rows(i))
Next
ZRan.Select
Selection.Borders.LineStyle = xlNone
' Do nothing
Down = MsgBox("是否指定工资条间距?" & vbCrLf & " " & vbCrLf & "★打印前应预览有无跨页★", vbQuestion + vbYesNo, "间距")
If Down = vbYes Then
Do
N = InputBox("请指定工资条间距!" & vbCrLf & " " & vbCrLf & "可通过调整间距或页边距使工资条不跨页", "提示", 20)
If IsNumeric(N) Then
If N >= 0 And N <= 409 Then
Exit Do
End If
End If
Down = MsgBox("行高必须在0至409之间!" & vbCrLf & "是否重新指定?", vbExclamation + vbYesNo, "错误")
If Down = vbNo Then
Exit Sub
End If
Loop
Selection.RowHeight = N
End If
End Sub
VB 里面的东西。。。。 只是标记下来 以后用
最新推荐文章于 2023-07-05 18:24:10 发布