VBA自动调整打印缩放比例

greener2008 · 发表于 2013-1-30 23:30

本帖最后由 greener2008 于 2013-1-30 23:41 编辑

多页，设置了手工分页符，每页行数不等，都要占用一页多，不到两页。
请问，如何自动设置打印缩放比例，以保证所有的数据都按照手工分页符打印在一页上？

greener2008 · 发表于 2013-1-31 15:17

本帖最后由 greener2008 于 2013-2-2 13:51 编辑

发现这样可以实现，请行家指点。

Sub SetPageZoom()
Dim Mn%, An%, Zn%
'统计手动分页符的个数
For i = 2 To [a65536].End(3).Row
If Sheet1.Rows(i).PageBreak = xlPageBreakManual Then
Mn = Mn + 1
End If
Next
For Zn = 90 To 70 Step -2
With Sheet1.PageSetup
.Zoom = Zn
End With
ActiveWorkbook.Save
An = Sheet1.HPageBreaks.Count
If An = Mn Then Exit For
Next
MsgBox "完成，缩放比例设置为" & Zn & "%"
End Sub

以上存在两个问题：
1、统计手动分页符的个数，执行时间太长。
2、Sheet1.HPageBreaks.Count 的值，不随着循环更新，始终是第一次执行时的取值。后发现存盘后 Sheet1.HPageBreaks.Count 的值可以更新，不得已，加了ActiveWorkbook.Save 来应急解决。

greener2008 · 发表于 2013-2-2 14:00

经求助、搜索，目前的结果是这样的：
Sub SetPageZoom()
Dim Mn%, Zn%
'由doitbest提供的优化代码===================================
Dim x As HPageBreak, n
For Each x In ActiveSheet.HPageBreaks
If x.Type = xlPageBreakManual Then Mn = Mn + 1
Next
'====================================================
For Zn = 100 To 60 Step -2
Sheet1.PageSetup.Zoom = Zn
Pages = ExecuteExcel4Macro("Get.Document(50)") '统计总页数
If Pages - 1 = Mn Then Exit For
Next
MsgBox "完成，缩放比例设置为" & Zn & "%"
End Sub

VBA调整打印缩放比例-完成.rar (9.4 KB, 下载次数: 190)

qw52633 · 发表于 2019-12-9 17:05

greener2008 发表于 2013-2-2 14:00
经求助、搜索，目前的结果是这样的：
Sub SetPageZoom()
Dim Mn%, Zn%

用到了感谢分享

qw52633 · 发表于 2019-12-10 08:31

greener2008 发表于 2013-2-2 14:00
经求助、搜索，目前的结果是这样的：
Sub SetPageZoom()
Dim Mn%, Zn%

总页数还是不随着更新而改变啊如何更改的啊？

dengcaimao · 发表于 2020-10-3 21:45

不错，也在学习这个

blackttea1 · 发表于 2020-11-25 08:52

学习啦，谢谢

volcano119 · 发表于 2024-11-12 14:24

我发现也是打印页数不随着缩放而更改，请问如何解决

		自动登录	找回密码
密码			免费注册

[求助] VBA自动调整打印缩放比例