gpt4 book ai didi

vba - Excel VBA : getting zoom level corresponding with FitToPageWide

转载 作者:行者123 更新时间:2023-12-02 01:10:54 26 4
gpt4 key购买 nike

我正在尝试在 Excel 中构建一个宏,该宏循环遍历所有工作表,并基于最大的工作表,将所有工作表的缩放级别设置为相同级别,以便它们全部适合一页,但具有相同的比例(其中打印时需要)。

但是,我在确定缩放级别时遇到了麻烦,该缩放级别可确保最大页面适合 1 页宽度。

使用 .PageSetup.FitToPagesWide = 1 将工作表宽度设置为适合一页时,.PageSetup.Zoom 属性会自动设置为 FALSE。

将 FitToPage 属性设置回 false,缩放级别与适合一页之前的状态保持不变。

当手动设置工作表使其适合一页宽时,Excel 确实会显示与此相对应的缩放级别,但似乎无法在 VBA 中读取此内容。有人可以帮我解决这个问题吗?

最佳答案

这篇文章已经很老了,但由于我一直面临类似的问题,这个问题给了我一个可能的答案。

使用 Tom Urtis (https://www.mrexcel.com/forum/excel-questions/67080-page-setup-zoom-property.html) 发布的稍微重做的代码,以下代码迭代提取缩放,然后设置所有页面的缩放。

Option Explicit
#If Win64 Then
Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Sub SetSameZoomOnAllWorksheets()
On Error GoTo failed
Dim initial_sheet As Worksheet, Sheet As Worksheet, minzoom As Double
With Application
'stuff to speed up the process and avoid any visible changes by the user
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
'.Visible = false 'Uncomment on a really slow document to make people freak out. Make sure to have the on error so that you'll set it to visble again
ActiveSheet.DisplayPageBreaks = False
End With
Set initial_sheet = ThisWorkbook.Worksheets(ActiveSheet.name)
minzoom = 400 ' max value set by zoom
'iterate over each sheet
For Each Sheet In ThisWorkbook.Worksheets
minzoom = Application.Min(minzoom, GetOnePageZoom(Sheet))
Next Sheet
'iterate over each sheet once more and set the zoom to the lowest zoom
For Each Sheet In ThisWorkbook.Worksheets
With Sheet
If .Visible = xlSheetVisible Then
.Select
.PageSetup.Zoom = minzoom
End If
End With
Next Sheet
initial_sheet.Select
failed:
With Application
'Change it back so that the user may see any changes, perform calculations and so on
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
'.Visible = True 'This one is very important to unmark if you have marked .visible = false at the top
End With
End Sub
Function GetOnePageZoom(ByRef Sheet As Worksheet) As Double
With Sheet
If .Visible = xlSheetVisible Then
.Select
'LockWindowUpdate locks the specified window for drawing - https://learn.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-lockwindowupdate
'XLMAIN is the current active window in excel
LockWindowUpdate FindWindowA("XLMAIN", Application.Caption)
.PageSetup.FitToPagesWide = 1
.PageSetup.Zoom = False
'pre-send keys for next command to specify: On pagesetup Dialog Press P to open the 'Print', then press alt + A to set page setup to adjust (Automatically moves into the zoom field but keeps the value), press enter
'This changes the pagesetup from 'fitstopageswide = 1' to 'automatic' but keeps the zoom at whatever level it was set to by the fitstopageswide
SendKeys "P%A~"
Application.Dialogs(xlDialogPageSetup).Show
LockWindowUpdate 0
GetOnePageZoom = .PageSetup.Zoom
Debug.Print .PageSetup.Zoom
Else
GetOnePageZoom = 400
End If
End With
End Function

关于vba - Excel VBA : getting zoom level corresponding with FitToPageWide,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/42139024/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com