VBA: Trouver la résolution de l’écran


Si vous avez besoin d'adapter votre Classeur (Workbook) en fonction de l'écran de l'utilisateur, vous pouvez utiliser le langage VBA pour modifier le Zoom de la feuille (voir le code VBA plus bas).

Pour savoir de quelle manière adapter le Zoom vous devez connaître la résolution de l'écran de l'utilisateur. Les deux fonctions suivantes vous permettent d'obtenir la Largeur de l'écran, la Hauteur de l'écran et, naturellement, leur combinaison.

Résolution de l'écran avec VBA

Le code fait appel à la fonction GetSystemMetrics32 de la librairie "User32". Si cela ne vous dit rien, cela n'a pas d'importance. Sachez seulement que le code qui suit doit se trouver au début de votre Module (avant même les fonctions):

Declare Function GetSystemMetrics32 Lib "User32" _
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Grâce à cette déclaration, vous pouvez accéder à certaines valeurs système dont la résolution de l'écran de l'ordinateur.

Et voici donc les deux fonctions VBA prêtes à l'emploi (vous pouvez les utiliser directement telles quelles après un copier/coller). Elles retournent la hauteur et la largeur de l'écran en pixels.

Fonctions VBA pour trouver la Largeur et la Hauteur de l'écran

Declare Function GetSystemMetrics32 Lib "User32" _
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Public Function ResolutionEcranLargeur()
'par: Excel-Malin.com ( http://excel-malin.com )
    On Error GoTo FunctionErreur
    Dim LargeurEcran As Long
    
        LargeurEcran = GetSystemMetrics32(0) 'largeur de l'écran en pixels
        ResolutionEcranLargeur = LargeurEcran
    
    Exit Function
FunctionErreur:
    ResolutionEcranHauteur = ""
End Function


Public Function ResolutionEcranHauteur()
'par: Excel-Malin.com ( http://excel-malin.com )
    On Error GoTo FunctionErreur
    Dim HauteurEcran As Long
    
        HauteurEcran = GetSystemMetrics32(1) 'hauteur de l'écran en pixels
        ResolutionEcranHauteur = HauteurEcran
        
    Exit Function
FunctionErreur:
    ResolutionEcranHauteur = ""
End Function

 

Exemple d’utilisation des fonctions ResolutionEcranLargeur() et ResolutionEcranHauteur()

Voici comment vous pouvez obtenir le message contenant la résolution de votre écran (le résultat est formaté).

Sub ResolutionEcran()
'par: Excel-Malin.com ( http://excel-malin.com )
    On Error GoTo ResolutionEcranErreur
    
    MsgBox "La résolution de l'écran (largeur x hauteur): " & (Chr(13) & Chr(10)) & Format(ResolutionEcranLargeur, "#,##0") & " x " & Format(ResolutionEcranHauteur, "#,##0"), vbInformation
    
    Exit Sub
ResolutionEcranErreur:
    MsgBox "La résolution de l'écran n'a pas pu être obtenue..."
End Sub

VBA: adapter la Feuille à la taille de l'écran

Maintenant que nous avons la résolution de l'écran de l'utilisateur, nous pouvons utiliser cette information pour adapter le Zoom de la Feuille.

Nous pouvons créer deux ou même plusieurs "tailles" de la Feuille. Pour un résultat optimal, il vous faudra tester le résultat sur les différentes résolution et trouver la valeur de Zoom qui convient le mieux. Voyez l'exemple suivant…

Exemple: comment adapter le Zoom de la Sheet selon la résolution de l'écran

Dans cet exemple, la Feuille est créée sur un écran avec la largeur de 1280 pixels. Pour être sûr que l'utilisateur avec un écran avec une plus faible résolution (par exemple: la largeur habituelle de 1024 pixels) puisse voir tout le contenu, nous adaptons le Zoom de la Feuille à 68%. L'utilisateur avec un écran de 1280 pixels de large verra le contenu dans sa taille originale (Zoom = 100%).

Sub AdapterZoomSelonResolution()
'par: Excel-Malin.com ( http://excel-malin.com )
    On Error GoTo ExempleErreur
    
            Select Case ResolutionEcranLargeur 'tester la résolution de la largeur
                'adapter le zoom du WorkBook selon le résultat
                Case 1280: ActiveWindow.Zoom = 100
                Case 1024: ActiveWindow.Zoom = 68
                Case Else
            End Select
    Exit Sub
ExempleErreur:
    MsgBox "Une erreur est survenue..."
End Sub

Pour aller plus loin

18 0



Laissez un commentaire

Votre adresse de messagerie ne sera pas publiée.