根据屏幕分辨率调整工作表缩放级别 [英] Adjusting worksheet zoom level based on screen resolution

问题描述

  Sub Macro1（）
 Dim maxWidth As Long，myWidth As Long 
 Dim myZoom As Single 
 
 maxWidth = Application.UsableWidth * 0.96 
'我使用r，因为有一个宏按钮
 myWidth = ThisWorkbook.ActiveSheet.Range（r1）。左
 myZoom = maxWidth / myWidth 
 ActiveWindow.Zoom = myZoom * 100 
 End Sub 
  

当我在Excel 2003中尝试按钮大小&其标题没有正确缩放。
和 Application.UsableWidth 总是返回 1026 作为屏幕分辨率1024 * 768或1366的宽度* 768。任何想法？

如果在任何系统屏幕分辨率下打开，我希望Excel表适合宽度

解决方案

您可以将此Windows API调用添加到可以确定屏幕分辨率的代码中。

 私有声明PtrSafe函数GetSystemMetrics LibUSER32_ 
（ByVal nIndex As Long）As Long 
 
 Sub Macro1（）
 Dim maxWidth As Long 
 Dim myWidth As Long 
 Dim myZoom As Single 
 
 maxWidth = GetSystemMetrics（0）* 0.96 
 myWidth = ThisWorkbook.ActiveSheet.Range（R1）。左
 myZoom = maxWidth / myWidth 
 ActiveWindow.Zoom = myZoom * 100 
 
 End Sub 
  

I have an Excel 2003 macro to adjust my screen zoom based on the screen resolution.

Sub Macro1()
   Dim maxWidth As Long, myWidth As Long
   Dim myZoom As Single

   maxWidth = Application.UsableWidth * 0.96
   'I use r because upto r i have macro buttons
   myWidth = ThisWorkbook.ActiveSheet.Range("r1").Left
   myZoom = maxWidth / myWidth
   ActiveWindow.Zoom = myZoom * 100
End Sub

When I try in Excel 2003, button size & its caption are not zooming properly. And Application.UsableWidth is always returning 1026 as width for either the screen resolution 1024*768 or 1366*768. Any ideas?

I want the Excel sheet to be fit in width if open in any system screen resolution

解决方案

You can add this Windows API call to your code which can determine the screen resolution.

Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" _
 (ByVal nIndex As Long) As Long

  Sub Macro1()
    Dim maxWidth As Long
    Dim myWidth As Long
    Dim myZoom As Single

    maxWidth = GetSystemMetrics(0) * 0.96
    myWidth = ThisWorkbook.ActiveSheet.Range("R1").Left
    myZoom = maxWidth / myWidth
    ActiveWindow.Zoom = myZoom * 100

  End Sub

这篇关于根据屏幕分辨率调整工作表缩放级别的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！