vba 根据屏幕分辨率调整工作表缩放级别
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11533942/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Adjusting worksheet zoom level based on screen resolution
提问by logan
I have an Excel 2003 macro to adjust my screen zoom based on the screen resolution.
我有一个 Excel 2003 宏可以根据屏幕分辨率调整我的屏幕缩放比例。
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.UsableWidthis always returning 1026as width for either the screen resolution 1024*768 or 1366*768. Any ideas?
当我在 Excel 2003 中尝试时，按钮大小及其标题没有正确缩放。并且Application.UsableWidth总是1026以屏幕分辨率 1024*768 或 1366*768 的宽度返回。有任何想法吗？
I want the Excel sheet to be fit in width if open in any system screen resolution
如果在任何系统屏幕分辨率下打开，我希望 Excel 工作表适合宽度
采纳答案by Robert Mearns
You can add this Windows API call to your code which can determine the screen resolution.
您可以将此 Windows API 调用添加到可以确定屏幕分辨率的代码中。
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
回答by user2598456
Sheets(1).Range("a1:AC1").Select
ActiveWindow.Zoom = True
Yes, this is all that's required. This will adjust the zoom level based on the screen resolution. Refer below link for detailed information :- http://optionexplicitvba.blogspot.sg/2011/10/one-size-fits-all.html
是的，这就是所需要的。这将根据屏幕分辨率调整缩放级别。有关详细信息，请参阅以下链接：- http://optionexplicitvba.blogspot.sg/2011/10/one-size-fits-all.html
回答by Mike
I thought I'd share what I put together which can be used for multiple sheets. It borrows from the above answers, and you do not have to specify what the active range is
我想我会分享我放在一起的东西，这些东西可以用于多张纸。它借鉴了上述答案，您不必指定活动范围是什么
Sub Zoomitgood()
'this macro will loop through all the sheets and zoom to fit the contents by
'measuring the width and height of each sheet. It will then zoom to 90% of
'the "zoom to fit" setting.
Dim WS_Count As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim maxwidth As Integer
Dim width As Integer
Dim Height As Integer
Dim MaxHeight As Integer
Dim zoom As Integer
'First Loop: Loop through each sheet, select each sheet so that each width
'and height can be measured. The width and height are measured in number of
'cells.
WS_Count = ActiveWorkbook.Worksheets.Count
For i = 1 To WS_Count
Worksheets(i).Activate
maxwidth = 0
MaxHeight = 0
'Second loop: measure the width of each sheet by running line by line and
'finding the rightmost cell. The maximum value of the rightmost cell will be
'set to the maxwidth variable
For j = 1 To 100
width = Cells(j, 100).End(xlToLeft).Column
If width >= maxwidth Then
maxwidth = width
End If
Next
'Third loop: measure the height of each sheet by running line by line and
'finding the rightmost cell. The maximum value of the lowest cell will be
'set to the maxheight variable.
For k = 1 To 100
Height = Cells(100, k).End(xlUp).Row
If Height >= MaxHeight Then
MaxHeight = Height
End If
Next
'Finally, back to loop 1, select the range for zooming. Then set the zoom to
'90% of full zoom.
Range(Cells(1, 1), Cells(MaxHeight, maxwidth)).Select
ActiveWindow.zoom = True
zoom = ActiveWindow.zoom
ActiveWindow.zoom = zoom * 0.9
Cells(1000, 1000).Select
Application.CutCopyMode = False
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Next
MsgBox "You have been zoomed"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
