Excel VBA: получение уровня масштабирования, соответствующего FitToPageWide

Question

Я пытаюсь создать макрос в Excel, который проходит по всем рабочим листам и на основе самого большого листа устанавливает одинаковый уровень масштабирования для всех рабочих листов, чтобы они умещались на одной странице, но имели одинаковый масштаб (который необходим в печать).

У меня, однако, возникают проблемы с определением уровня масштабирования, который гарантирует, что самая большая страница соответствует ширине 1 страницы.

При настройке ширины листа для размещения на одной странице с помощью .PageSetup.FitToPagesWide = 1 .PageSetup.Zoom свойство автоматически устанавливается на ЛОЖЬ.

Если для свойства FitToPage задано значение false, уровень масштабирования не изменяется по сравнению с тем, который был до размещения на одной странице.

При ручной настройке листа таким образом, чтобы он умещался на одну страницу в ширину, Excel показывает, какой уровень масштабирования соответствует этому, но кажется, что в VBA это невозможно прочитать. Может ли кто-нибудь помочь мне с этим вопросом?

Answer 1

Этот пост становится довольно старым, но, поскольку я сидел с подобной проблемой, этот вопрос дал мне возможный ответ.

Используя слегка переделанный код, опубликованный Томом Уртисом ( 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://docs.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