Получение формата экрана для экрана vba excel

Question

Я разработал инструмент в excel для использования несколькими пользователями. Когда я открываю инструмент на моем мониторе, он идеально подходит для экрана. Я сделал это просто масштабирование в диапазоне:

Sheets("sliders").Activate 
Range("A1:BA51").Select 
Range("A51").Activate 
ActiveWindow.Zoom = True 

мне было интересно, если кто-нибудь знает лучший способ сделать это. Некоторые пользователи заявили, что инструмент отсекает разделы по бокам и сверху? Я думаю, это потому, что аспектный рацион их монитора отличается от моего.

Есть ли способ получить доступ к этой информации с помощью VBA в excel? Я мог бы делать случаи для экранов различного типа, если это было так.

Answer 1

Для autofitting я обычно использую это:

на листе выделить весь диапазон ячеек, которые вы хотите отобразить Перейдите в меню Вставка и выберите «Имя», а затем «Определить» Назовите диапазон вам «ве выделены„ResizeRange“

Затем в VBA выбрать„ThisWorkbook“и вставьте следующий код:

Private Sub Workbook_Open() 
range("ResizeRange").select 
ActiveWindow.Zoom = True 
cells(1,1).select 
end sub 

Если вы wan't пойти на шаг дальше у также может удалить все ленты и т.д., чтобы вы VISU союзник может видеть только ваш раструб. затем сделать следующий

В ThisWorkbook:

Sub Workbook_Open() 
Application.EnableEvents = False 
Call masque 
Application.EnableEvents = True 
End Sub 

Sub Workbook_Activate() 
Application.EnableEvents = False 
Call masque 
Application.EnableEvents = True 
End Sub 

Sub Workbook_Deactivate() 
Application.EnableEvents = False 
Call normal 
Application.EnableEvents = True 
End Sub 

Sub Workbook_BeforeClose(Cancel As Boolean) 
Application.EnableEvents = False 
Call normal 
Application.EnableEvents = True 
ThisWorkbook.Saved = True 
End Sub 

В Module1:

Sub masque() 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)" 
ActiveWindow.DisplayHeadings = False 
ActiveWindow.DisplayGridlines = False 
Application.DisplayFullScreen = True 
Application.DisplayStatusBar = Not Application.DisplayStatusBar 
Application.WindowState = xlMaximized 
ActiveWindow.WindowState = xlMaximized 
Application.DisplayFormulaBar = False 
Application.EnableEvents = True 
Application.ScreenUpdating = True 
End Sub 

В module2:

Sub normal() 
Application.ScreenUpdating = False 
ActiveWindow.View = xlNormalView 
ActiveWindow.DisplayHeadings = True 
ActiveWindow.DisplayGridlines = True 
Application.DisplayStatusBar = True 
ActiveWindow.DisplayHorizontalScrollBar = True 
ActiveWindow.DisplayVerticalScrollBar = True 
Application.DisplayFullScreen = False 
Application.DisplayFormulaBar = True 
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)" 
'Curiously, if we put the previous line at the beginning of the module, it  is not taken into account each time ... 
Application.ScreenUpdating = True 
End Sub 

В каждом листе:

Sub Worksheet_Open() 
Call masque 
End Sub 

Sub Worksheet_Activate() 
Application.ScreenUpdating = False 
Call masque 
Application.ScreenUpdating = True 
End Sub 

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

в workheet_activate и workheet_open вы можете добавить следующую строку, чтобы убедиться, что каждый прокрутка и ваша информация остаются на экране все время.

me.scrollarea = resizerange 

Answer 2

Попробуйте это:

Declare Function GetSystemMetrics32 Lib "User32" _ 
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long 

Sub FindResolution() 
Dim w As Long, h As Long 
    w = GetSystemMetrics32(0) ' width in pixels 
    h = GetSystemMetrics32(1) ' height in pixels 
    MsgBox w & Chr(10) & h, vbOKOnly + vbInformation, "Monitor Size (width x height)" 


End Sub