|
现在点击时运行是把换页符插到“发货清单”后面,改了好久也不能把换页符插到“发货清单”行前面?以方便换页打印,大家有没有办法实现
Sub 插入分页符()
Dim msg As String, i&, j&, d As Object, arr, dicitem
msg = InputBox("请输入关键字", "温馨提示", "发货清单")
If msg = "" Then Exit Sub
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Call 重置分页符
arr = ActiveSheet.UsedRange
For i = 1 To UBound(arr)
For j = 1 To 6
If InStr(arr(i, j), msg) Then d(i + 1) = ""
Next j
Next i
arr(1, 1) = IIf(1026 > d.Count, d.Count, 1026) '一个工作表最多1026个分页符!!!
dicitem = d.keys
For i = 0 To arr(1, 1) - 1
ActiveSheet.HPageBreaks.Add Before:=Range("A" & dicitem(i))
Next
Application.ScreenUpdating = True
Set d = Nothing
MsgBox "已成功插入" & arr(1, 1) & "个分页符"
End Sub
Sub 重置分页符()
yy = ActiveSheet.PageSetup.Zoom
ActiveSheet.ResetAllPageBreaks
ActiveSheet.PageSetup.Zoom = yy
End Sub
你的代码搞得太复杂了,简化了一下。 - Sub 插入分页符()
- Dim msg As String, i&, n&
- msg = InputBox("请输入关键字", "温馨提示", "发货清单")
- If msg = "" Then Exit Sub
- Set d = CreateObject("Scripting.Dictionary")
- ActiveSheet.ResetAllPageBreaks
- For i = 2 To [a65536].End(3).Row
- If InStr(Cells(i, 1), msg) Then ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1): n = n + 1
- Next
- MsgBox "已成功插入" & n & "个分页符"
- End Sub
复制代码
|
|