在excel中，用vba渐次增加每行的行距逼近上下页边距,让每页都布满A4纸

aa868682008

每天面对需要处理的大量表格，几乎从来没有按时下班过，很是崩溃。下面的表格列宽已经调整好，表格在打印预览的时候也已经自动分好了页。现在的问题是每页的第一个框线与上边距都会自动对齐，但每页的最后一个框线与下边距就比较乱了，这就造成打印的结果不甚美观。希望在照顾各行在最合适的行高下，适当增加当页中的各行行高，以使每页的第一个框线与最后一个框线和上下边距恰好对齐，就是所谓的每页都布满A4纸。也不知道我的表达清楚不清楚。上图。实际是这样的：
需要的是这样的：

又重新编辑了一下，因为表格涉及其他敏感信息，所以不能上传，请谅。希望能得到VBA或者python方面的大神帮助，在此先行感谢。另，从图片可以看到下面的大片空白确实不太美观。当页面只有一行的时候也可以把这个页面忽略过去进行手动处理，例如图三，这个行文字超过了一行的最高上限。

aa868682008

图没有上传上来，也不知道是哪点出了问题。

xlj310

我是有一个思路可供参考。 就是把行高按大于1的倍数加大，直到页数增加一页，然后，再把行高×一个小于1的数，就可以使内容刚好就是一页。
代码仅供参考，页数你先预览一下，再自定义。可能页数少的情况下，作用会大一些，你如果有几百上千页的话，自己酌情考虑。

1. Sub 设置多少页()
   
2.     打印设置N页 ActiveWorkbook.ActiveSheet, 1, 1
   
3. End Sub
   
4. Private Sub 打印设置N页(Optional 工作表, Optional 行页数 = 1, Optional 列页数 = 1)
   
5.     If 工作表 Is Nothing Then Set 工作表 = ActiveWorkbook.ActiveSheet '赋值默认为 激活工作簿中的活动工作表
   
6.     工作表.Activate '激活此工作表，此步必须，因为底下设置打印与活动工作表相关的。
   
7.     If 设置打印机("黑白") Then
   
8.         Application.PrintCommunication = False '断开打印机连接,这样设置快些
   
9.         With 工作表.PageSetup
   
10.             .PrintArea = "" '取消打印区域
    
11.             .CenterHorizontally = True '水平居中
    
12.             .CenterVertically = False '垂直居中
    
13.             .LeftMargin = 0 '左边距
    
14.             .RightMargin = 0 '右边距
    
15.             .TopMargin = 0 '顶边距
    
16.             .BottomMargin = 0 '底边距
    
17.             .HeaderMargin = 0 '页眉边距
    
18.             .FooterMargin = 0 '页脚边距
    
19.             .PaperSize = xlPaperA4  'A4纸
    
20.             .PrintTitleRows = "$1:$1"
    
21.             '.Orientation = xlPortrait '纵向  '横向：xlLandscape 纵向：xlPortrait
    
22.             .Zoom = 100 '缩放100%
    
23.             .Parent.UsedRange.EntireRow.AutoFit '最合适的行高
    
24.             .Parent.UsedRange.EntireColumn.AutoFit '最合适的列宽
    
25.             '.FitToPagesTall = 1 '所有行打印在一页,为0不管
    
26.             '.FitToPagesWide = 1 '所有列打印在一页
    
27.             Do Until 工作表.HPageBreaks.Count > 行页数 - 1
    
28.                 调整行高 工作表, 1.05
    
29.             Loop
    
30.             Do Until 工作表.VPageBreaks.Count > 列页数 - 1
    
31.                 调整列宽 工作表, 1.05
    
32.             Loop
    
33.             Do Until 工作表.HPageBreaks.Count < 行页数
    
34.                 调整行高 工作表, 0.99
    
35.             Loop
    
36.             Do Until 工作表.VPageBreaks.Count < 列页数
    
37.                 调整列宽 工作表, 0.95
    
38.             Loop
    
39.         End With
    
40.         Application.PrintCommunication = True '重连打印机
    
41.     End If
    
42. End Sub
    
43. Private Sub 调整列宽(工作表, 倍数)
    
44.     With 工作表
    
45.         列数 = .UsedRange.Columns.Count
    
46.         If 列数 = .Columns.Count Then 列数 = .[a1].CurrentRegion.Columns.Count
    
47.         For 列 = 1 To 列数
    
48.             .Cells(1, 列).ColumnWidth = .Cells(1, 列).ColumnWidth * 倍数
    
49.         Next
    
50.     End With
    
51. End Sub
    
52. Private Sub 调整行高(工作表, 倍数)
    
53.     With 工作表
    
54.         行数 = .UsedRange.Rows.Count
    
55.         For 行 = 1 To 行数
    
56.             .Cells(行, 1).RowHeight = .Cells(行, 1).RowHeight * 倍数
    
57.         Next
    
58.     End With
    
59. End Sub
    
60. Function 设置打印机(Optional 打印机名称 = "黑白") '成功返回true,失败返回false,打印机名称是前后*号匹配的
    
61.     设置打印机 = False
    
62.     Set ws = CreateObject("wscript.network")
    
63.     Set 打印机列表 = ws.EnumPrinterConnections
    
64.     打印机名称 = UCase(打印机名称)
    
65.     For i = 1 To 打印机列表.Count - 1 Step 2
    
66.         If UCase(打印机列表(i)) Like "*" & 打印机名称 & "*" Then 打印机名称 = 打印机列表(i): Exit For  '打印机名称
    
67.     Next
    
68.     On Error GoTo myerror
    
69.     i = 0
    
70.     Do While True
    
71.         If i > 100 Then End '一般到不了这个数
    
72.         Application.ActivePrinter = 打印机名称 & " 在 Ne" & Format(i, "00") & ":"
    
73.         Exit Do
    
74. myerror:
    
75.         Resume nextLoop
    
76. nextLoop:
    
77.         i = i + 1
    
78.     Loop
    
79.     设置打印机 = True
    
80. End Function
    
81. 
    

复制代码

aa868682008

思路很好，关键是如何实现啊。问了豆包，给了个一个VBA，但是无法使用。

aa868682008

由于这样的表格动辄几百上千页，而且涉及敏感信息，所以只能专人处理，请大神予以出手帮助。

aa868682008

xlj310 发表于 2025-1-7 18:13
我是有一个思路可供参考。 就是把行高按大于1的倍数加大，直到页数增加一页，然后，再把行高×一个小于1的 ...

谢谢，这就试试。

aa868682008

aa868682008 发表于 2025-1-8 16:35
谢谢，这就试试。

在我的2007上没有任何反应，也不知道是我不会操作还是版本太低了。但单位这电脑，能带动2007也算很不错了

panglong00

留名待学！！！！！！！！1

panglong00

xlj310 发表于 2025-1-7 18:13
我是有一个思路可供参考。 就是把行高按大于1的倍数加大，直到页数增加一页，然后，再把行高×一个小于1的 ...

请教一下，为什么下面这句代码不能修改？   修改后就无法测试成功。  这句在 打印机名称 后面加的内容究竟有什么意义？

Application.ActivePrinter = 打印机名称 & " 在 Ne" & Format(i, "00") & ":"

aa868682008

xlj310 发表于 2025-1-7 18:13
我是有一个思路可供参考。 就是把行高按大于1的倍数加大，直到页数增加一页，然后，再把行高×一个小于1的 ...

刚才回复到我自己的评论下面了，汗。现在又复制过来，方便您及时看到：在我的2007上没有任何反应，也不知道是我不会操作还是版本太低了。但单位这电脑，能带动2007也算很不错了。