Réglage de la feuille de calcul du niveau de zoom basé sur la résolution de l'écran

J'ai Excel 2003 macro pour régler mon écran zoom basé sur la résolution de l'écran.

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

Quand j'essaie dans Excel 2003, la taille du bouton & sa légende ne sont pas zoomer correctement.
Et Application.UsableWidth est toujours de retour 1026 que la largeur soit la résolution d'écran de 1024*768 ou résolution de 1366*768. Des idées?

Je veux la feuille Excel pour être adapté à la largeur de s'ouvrir dans n'importe quel système de résolution d'écran

OriginalL'auteur logan | 2012-07-18

  1. 2

    Vous pouvez ajouter cet appel d'API de Windows de votre code qui peut déterminer la résolution de l'écran.

    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
    Est-il une raison pour utiliser le PtrSafe mot-clé pour Excel 2003?
    Non, il n'est requise que pour les systèmes 64 bits.

    OriginalL'auteur Robert Mearns

  2. 8
    Sheets(1).Range("a1:AC1").Select
ActiveWindow.Zoom = True

    Oui, c'est tout ce qui est nécessaire. Cela permettra d'ajuster le niveau de zoom est basé sur la résolution de l'écran.
    Consultez ci-dessous le lien pour obtenir des informations détaillées :-
    http://optionexplicitvba.blogspot.sg/2011/10/one-size-fits-all.html

    Bienvenue DONC. +1 pour l', y compris la source.

    OriginalL'auteur user2598456

  3. 0

    Je pensais que je voudrais partager ce que j'ai mis en place qui peut être utilisé pour plusieurs feuilles. Elle emprunte les réponses ci-dessus, et vous n'avez pas à spécifier la plage active est 

    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

    OriginalL'auteur Mike