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 ?

 

[Dudu2]

Donc tu n'a pas adopté le dock userform Host

Non. J'utilise un système simple qui fonctionne bien. J'en reste là.

 

[nullosse]

Bon j'ai une nouvelle piste : Utiliser un volet existant comme conteneur par exemple le volet Source XML . Pour le faire apparaître :

Application.CommandBars("XML Source").Visible = True

Et voilà ce qu'on peut faire avec :

 

[patricktoulon]

@nullosse comment met tu word dans l'onglet source ?

 

[patricktoulon]

j'ai trouvé tous les handle de ce volet

 

[nullosse]

@nullosse comment met tu word dans l'onglet source ?

Ben je fais comme toi : je mets word dans un userform et c'est le userform que je mets dans le volet par un setParent. Il faut trouver la fenêtre du volet dans les éléments fils d'Excel. Moi j'ai repéré un volet qui a comme nom de classe : bosa_sdm_XL9 pas sûr que cela soit la même sur toutes les versions d'Excel. Quand on clique sur la croix du volet cela ne le détruit pas , cela le masque, si on le refait apparaître il y a toujours ce qu'on a mis dedans
[EDIT] tu as le même nom de classe

 

[nullosse]

Attention en fait il faut utiliser la commande :

Application.CommandBars.ExecuteMso "XmlSource"

pour créer et ouvrir le volet source xml

 

[patricktoulon]

ben si tu prends la fenetre de xlsource tu n'a plus besoins de userform non? 😉
ok j'ai la commande pour l'ouvrir maintenant il faut que je trouve l'enlarge midle moitié/ motié
oui je sais pour la commande je l'ai trouvé dans mon creatorRibbonx
j'ai testé sans userform et visiblement on gagne pas le focus donc usf obligatoire
par contre je n'ai pas trouver comment l'agrandir tout seul si il ne l'ai pas

 

[patricktoulon]

pour le moment j'en suis là avec cette version si tu a garder mon module api fonction tu a tout ;;

Sub OuvrirVoletWord_V_4()
    Dim Hdock As LongPtr, Hword As LongPtr, I&, Haut&, T, N$
    ' Ouvrir le panneau
    
    fermetureVoletWord_v_4
    
    'ouverture du paneau source
    'on teste si le window est la
    T = AllPartExcelWindowList
    For I = 2 To UBound(T)
        If T(I, 2) = "bosa_sdm_XL9" Then
            Hdock = CLngPtr(T(I - 2, 1))
            Haut = T(I, 8)
            Exit For
        End If
    Next
   ' sil n'est pas là
   If Hdock = 0 Then
        Application.CommandBars.ExecuteMso "XmlSource"
        
        T = AllPartExcelWindowList
        For I = 2 To UBound(T)
            If T(I, 2) = "bosa_sdm_XL9" Then
                Hdock = CLngPtr(T(I - 2, 1))
                Haut = T(I, 8)
                Exit For
            End If
        Next
    End If
    
    ' Ouvre le fichier Word
    fichier = Application.GetOpenFilename("Word Files (*.doc*), *.doc*", 1, "Ouvrir un fichier")
    If fichier = False Then Exit Sub
    
    Set wordxapp = CreateObject("Word.Application")
    wordxapp.Visible = True
    wordxapp.Documents.Open fichier
    DoEvents
    N = Split(Mid(fichier, InStrRev(fichier, "\") + 1), ".")(0)
    
    ' Ici tu utilises ta fonction GetWinHandle
    Hword = GetWinHandle("OpusApp", N, 10)
    SetParent Hword, Hdock
    SetWindowPos Hword, 4, 0, 0, (Application.Width / 2) / 0.75, Haut, 0
    DoEvents
    
End Sub
Sub fermetureVoletWord_v_4()
   Dim T, I&
   'fermeture du document word si il y en a déja un
    T = AllPartExcelWindowList
    For I = 2 To UBound(T)
        If T(I, 2) = "OpusApp" Then
            ' Application.CommandBars.ExecuteMso "XmlSource"
            On Error Resume Next
            If Not wordxapp Is Nothing Then
                wordxapp.document.Close
                wordxapp.Quit
                On Error GoTo 0
            End If
        End If
    Next
    Application.CommandBars.ExecuteMso "XmlSource"
End Sub

 

[patricktoulon]

testé avec le userform host on reprend pas le focus donc c'est mort avec cette méthode
cela dit elle devrait plaire a @Dudu2
elle est pas si mal
avec le userform

Sub OuvrirVoletWord_V_4()
    Dim Hdock As LongPtr, Hword As LongPtr, I&, Haut&, T, N$
    ' Ouvrir le panneau
    
    fermetureVoletWord_v_4
    
    'ouverture du paneau source
    'on teste si le window est la
    T = AllPartExcelWindowList
    For I = 2 To UBound(T)
        If T(I, 2) = "bosa_sdm_XL9" Then
            Hdock = CLngPtr(T(I - 2, 1))
            Haut = T(I, 8)
            Exit For
        End If
    Next
   ' sil n'est pas là
   If Hdock = 0 Then
        Application.CommandBars.ExecuteMso "XmlSource"
        
        T = AllPartExcelWindowList
        For I = 2 To UBound(T)
            If T(I, 2) = "bosa_sdm_XL9" Then
                Hdock = CLngPtr(T(I - 2, 1))
                Haut = T(I, 8)
                Exit For
            End If
        Next
    End If
    
    ' Ouvre le fichier Word
    fichier = Application.GetOpenFilename("Word Files (*.doc*), *.doc*", 1, "Ouvrir un fichier")
    If fichier = False Then Exit Sub
    
    Set wordxapp = CreateObject("Word.Application")
    wordxapp.Visible = True
    wordxapp.Documents.Open fichier
    DoEvents
    N = Split(Mid(fichier, InStrRev(fichier, "\") + 1), ".")(0)
    
    ' Ici tu utilises ta fonction GetWinHandle
    Hword = GetWinHandle("OpusApp", N, 10)
     DoEvents
  
     plaque.Show 0
    DoEvents
    AppForm = GetActiveWindow
    SetWindowLong AppForm, -16, &H16000000 'checkbox on vire la caption
 
    
    
    SetParent AppForm, Hdock
    
    SetWindowPos AppForm, 0, 0, 0, (Application.Width / 2) / 0.75, Haut, 0
    DoEvents
    SetParent Hword, AppForm
    
    SetWindowPos Hword, 0, 0, 0, (Application.Width / 2) / 0.75, Haut, 0
  
End Sub
Sub fermetureVoletWord_v_4()
   Dim T, I&
   'fermeture du document word si il y en a déja un
    T = AllPartExcelWindowList
    For I = 2 To UBound(T)
        If T(I, 2) = "OpusApp" Then
            ' Application.CommandBars.ExecuteMso "XmlSource"
            On Error Resume Next
            If Not wordxapp Is Nothing Then
                wordxapp.document.Close
                wordxapp.Quit
                On Error GoTo 0
            End If
        End If
    Next
    Application.CommandBars.ExecuteMso "XmlSource"
Unload plaque
End Sub

pareil si vous avez garder mon module api_fonction vous avez tout

 

[patricktoulon]

Bonjour @nullosse , @Dudu2
la version avec le volet sourcexml reconditionné
j'ai fais un onglet dans le ruban

et si vous mettez les 4 constantes à true dans le module callback
vous aurez deux boutons supplémentaire dans chaque sections
vous pouvez mettre le texte de bouton que vous voulez en changeant les 4 constantes qui suivent

les constante à modifier

Const BtWebviSible1 As Boolean = False
Const BtWebviSible2 As Boolean = False
Const BtAppviSible1 As Boolean = False
Const BtAppviSible2 As Boolean = False

Const BtWebLabel1 As String = "Bt web Libre1"
Const BtWebLabel2 As String = "Bt web Libre2"
Const BtAppLabel1 As String = "Bt App Libre1"
Const BtAppLabel2 As String = "Bt App Libre2"

il ne vous reste plus qu'a coder l'action que vous voulez faire avec dans leur événement click respectif dans le module callback


pour word je suis allé un peu plus loin pour le problème du bouton Fichier
en effet je le masque tout simplement avec une fenêtre créée dynamiquement et inséré dans le handle du ruban en first plan
j'ai adapter une version de ma fonction qui liste les composante d'Excel pour word pour ça ce qui me permet de sélectionner le bon handle du ruban pour y affilier la fenêtre dynamique
il vous sera donc impossible de cliquer sur ce bouton

Conclusion pour cette version avec volet source xml

je reconnais que c'est assez séduisant mais l'astuce du userform host ne fonctionne pas ici
donc adaptez la méthode de @dudu2 je sais pas trop comment il fait
malgré ce petit détail ergonomique c'est un compromis simple à mettre en place

Nb: peux être sauvé directement en xlam

 

[nullosse]

Salut Patrick Toulon,
Conclusion pour cette version avec volet source xml

je reconnais que c'est assez séduisant mais l'astuce du userform host ne fonctionne pas ici
donc adaptez la méthode de @dudu2 je sais pas trop comment il fait
malgré ce petit détail ergonomique c'est un compromis simple à mettre en place

Heu je sais pas si j'ai bien compris mais tu fais un Unload apropos avant de vouloir utiliser le userform host cela va marcher beaucoup moins bien,
D'autre part tu ne mets pas ton userform dans la bonne fenêtre : il faut prendre le parent de bosa . On peut alors "slider" le volet. On peut aussi cacher les controles qui se trouvent dans le bosa. Voici ton code modifié au début pour gérer cela :

Sub OuvrirVoletWord_V_4()
    Dim Hdock As LongPtr, Hword As LongPtr, HForm As LongPtr, HRibbon As LongPtr, I&, Haut&, t, N$, Fichier$
    Dim HwnDmask As LongPtr, Hbosa As LongPtr
    If TaskPaneUsed Then MsgBox "Fermez le volet actuel ": Exit Sub
    ' Ouvrir le panneau
    fermetureVolet_v_4
    'ouverture du paneau source
    'on teste si le window est la
    t = AllPartExcelWindowList
    For I = 2 To UBound(t)
        If t(I, 2) = "bosa_sdm_XL9" Then
            Hbosa = CLngPtr(t(I, 1))
            Haut = t(I, 8)
            Exit For
        End If
    Next
    ' sil n'est pas là
    If Hbosa = 0 Then
        Application.CommandBars.ExecuteMso "XmlSource"
       
        t = AllPartExcelWindowList
        For I = 2 To UBound(t)
            If t(I, 2) = "bosa_sdm_XL9" Then
                Hbosa = CLngPtr(t(I, 1))
                Haut = t(I, 8)
                Exit For
            End If
        Next
    End If
    ShowWindow Hbosa, SW_HIDE
    Hdock = GetParent(Hbosa)
    apropos.Show 0
    HForm = GetActiveWindow
    SetParent HForm, Hdock
    SetWindowPos HForm, 0, 5, 0, (Application.Width / 2) / 0.75, Haut, 0

Ne pas oublier de mettre derrière le unload en commentaire.

On pourra aussi faire un système de monitoring qui réajuste les fenêtres à l'intérieur du volet .

Nullosse

 

[patricktoulon]

re
Bonjour @nullosse
non c'est volontaire le parent je veux rien de xml quand c'est le perso
le userform n'est plus un host seulement une présentation
le userform en host ne servirait a rien (j'ai testé) ne permet d'avoir le full focus
donc résultat quand on change de fenêtre ,on est obligé de cliquer une fois pour prendre le focus et une autre pouyr faire ce qu'est sensé faire le click donc je ne l'ai pas mis en host
mais si tu y tiens au slide tout en gardant la grand-mère de la bosa_sdm_XL9 il te suffit de supprimer ce menu sytem de la fenêtre word (ou autre)
et le seul slide possible sera bien le volet c'est pas compliqué

et là on voit toujours rien du volet xml original

mais si tu y tiens voila la même avec l app dans le userform et le slide fonctionnel
ps ; j'ai ajouré un bouton pour les xml et html local(perso je m'en sert beaucoup de ces deux là

 

[nullosse]

OK mais quand on est en Mise en échelle 125 % , on voit les contrôles du volet XML source à droite et aussi en bas. C'est à cela que sert mon :

 ShowWindow Hbosa, SW_HIDE

A cacher les contrôles du volet au cas où.
Il y a aussi le cache fichier qui est trop haut chez moi meme en mise à l'échelle 100% , il ne cache pas l'onglet Fichier

 

[patricktoulon]

a h ok je corrige ca c'est trois fois rien

 

[patricktoulon]

@nullosse
voila il fallait simplement remplacer tout les 0.75(qui est coeff pointpixel pour dpi 100%) par ma petite fonction fonction PpX