默认设置打印方向为纵向，打印缩放比例满足一定条件改为横向

此乃小白一枚

代码作用：打印设置，页面A4；水平居中；1页宽，高自动；页面方向纵向，若缩放比例小于70%，页面方向设为横向；
但是经过测试，代码第37行这个 if .zoom < 70 是恒成立的，请vba大佬帮忙改写

1. Sub 打印多个工作表()
   
2. 
   
3.     Application.ScreenUpdating = False      '关闭屏幕更新
   
4.    
   
5.     If Not Application.Dialogs(xlDialogPrinterSetup).Show Then
   
6.         Exit Sub
   
7.     End If
   
8.    
   
9.     Dim 是否修改格式 As Integer
   
10.     是否修改格式 = MsgBox("是否自动调整打印格式", vbYesNo)
    
11.    
    
12.     Dim 当前工作表 As Worksheet
    
13.     For Each 当前工作表 In Worksheets
    
14.         If 当前工作表.Visible = xlSheetVisible Then      '只打印没有隐藏的工作表
    
15.             If 是否修改格式 = vbYes Then
    
16.                 修改打印格式 当前工作表
    
17.             End If
    
18.             '当前工作表.PrintOut        '先屏蔽本行代码
    
19.         End If
    
20.     Next
    
21.    
    
22.     Application.ScreenUpdating = True      '恢复屏幕更新
    
23. 
    
24. End Sub
    
25. 
    
26. Sub 修改打印格式(工作表 As Worksheet)
    
27. 
    
28.     工作表.Range("1:1048576").Interior.ColorIndex = xlNone      '设置单元格无填充
    
29. 
    
30.     With 工作表.PageSetup
    
31.         .PaperSize = xlPaperA4              '页面纸张大小(Z)：A4
    
32.         .CenterHorizontally = True         '页边距居中方式：水平(Z)
    
33.         .Zoom = False                       '页面缩放比例：未选择
    
34.         .FitToPagesWide = 1                 '调整为1页宽
    
35.         .FitToPagesTall = False             '调整为自动高
    
36.         .Orientation = xlPortrait           '页面方向：纵向(T) xlPortrait/ 横向(L) xlLandscape, 默认纵向
    
37.         If .Zoom < 70 Then
    
38.             .Orientation = xlLandscape          '页面方向：纵向(T) xlPortrait/ 横向(L) xlLandscape
    
39.         End If
    
40.     End With
    
41. 
    
42. End Sub

复制代码

这个问题已经困扰我两天了，也可能是我思路有问题，还望大佬指导已经解决了，感谢大家帮忙，附上最终代码（已打印大量表格，经检查未发现问题）
文件工作簿1是有问题的，文件工作簿2是最终的（应该是正确的）

1. Sub 打印多个工作表()
   
2. 
   
3.     Application.ScreenUpdating = False      '关闭屏幕更新
   
4.    
   
5.     If Not Application.Dialogs(xlDialogPrinterSetup).Show Then
   
6.         Exit Sub
   
7.     End If
   
8.    
   
9.     Dim 是否修改格式 As Integer
   
10.     是否修改格式 = MsgBox("是否自动调整打印格式", vbYesNo)
    
11.    
    
12.     Dim 当前工作表 As Worksheet
    
13.     For Each 当前工作表 In Worksheets
    
14.         If 当前工作表.Visible = xlSheetVisible Then      '只打印没有隐藏的工作表
    
15.             If 是否修改格式 = vbYes Then
    
16.                 修改打印格式 当前工作表
    
17.             End If
    
18.             '当前工作表.PrintOut      '暂时屏蔽本行代码
    
19.         End If
    
20.     Next
    
21.    
    
22.     Application.ScreenUpdating = True      '恢复屏幕更新
    
23. 
    
24. End Sub
    
25. Sub 修改打印格式(工作表 As Worksheet)
    
26. 
    
27.     工作表.Range("1:1048576").Interior.ColorIndex = xlNone      '设置单元格无填充
    
28. 
    
29.     With 工作表.PageSetup
    
30.         .PaperSize = xlPaperA4              '页面纸张大小(Z)：A4
    
31.         .CenterHorizontally = True         '页边距居中方式：水平(Z)
    
32.         .Orientation = xlPortrait           '页面方向：纵向(T) xlPortrait/ 横向(L) xlLandscape, 默认纵向
    
33.         .Zoom = 70                       '页面缩放比例：70%
    
34.         If 工作表.VPageBreaks.Count Then
    
35.             .Orientation = xlLandscape          '页面方向：纵向(T) xlPortrait/ 横向(L) xlLandscape
    
36.         End If
    
37.         .Zoom = False
    
38.         .FitToPagesWide = 1                 '调整为1页宽
    
39.         .FitToPagesTall = False             '调整为自动高
    
40.     End With
    
41. 
    
42. End Sub
    

复制代码

但是.VPageBreaks.count可能不能正确获得垂直分页符的数量，望大佬帮忙看下

此乃小白一枚

代码有问题...已修改

1. Sub 打印多个工作表()
   
2. 
   
3.     Application.ScreenUpdating = False      '关闭屏幕更新
   
4.    
   
5.     If Not Application.Dialogs(xlDialogPrinterSetup).Show Then
   
6.         Exit Sub
   
7.     End If
   
8.    
   
9.     Dim 是否修改格式 As Integer
   
10.     是否修改格式 = MsgBox("是否自动调整打印格式", vbYesNo)
    
11.    
    
12.     Dim 当前工作表 As Excel.Worksheet
    
13.     For Each 当前工作表 In Worksheets
    
14.         With 当前工作表
    
15.             If .Visible = xlSheetVisible Then      '只打印没有隐藏的工作表
    
16.                 If 是否修改格式 = vbYes Then
    
17.                     鼎信诺化打印格式 当前工作表               '该函数存放于其他模块
    
18.                 End If
    
19.                 .PrintOut
    
20.             End If
    
21.         End With
    
22.     Next
    
23.    
    
24.     Application.ScreenUpdating = True      '恢复屏幕更新
    
25. 
    
26. End Sub
    
27. 
    
28. Sub 修改打印格式(ByVal 工作表 As Excel.Worksheet)
    
29.    
    
30.     Application.PrintCommunication = False           '中断与打印机的通信以提高运行速度
    
31.         
    
32.     ActiveWindow.View = xlPageBreakPreview   '切换视图为分页预览
    
33.    
    
34.     With 工作表.PageSetup
    
35.    
    
36.         .PaperSize = xlPaperA4              '页面纸张大小(Z)：A4
    
37.         .CenterHorizontally = True          '水平居中
    
38.         .Orientation = xlPortrait           '页面方向：纵向(T) xlPortrait/ 横向(L) xlLandscape, 默认纵向
    
39.         .Zoom = 70                          '页面缩放比例：70%（可忍受的最低缩放比例）
    
40.         Application.PrintCommunication = True           '恢复与打印机的通信以获得正确的垂直分页符数量
    
41.         Application.PrintCommunication = False           '中断与打印机的通信以提高运行速度
    
42.         If 工作表.VPageBreaks.Count Then .Orientation = xlLandscape       '页面过宽，改为横向
    
43.         .Zoom = False
    
44.         .FitToPagesWide = 1                 '调整为1页宽
    
45.         .FitToPagesTall = False             '高度自动

复制代码

此乃小白一枚

自己顶一下

此乃小白一枚

好吧，继续顶

此乃小白一枚

顶一下
[em07

此乃小白一枚

自己顶一下，话说是我表述有问题吗？都没人回帖

此乃小白一枚

疯狂顶贴

fanyoulin

你这问题有点另类：
1、一般表格都是固定的，谁没事会把表格变来变去？
2、万一表格被偶尔变化了，也就是鼠标点一下的事，用代码很多余的。

此乃小白一枚

fanyoulin 发表于 2021-1-14 12:53
你这问题有点另类：
1、一般表格都是固定的，谁没事会把表格变来变去？
2、万一表格被偶尔变化了，也就是 ...

感谢回复，有些时候是需要这个功能的，审计会做一堆底稿，手工的，打印的话要一张一张地调整打印格式，其实尽量能看清楚就行了，所以你可以看到，我的代码设置纵横的规则很简单

此乃小白一枚

自己顶一下

此乃小白一枚

顶一下