我有一个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
当我在Excel2003中尝试时,按钮大小&其标题缩放不正确。并且CCD_ 1总是返回CCD_ 2作为屏幕分辨率1024*768或1366*768的宽度。有什么想法吗?
如果在任何系统屏幕分辨率中打开,我希望Excel表格的宽度合适
Sheets(1).Range("a1:AC1").Select
ActiveWindow.Zoom = True
是的,这就是所需要的。这将根据屏幕分辨率调整缩放级别。有关详细信息,请参阅以下链接:-http://optionexplicitvba.blogspot.sg/2011/10/one-size-fits-all.html
您可以将此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
我想我应该分享我放在一起的东西,这些东西可以用于多张图纸。它借鉴了上述答案,并且您不必指定的有效范围
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