XL 2019 Adaptation d'une interface à la résolution de plusieurs écrans

[loic74*]

Bonjour à tous,

Je suis en train de créer une interface servant de menu pour gérer des dossier et je souhaitais faire en sorte que l'application s'adapte aux différentes résolutions des utilisateurs lorsque ceux-ci utilisent plusieurs écran pouvant avoir des résolutions différentes.
Pour cela, j'ai trouvé une fonction qui me permet d'ajuster la taille de l'interface à l'écran de l'utilisateur en changeant la résolution grâce au code suivant :

Option Explicit
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" _
(ByVal hWnd As Long, rectangle As RECT) As Long

Function GetScreenResolution() As String
Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long
hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
End Function

Puis je passe pour un bouton dynamique qui me permet d'appliquer cette fonction et d'ajuster la résolution :

Private Sub CommandButton1_Click()
Dim Hauteur As Variant, Zoom As Double, Resolution As String
Const Zoom_100 As Integer = 1368

Resolution = GetScreenResolution
Hauteur = Mid(Resolution, 1, InStrRev(Resolution, "x") - 1)
Zoom = (100 / Zoom_100) * CDbl(Hauteur)

MsgBox "Résolution actuelle : " & Resolution & " zoom passé à : " & Format(Zoom, "0") & " % (100% = " & Zoom_100 & ")"

ActiveWindow.Zoom = Format(Zoom, "0")
End Sub

Mon problème est que si l'utilisateur travail sur plusieurs écrans simultanément, l'interface ne modifie pas le zoom et ne prend en compte que la résolution de l'écran défini comme écran principal.
Je me demande donc s'il est possible d'ajuster l'interface, soit à l'aide du bouton ou automatiquement, en fonction des différentes résolutions de l'utilisateur (autre que l'écran principal) ?

D'avance merci pour votre aide !

 

[Lolote83]

Bonjour LOIC74*,
Va faire un tour sur ce fil, cela permet d’identifier les écrans et ainsi tu devrais y retrouver tes petits
https://www.excel-downloads.com/threads/recuperation-de-la-resolution-de-plusieurs-ecran.20001925/
Je viens de faire un test et chez moi, les deux écrans sont bien détectés
Excel lancé sur écran principal

Bon courage
@+ Lolote83

 

[job75]

Bonjour loic74*, bienvenue sur XLD,

Le titre de la discussion n'est pas du tout significatif, modifiez-le.

Et joignez votre fichier, allégé et sans données confidentielles.

Cela dit je n'irai pas plus loin car je ne travaille pas sur plusieurs écrans

Edit : salut Lolote83, pas rafraîchi.

A+

 

[Usine à gaz]

Bonjour loic74*, Lolote83, Gérard, le Forum,

@ loic74* : peut-être comme ça

Sheets("SOMMAIRE").Select
Range(Cells(1, 24), Cells(1, 1)).Select
ActiveWindow.Zoom = True 'ActiveWindow.Zoom = 114

voir fichier en retour,
Amicalement,
lionel,

 

[Lolote83]

Bonjour Usine à gaz.
Effectivement ça peut le faire et c'est très court .....
@+ Lolote83

 

[cathodique]

Bonjour loic74*, Lolote83, Gérard, le Forum,

@ loic74* : peut-être comme ça

Sheets("SOMMAIRE").Select
Range(Cells(1, 24), Cells(1, 1)).Select
ActiveWindow.Zoom = True 'ActiveWindow.Zoom = 114

voir fichier en retour,
Amicalement,
lionel,

Bonjour Usine à gaz , Lolote83 , job75 ,loic74* ,

@Usine à gaz : juste pour info, chez-moi sous Excel 2010 le code plante sur la ligne ci-dessous de la procédure WorkBook_Open

    ActiveWindow.EnableResize = False

 

[Usine à gaz]

Bonsoir cathodique

Chez moi ça ne plante pas c'est curieux que ça plante chez toi.

Private Sub Workbook_Open()
    Application.CommandBars(1).Enabled = False
    ActiveWindow.EnableResize = False
    Application.DisplayFormulaBar = False
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
    ActiveWindow.DisplayWorkbookTabs = False
    ActiveWindow.DisplayHeadings = False
    Application.DisplayFullScreen = True

Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = False
Next CmdB

Worksheets("SOMMAIRE").ScrollArea = "a1:D10"
Sheets("SOMMAIRE").Select
Range(Cells(1, 24), Cells(1, 1)).Select
    ActiveWindow.Zoom = True

End Sub

Je testerai encore,
lionel

 

[cathodique]

Bonsoir cathodique

Chez moi ça ne plante pas c'est curieux que ça plante chez toi.

Private Sub Workbook_Open()
    Application.CommandBars(1).Enabled = False
    ActiveWindow.EnableResize = False
    Application.DisplayFormulaBar = False
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
    ActiveWindow.DisplayWorkbookTabs = False
    ActiveWindow.DisplayHeadings = False
    Application.DisplayFullScreen = True

Dim CmdB As CommandBar
For Each CmdB In Application.CommandBars
CmdB.Enabled = False
Next CmdB

Worksheets("SOMMAIRE").ScrollArea = "a1:D10"
Sheets("SOMMAIRE").Select
Range(Cells(1, 24), Cells(1, 1)).Select
    ActiveWindow.Zoom = True

End Sub

Je testerai encore,
lionel

Merci pour ton retour. Est-ce que tu es sous Excel 2010 32bits/ Win7 6 bits?

 

[Usine à gaz]

Je suis sous windoww10 64 et
Setup.X64.fr-fr_O365BusinessRetail_028b3ef4-42f1-409d-901b-d8c0f8ee9f17_TX_DB_b_32_
donc excel 64 bytes

 

[cathodique]

Je suis sous windoww10 64 et Office 365

Merci. Excel 2010 patine.

 

[patricktoulon]

bonjour
pour info
zoom n'accepte q'un long de 1 à 400 ou un boolean(false/true)
tu capte la résolution c'est en pixel hors on travaille en point sur excel
bref c'est tout faux de A à Z

 

[patricktoulon]

re
vire ton module 1 a la poubelle
dans le module de la feuille en question
clique pour plein ecran sans le ruban et reclique pour le remettre normal

Option Explicit
Dim z As Boolean
Dim Wstate As Long
Private Sub CommandButton1_Click()
    If Not z Then
        z = True
        Wstate = Application.WindowState
        ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",false)"  
        Application.WindowState = xlMaximized
        [A1:X46].Select
        ActiveWindow.Zoom = z
    Else
        Application.WindowState = Wstate
        ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",True)"   
        ActiveWindow.Zoom = 100
    z = False
    End If
End Sub

et voila c'est pas compliqué
si tu est en double écran (en mode étendu) c'est a dire le bureau sur les deux écran)ça ne peut pas fonctionner
sinon normalement l'application se met en plein écran sur l’écran principal toute seule
c'a n'est pas forcé l'ecran 1 soit le principal voir dans ta config paramètres d'affichage
il faut etre en double ecran 1 et 2 mode double

 

[loic74*]

Bonjour à tous,
Merci pour votre aide, je vais tester tous ça pour voir si ça fonctionne chez moi

 

[loic74*]

@patricktoulon super ça fonctionne super bien !
Il y t'il un moyen pour que la fonction se lance automatiquement ou il faut obligatoirement passer par un bouton de commande ?
Merci pour votre aide à tous !

 

[patricktoulon]

bonjour ben tu la lance dans le workbook_open c'est tout
vire le code que je t'ai donné dans la feuille et met celui ci dans le module thisworkbook

Option Explicit
Private Sub Workbook_Open()
    fullscreen
End Sub
Sub fullscreen()
    With Application
       .WindowState = xlMaximized
        .DisplayFormulaBar = False
        .DisplayScrollBars = False
        .ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",false)"
         [A1:X46].Select
    End With
    With ActiveWindow
        .Zoom = True
        .DisplayWorkbookTabs = False
        .DisplayHeadings = False
    End With
End Sub

et voila