获取用户屏幕宽高比vba excel

Question

我在excel中设计了一个工具供多个用户使用。当我在显示器上打开该工具时，它完全适合屏幕。我已经通过简单缩放到一个范围来完成这项工作：

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

我想知道是否有人知道这样做的更好方法。有些用户表示，该工具会切断侧面和顶部的部分？我想这是因为他们的显示器的宽高比与我的不同。

有没有什么办法可以在excel中使用VBA访问这种信息？如果是这种情况，我可以为不同类型的屏幕创建案例。

Answer 1

对于autofitting我通常使用：

工作表上突出显示要显示 转到插入菜单细胞的整个范围，并选择“姓名”，然后选择“定义” 名称你的范围“VE强调‘ResizeRange’

然后在VBA选择‘的ThisWorkbook’，并粘贴以下代码：如果您wan't走得更远了一步ü也可以删除所有带等，让您

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

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 

在模块1：

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 

在模块2：

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文件，它会再次显示正常。

在worksheet_activate和worksheet_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