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

  • Initiateur de la discussion Initiateur de la discussion Dudu2
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Dudu2

XLDnaute Barbatruc
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 ?

1758617247578.png
 
sinon j'avais ça
VB:
Option Explicit
'patricktoulon
'Déclarations VBA7 en 32/64 bits
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long

' Fonction qui lance le PDF et renvoie le handle
Function OuvrirPDF_GetHandle() As LongPtr
    Dim cheminPDF As String
    Dim hwnd As LongPtr
    Dim sStr As String
    Dim tim As Double, a As Long
    
    OuvrirPDF_GetHandle = 0 ' valeur par défaut
    
    cheminPDF = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", 1, "Ouvrir un fichier")
    
    If cheminPDF = "Faux" Or Dir(cheminPDF) = "" Then
        MsgBox "Fichier PDF introuvable.", vbExclamation
        Exit Function
    End If
    
    ' Lance le PDF avec l'application par défaut
    Shell "explorer """ & cheminPDF & """", vbNormalFocus
    
    ' Recherche du handle
    sStr = Space$(512)
    tim = Timer
    a = 0
    Do While a < 10 And OuvrirPDF_GetHandle = 0
        a = a + 1
        hwnd = FindWindow(vbNullString, vbNullString)
        Do While hwnd <> 0 And Timer - tim < 10
            DoEvents
            GetWindowText hwnd, sStr, 512
            If Trim(sStr) Like "*" & Mid(cheminPDF, InStrRev(cheminPDF, "\") + 1) & "*" Then
                OuvrirPDF_GetHandle = hwnd
                Exit Do
            End If
            hwnd = GetWindow(hwnd, 2)
        Loop
    Loop
End Function

' Exemple de test
Sub testouille()
    Dim h As LongPtr
    h = OuvrirPDF_GetHandle
    MsgBox "Handle de la fenêtre PDF : " & h
End Sub
l'application par defaut dans ton system
 
Salut Dudu2,
A noter que si tu utilises Chrome comme navigateur tu peux utiliser sa visionneuse PDF comme avec Edge car il est du type Chromium :
VB:
    Shell "cmd /c start chrome --app=""" & pdfURL & """", vbHide ' Ouvre Chrome avec le PDF en mode app (fenêtre propre)


ChromeViewer.png



et pour patricktoulon que je salue ce code pour trouver la fenêtre du PDF fonctionne très bien chez moi en Excel 2021 Windows 11 :
VB:
            Dim partsPath, nomfenetre
            partsPath = Split(cheminPDF, "\")
            nomfenetre = partsPath(UBound(partsPath))
            Do
                hwnd = FindWindow("Chrome_WidgetWin_1", nomfenetre)
               ' Debug.Print hwnd
                DoEvents
                If Timer - t > 5 Then Exit Do ' Max 5 secondes
            Loop While hwnd = 0
Le nom affiché dans le haut de la fenêtre PDF est bien nomfenetre


Nullosse
 
Dernière édition:
Bonjour @nullosse,
Oui, c'est une idée. Je pense que Firefox est aussi basé sur Chromium.
J'utilise les 2, donc je vais tenter le coup avec ta commande Shell.

J'ai copié et adapté le code de @patricktoulon pour un lancement du programme par défaut pour le PDF (chez moi PDF XChange Viewer).
VB:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As Long
    Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Boolean
#Else
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Boolean
#End If

Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

'--------------------------------------------
'Get Window's Handle by Window's partial text
'--------------------------------------------
#If VBA7 Then
    Private Function GetWindowByPartialText(Text As String) As LongPtr
        Dim hWnd As LongPtr
#Else
    Private Function GetWindowByPartialText(Text As String) As Long
        Dim hWnd As Long
#End If
    Dim WindowText As String
    
    hWnd = GetDesktopWindow()
    hWnd = GetWindow(hWnd, GW_CHILD)
    
    Do While Not hWnd = 0
        If IsWindowVisible(hWnd) Then
             WindowText = String(GetWindowTextLength(hWnd) + 1, Chr$(0))
            Call GetWindowText(hWnd, WindowText, Len(WindowText))
            If InStr(UCase(WindowText), UCase(Text)) Then Exit Do
        End If

        hWnd = GetWindow(hWnd, GW_HWNDNEXT)
    Loop

    'Return value
    GetWindowByPartialText = hWnd
End Function

' Fonction qui lance le PDF et renvoie le handle
Function OuvrirPDF_GetHandle() As LongPtr
    Dim CheminPDF As Variant
    Dim NomPDF As String

    CheminPDF = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", 1, "Ouvrir un fichier")
    If VarType(CheminPDF) = vbBoolean Then Exit Function
    
    NomPDF = Mid(CheminPDF, InStrRev(CheminPDF, "\") + 1)
    NomPDF = Left(NomPDF, Len(NomPDF) - 4)
    
    ' Lance le PDF avec l'application par défaut
    Shell "explorer """ & CheminPDF & """", vbNormalFocus
    Sleep 500
    
    OuvrirPDF_GetHandle = GetWindowByPartialText(NomPDF)
End Function

' Exemple de test
Sub testouille()
    Dim h As LongPtr
    h = OuvrirPDF_GetHandle
    MsgBox "Handle de la fenêtre PDF : " & h
End Sub
 
Dernière édition:
Bonjour
@nullosse oui on peut faire plus simple que splitter et compter

VB:
Dim nomfenetre
              nomfenetre=mid(cheminPDF,instrRev(cheminPDF,"\")+1)
         
          Do
                hwnd = FindWindow("Chrome_WidgetWin_1", nomfenetre)
               ' Debug.Print hwnd
                DoEvents
                If Timer - t > 5 Then Exit Do ' Max 5 secondes
            Loop While hwnd = 0

@Dudu2
Bonjour à tous,
Je suis étonné que
VB:
hWnd = FindWindow(vbNullString, vbNullString)
retourne le même Handle que
Code:
hWnd = GetDesktopWindow
hWnd = GetWindow(hWnd, 5)
Est-ce vrai dans tous les cas ?
oui
il prends le premier de la liste qui est le getdesktopwindow
 
apres il faudrait se mettre d'accord su la methode d'ouverture
le shell explorer
ou le shell cmd
pour @dudu2(et chez moi ca marche aussi avec edge, firefox , bullzipPDF , adobe reader)
VB:
Option Explicit
'patricktoulon
'Déclarations VBA7 en 32/64 bits
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long

' Fonction qui lance le PDF et renvoie le handle
Function OuvrirPDF_GetHandle() As LongPtr
    Dim cheminPDF As String
    Dim hwnd As LongPtr
    Dim sStr As String
    Dim tim As Double, a As Long
    OuvrirPDF_GetHandle = 0 ' valeur par défaut
     cheminPDF = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", 1, "Ouvrir un fichier")
     If cheminPDF = "Faux" Or Dir(cheminPDF) = "" Then
        MsgBox "Fichier PDF introuvable.", vbExclamation
        Exit Function
    End If
    ' Lance le PDF avec l'application par défaut
    Shell "explorer """ & cheminPDF & """", vbNormalFocus
    ' Recherche du handle
    sStr = Space$(512)
    tim = Timer
    a = 0
    Do While a < 5 And OuvrirPDF_GetHandle = 0
        a = a + 1
        hwnd = FindWindow(vbNullString, vbNullString)
        Do While hwnd <> 0 And Timer - tim < 5
            DoEvents
            GetWindowText hwnd, sStr, 512
            If Trim(sStr) Like "*" & Split(Mid(cheminPDF, InStrRev(cheminPDF, "\") + 1), ".")(0) & "*" Then
                OuvrirPDF_GetHandle = hwnd
                Exit Do
            End If
            hwnd = GetWindow(hwnd, 2)
        Loop
    Loop
End Function

' Exemple de test
Sub testouille()
    Dim h As LongPtr
    h = OuvrirPDF_GetHandle
    MsgBox "Handle de la fenêtre PDF : " & h
End Sub
si vous me dites que ca marche chez vous je remplace dans le xla par celle ci et on en parles plus
 
apres il faudrait se mettre d'accord su la methode d'ouverture
si vous me dites que ca marche chez vous je remplace dans le xla par celle ci et on en parles plus
Avec ton code cela ne fonctionne pas chez moi la fenêtre s'ouvre avec le PDF mais comme le hwnd est à 0 il n'y a pas de positionnement et de redimension. Il doit y avoir un problème de timing dans la boucle car si je met une instruction debug.Print dedans le hwnd n'est plus à 0 et la boucle s'arrête avec l'affichage du nom du PDF :
Do While a < 5 And OuvrirPDF_GetHandle = 0
a = a + 1
hwnd = FindWindow(vbNullString, vbNullString)
Do While hwnd <> 0 And Timer - tim < 5
DoEvents
GetWindowText hwnd, sStr, 512
Debug.Print sStr
If Trim(sStr) Like "*" & Split(Mid(cheminPDF, InStrRev(cheminPDF, "\") + 1), ".")(0) & "*" Then
OuvrirPDF_GetHandle = hwnd
Exit Do
End If
hwnd = GetWindow(hwnd, 2)
Loop
Loop
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
9
Affichages
917
Réponses
0
Affichages
2 K
Retour