XL 2016 VBA - Réduire la largeur de la grille Excel

[Dudu2]

Bonjour,

DataSnipper est un outil commercial ajoutant à Excel des fonctionnalités diverses.
Parmi ces fonctionnalités, la possibilité de visualiser des documents PDF directement dans Excel avec cette particularité (voir image ci-dessous) que la fenêtre Excel est divisée en 2 verticalement. La partie gauche contient la grille Excel, la partie droite contient probablement un Control ActiveX visualisateur PDF, je ne sais pas lequel ? Acrobat ? PDF-XChange Viewer ? Autre ?

La question est: comment est-il possible dans une fenêtre Excel de réduire la largeur de la grille Excel et ses ascenseurs comme le fait ce logiciel ?

 

[patricktoulon]

@Dudu2 le but étant de faire disparaitre la caption et le bouton
et j'ai peut être un peu oublié le set windowlong sur apphandle car même si ca supprime pas la caption ca supprime le DWM et frame size ce qui fait que normalement l'app ne peut pas être bougé dans le userform
version docké dans le xmlsource

regarde je vous racconte pas d'histoire

 

[nullosse]

Patricktoulon, je ne sais pas ce que tu as "bricolé" dans le dernier classeur que tu as posté mais il se comporte comme avec le xlam. Cette partie est louche :

 '/////////////////////////////////////////////////////////////////////
    'IL NE VOUS RESTE PLUS QU A LA DOCKER DANS EXCEL7
    'exemple
    SetWindowPos Hform, -1, largeur, 0, largeur, hauteur, 0
    SetParent Hform, XLDESK
    SetWindowPos He7, 0, 0, 0, largeur, hauteur, 0
    
    'ou
    'LA DOCKER DANS LE VOLET XMLSOURCE
    'DoEvents
    SetParent Hform, HXML
    SetWindowPos Hform, 0, 5, 0, largeur - 5, hauteur, 0
    '/////////////////////////////////////////////////////////////

 

[patricktoulon]

en fait il faut bloquer l'une ou l'autre pardon en haut docké au xldesk en bas docké au xml

 

[patricktoulon]

par contr evous avez vu que j'ai trouvé une astuce imparable pour détecter si le volet xml est ouvert ou non ?
ça simplifie les chose
car une fois qu'il a été affiché une fois il reapparait dans la list même si il est fermé gestion(MDI/SDI)
du coup pour savoir c'etait compliqué mais en fait non il sufit de tester le rangefrompoint la ou il est sensé être
apres tu m'a pas dit le "*WindowsZoom" ca te sert ou non ?

 

[nullosse]

Bon je crois que j'ai trouvé pourquoi le bouton Fichier est caché chez toi et pas chez moi. Normalement d'après tes commentaires tu as une commande qui doit cacher la barre de titre de word -> cela ne se fait pas sur mon Excel 2021 , du coup j'ai rajouté la hauteur de la barre de titre dans le rectangle du cache :

      'Crée la région entiere de la barre de titre
        hRgnCaption = CreateRectRgn(0, 0, .Width / PpX, hauteurRgn2 + hauteurRgn1)
        'Crée la région du bouton à masquer
        hRgnBouton = CreateRectRgn(0, 0, 65, hauteurRgn2 + hauteurRgn1)

J'ai rajouté quelques pixels en x car sinon cela ne couvrait pas totalement mon bouton.
Attention à la variable hauteurRgn1 qui dans les Dim s'appelle bien comme cela mais après tu avais mis hauteurRng1
Voilà ce que cela fait chez moi maintenant :

 

[patricktoulon]

oui c'est le même problème qu'avec la petite fenêtre pour cacher en fait chez vous il faut couper pareil a 86 a peu près
en fait la caption et la barre de titre des onglet c'est la même chez vous j'avais oublié ca je l'avais remarqué sur 2016 64
donc

  'hauteur de la barre de tire
    hauteurRng1 = GetSystemMetrics(30) '* WindowsZoom
   
    'hauteur  de la fenêtre jusqu'au bas du bouton fichier
    hauteurRgn2 = GetSystemMetrics(54) + GetSystemMetrics(30) '* WindowsZoom
   
    If Val(Application.Version) > 15 Then hauteurRng1 = hauteurRng1 + hauteurRng2: hauteurRng2 = hauteurRng1

et voila ca marchera pour tout le monde
et tu enlève les addition dans les CreateRectRgn
et tu peux remettre le backcolor du userform en gris normal (c'etait juste pour que vous voyez la différence entre decouper et masquer comme dans le xlam
la il y a plus de soucis a savoir positionner c'est découpé et c'est tout

 

[nullosse]

je viens d'essayer en zoom 100% et 125% le mieux pour le décalage en x c'est 60 * WindowsZoom , le bouton est complétement caché dans les deux cas

 

[patricktoulon]

oui j'avais prevus le "*Windowszoom justement pour toi qui est en 125%
du coup maintenant que c'est sur je peux le debloquer chez moi aussi puisque ca donne 1 pour moi
c'est parfait

 

[patricktoulon]

donc au final ca donne ça

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'Task pane Project  V3 en cours
Sub fermerWord()
    If Not wordxapp Is Nothing Then
        If wordxapp.Documents.Count > 0 Then
            wordxapp.Documents(1).Saved = True
            wordxapp.Documents(1).Close SaveChanges:=0
        End If
        Do While wordxapp.Documents.Count > 0: DoEvents: Loop
        wordxapp.Quit
        Set wordxapp = Nothing
    End If
    Unload UserForm1
    KillerTousLesWord
    T = AllPartExcelWindowList
    For I = 2 To UBound(T)
        If T(I, 2) = "XLDESK" Then Large = T(I, 7): Haut = T(I, 8)
        If T(I, 2) = "EXCEL7" Then He7 = CLngPtr(T(I, 1))
    Next
    SetWindowPos He7, 0, 0, 0, Large, Haut, 0
    'on teste si le dock xml  est ouvert ou pas et on l'ouvre si il ne l'ai pas
    If TypeName(ActiveWindow.RangeFromPoint(GetSystemMetrics(0) - 100, 300)) <> "Range" Then
        Application.CommandBars.ExecuteMso "XmlSource"
    End If
    DoEvents
    
End Sub



Sub test()
    If Not wordxapp Is Nothing Then Exit Sub
    Dim Hform As LongPtr, appHandle As LongPtr, He7 As LongPtr, XLDESK As LongPtr, HXML As LongPtr
    Dim hRgnGlobal As LongPtr, hRgnBouton As LongPtr, hRgnCaption As LongPtr
    Dim N$, T, I&, HauteurRgn1&, hauteurRgn2&
    
    Application.WindowState = xlMaximized
    DoEvents
    
    'hauteur de la barre de tire
    hauteurRng1 = GetSystemMetrics(30) '* WindowsZoom
    
    'hauteur  de la fenêtre jusqu'au bas du bouton fichier
    hauteurRgn2 = GetSystemMetrics(54) + GetSystemMetrics(30) '* WindowsZoom
    
    
    If Val(Application.Version) > 15 Then hauteurRng1 = hauteurRng1 + hauteurRng2: hauteurRng2 = hauteurRng1
    
    'on teste si le dock xml  est ouvert ou pas et on l'ouvre si il ne l'ai pas
    X = (Application.left + Application.Width - 100) / PpX
    Y = ((Application.top + CommandBars("ribbon").Height) / PpX) + 100
    
    If TypeName(ActiveWindow.RangeFromPoint(X, Y)) = "Range" Then
        Application.CommandBars.ExecuteMso "XmlSource"
    End If
    DoEvents
    T = AllPartExcelWindowList
    For I = 1 To UBound(T)
        If T(I, 2) = "EXCEL7" Then
            He7 = CLngPtr(T(I, 1))
            hauteur = T(I, 8)
            largeur = GetSystemMetrics(0) / 2
        End If
        If T(I, 2) = "XLDESK" Then XLDESK = CLngPtr(T(I, 1))
        If T(I, 2) = "bosa_sdm_XL9" Then HXML = CLngPtr(T(I - 2, 1))
        
    Next
    
    With UserForm1
        .Show 0
        Hform = GetActiveWindow
        SetWindowLong Hform, -16, &H16000000
        .Width = largeur * PpX
        .Height = hauteur * PpX
        .top = CommandBars("ribbon").Height - 5
        .left = 3000 '(GetSystemMetrics(0) / 2) * PpX
    End With
    SetWindowLong Hform, -16, &H16000000 'on retire le dwm et le gwborde et le Hcaption
    
    
    fichier = Application.GetOpenFilename("Doc(Word) Files (*.doc*), *.doc*", 1, "ouvrir un fichier")
    If fichier = "Faux" Then Exit Sub
    
    '                   ICI ON VA OUVRIR fenêtre  WORD
    Set wordxapp = CreateObject("word.application")
    With wordxapp
        .Visible = True
        .Documents.Open fichier
        'même taille que le userform
        .Width = UserForm1.Width
        .Height = UserForm1.Height
        
        N = Split(Mid(fichier, InStrRev(fichier, "\") + 1), ".")(0)
        appHandle = GetWinHandle("OpusApp", N, 10)
        
        SetWindowLong appHandle, -16, &H16000000 'on retire le dwm et le gwborde et le Hcaption
        
        SetParent appHandle, Hform 'papa dans maman
        SetWindowPos appHandle, 0, 0, -hauteurRng1, .Width / PpX, (.Height / PpX) + hauteurRng1, 0 'positionne word en left et top 0
        
        '                  DECOUPAGE DE LA FENETRE
        
        'Crée la région entiere de la fenêtre
        hRgnGlobal = CreateRectRgn(0, 0, .Width / PpX, .Height / PpX)
        'on retire la région de la barre de titre  à la région globale(methode RGN_DIFF pour exclure)
        CombineRgn hRgnGlobal, hRgnGlobal, hRgnCaption, RGN_DIFF
        
        'Crée la région entiere de la barre de titre
        hRgnCaption = CreateRectRgn(0, 0, .Width / PpX, HauteurRgn1)
        
        'Crée la région du bouton à masquer
        hRgnBouton = CreateRectRgn(0, 0, 60 * WindowsZoom, hauteurRgn2)
        'on retire la région du bouton à la région globale(methode RGN_DIFF pour exclure)
        CombineRgn hRgnGlobal, hRgnGlobal, hRgnBouton, RGN_DIFF
        
        
        
    End With
    
    'Applique LE DECOUPAGE DE la région à la fenêtre WORD
    SetWindowRgn appHandle, hRgnGlobal, True
    
    '/////////////////////////////////////////////////////////////////////
    'IL NE VOUS RESTE PLUS QU A LA DOCKER DANS EXCEL7
    'exemple
    'SetWindowPos Hform, -1, largeur, 0, largeur, hauteur, 0
    'SetParent Hform, XLDESK
    'SetWindowPos He7, 0, 0, 0, largeur, hauteur, 0
    
    'ou
    'LA DOCKER DANS LE VOLET XMLSOURCE
    'DoEvents
    SetParent Hform, HXML
    SetWindowPos Hform, 0, 5, 0, largeur - 5, hauteur, 0
    '//////////////////////////////////////////////////////////////
    Cells(2, 1).Resize(200, 9) = T
End Sub

 

[nullosse]

Aie ! La commande de la mort dans la fenêtre word : ALT+F

 

[Dudu2]

Coté version XLDESK7 de mon parcours solitaire, j'ai amélioré le classeur du Post #165 en plaçant le monitoring en classe ce qui évite d'avoir le désagrément du curseur qui clignote lors des relances par SetTimer ou Application.Ontime. De plus, la génération de clics souris en basculement Excel <-> Document évite le handicap du double clic (Activation + Clic).

vous avez vu que j'ai trouvé une astuce imparable pour détecter si le volet xml est ouvert ou non ?

Il suffit de tester:

Application.CommandBars("XML Source").Visible

J'attends un nouveau fichier de @patricktoulon pour le tester.

Edit: Pour info, l'échelle de l'affichage est obtenue avec l'API GetDpiForWindow()

'----------------
'Scale of display
'----------------
Function DisplayScale() As Double
    With Application
        DisplayScale = GetDpiForWindow(.hWnd) / 96
    End With
End Function

 

[patricktoulon]

non @Dudu2 ca ne fonctionne pas chez moi ça de même que le left -10000
je n'ai que la lecture de certains trucs de dispo et encore pas tout car on code commandbars mais en fait c'est un volet ou pane en anglais
mais pour rétrocompatibilité on gère un minimum par la collection commandbars
Après ça diffère un peu selon les versions va savoir toi ;en tout ,ca je me suis battu avec chatgpt , claude et copilot pour trouver une solution
aucun des 3 n'a penser au rangefrompoint ca m'a frapper hier soir en fait LOL

pour ton petit désagrément tu sais que tu peux classer dans le userform puisque il ne sert a rien si ce n'est que plaque host a moins que tu l'ai fait sans userform

 

[Dudu2]

tu sais que tu peux classer dans le userform puisque il ne sert a rien si ce n'est que plaque host a moins que tu l'ai fait sans userform

Oui je sais, un UserForm c'est une Classe. mais je travaille sans emballage pour document.

 

[Dudu2]

Bonjour @patricktoulon, @nullosse,
Plus de nouvelle proposition ? Abandon ?

 

[nullosse]

Bonjour @patricktoulon, @nullosse,
Plus de nouvelle proposition ? Abandon ?

Salut,
moi j'ai jeté l'éponge concernant la solution avec le volet ou même l'attachement à la fenêtre XLDESK, car rien ne garantit qu'il n'y aura pas de plantage de la fenêtre qui se trouve dedans ceci surtout pour Word.
Nullosse