XL 2019 Désactiver la barre de titre d'un userform 64bits

[akni]

Bonjour Tout le monde,

j'ai un code qui supprime la barre de titre des userform mais il ne marche pas dans la version 64bits

Merci pour toute aide.

 

[Simply]

Declaring API functions for 64 bit Office (and Mac Office)

JKP Application Development Services, Microsoft Office Application Development

jkp-ads.com

 

[Usine à gaz]

Bonjour à toutes et à tous,
@ akni : tu nous copie ton code ?
lionel,

 

[Phil69970]

Bonjour @akni

Je te propose ceci...

Et n'oublie pas de passer le post en résolu si c'est bon

@Phil69970

 

[akni]

Bonjour à toutes et à tous,
@ akni : tu nous copie ton code ?
lionel,

Bonjour lionel,
tout d'abord merci, j'ai pu trouver ce code et ça marche

Private Declare PtrSafe Function FindWindowA Lib "User32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function GetWindowLongA Lib "User32" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare PtrSafe Function SetWindowLongA Lib "User32" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Sub UserForm_Activate()
Dim hWnd As Long, exLong As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hWnd, -16)
If exLong And &H880000 Then
SetWindowLongA hWnd, -16, exLong And &HFF77FFFF
Me.Hide: Me.Show
End If
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub

 

[akni]

Bonjour Tout le monde,

j'ai un code qui supprime la barre de titre des userform mais il ne marche pas dans la version 64bits

Merci pour toute aide.

Bonjour Tout le monde,

j'ai un code qui supprime la barre de titre des userform mais il ne marche pas dans la version 64bits

Merci pour toute aide.

Merci tout le monde
problème résolu

 

[patricktoulon]

Salut
déjà ça m’étonnerait que tes déclarations même avec ptrsafe fonctionne correctement sur 64bits

sinon je te propose de ne plus te soucier de ta version d'excel

'**********************************************************************************************
'      supprimer le cadre et la barre de titre du Userform
'auteur :patricktoulon
'**********************************************************************************************

'EXEMPLE
Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Activate()
   Dim hwnd&,H&
    H = Me.InsideHeight
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'api GetActiveWindow
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94080080 & ")")      'api SetWindowLongA
    ExecuteExcel4Macro ("CALL(""user32"",""DrawMenuBar"",""JJJJJJ"", " & hwnd & ")")
Me.Height = H + 4
End Sub

 

[Compte Supprimé 979]

Salut
déjà ça m’étonnerait que tes déclarations même avec ptrsafe fonctionne correctement sur 64bits

Bonjour Patrick

Je puis te l'assurer, le code que j'ai donné sur l'autre forum et qu'il a mis ici, fonctionne sur la version 64bits

Bon il a viré la compilation conditionnelle, il sera emm*rdé s'il veut l'utiliser sur une autre version

 

[patricktoulon]

Bonjour bruno

pour 64 bits c'est LongPtr et non Long pour les contextx(HDC) et handles

Private Declare PtrSafe Function FindWindowA Lib "User32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function GetWindowLongA Lib "User32" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function SetWindowLongA Lib "User32" _
(ByVal hWnd As LongPtr, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As LongPtr

ptrsafe à partir de VB7 qui commence a partir de 2013 meme en 32 bits
long 32 bits / longPtr 64 bits

 

[Compte Supprimé 979]

Patrick

On est absolument pas obligé dans ce contexte je suis d'accord ce n'est pas très clean, mais ça fonctionne

D'ailleurs, j'en suis navré, mais ça ne semble pas fonctionner avec ton code

@+

 

[patricktoulon]

re
re
et bien sur que ça ne peut fonctionner ta condition n'est pas bonne
vous confondez VB7 et win64
chez moi par exemple 2013 32 bit je suis bien en vb7 mais win 32
d'ailleurs ptrsafe ou pas avec long (tout court) chez moi ça fonctionne
j'ai aussi peut être oublié un "Ptr" quelque part
mais comme tu le dis c'est pas clean
et en plus tu me fait un findwindow dans un initialise ???????
c'est dans le activate que l'on peut faire un findwindow
dans le initialise c'est la classe userform qui s’instancie pas l'object FORM donc le formulaire n'est toujours pas affiché
en tout cas c'est comme ça que ça devrait fonctionner

Après sincèrement il y a un bon moment déjà que je ne déclare plus les fonction User32 dans mes fichiers
j'utilise ma méthode avec les macro4 comme ça je n'ai pas de soucis sur aucun PCs

mais bon
essaie plutot celle là avec des déclarations dignes de ce nom
et dis moi le message que tu a

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe  Function  DrawMenuBar Lib "User32" (ByVal hWnd As LongPtr) As Long
        Const ver As String = "version 64 en VB7"
    #Else
        Const ver As String = "version 32 en VB7"
        Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
    #End If
#Else
    Const ver As String = "version 32 en VB6"
    Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
#End If

Private Sub UserForm_Activate()
    Dim hWnd As Long, exLong As Long
    hWnd = FindWindow(vbNullString, Me.Caption)
    exLong = GetWindowLong(hWnd, -16)
    If exLong And &H880000 Then
        SetWindowLong hWnd, -16, exLong And &HFF77FFFF
        DrawMenuBar hWnd
        Me.Hide: Me.Show
    End If
    MsgBox ver
End Sub
Private Sub CommandButton1_Click()
    Unload Me
End Sub

voilà le mien

 

[Phil69970]

Re

@akni

Décidément ça doit être ma semaine transparente et invisible....


@Phil69970

 

[patricktoulon]

Bonjour @Phil69970

oui avec le rectangle j'ai vu
mais je pige pas le besoins de setwindowpos dans ce cas car setwindowlong fait déjà le boulot

alors oui peut être qu'avec ta version ça marche mais comme je disais plus haut c'est pas clean
car si ça fonctionne avec ces deux api tu risque de te heurter a un mur avec d'autre api
autant les déclarer en bon et due forme
en l’occurrence ici 3 déclarations
à noter que je re capte pas le style de départ j'applique un long direct avec SetWindowLong

#If VBA7 Then
    #If Win64 Then    'vba7 et 64 bits
        Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Const ver$ = "version 64 bits en VBA7"
    #Else    'vba7 et 32 bits
        Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Const ver$ = "version 32 bits en VBA7"
    #End If
#Else    'vba6 et 32 bits
    Const ver$ = "version 32 bits en VBA6"
    Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Activate()
    Dim Hwnd&
    Hwnd = FindWindowA(vbNullString, Me.Caption)
    SetWindowLong Hwnd, -16, &H94080080
    ' pour ne pas utiliser l'api "DrawMenuBar"et remettre la partie visible de l'usf a la meme dimention que son inside de depart
    .Height = Me.Height - (Me.Height - Me.InsideHeight) + (Me.Width - Me.InsideWidth)
    MsgBox ver
End Sub

voila pourquoi je ne m'ennuie plus avec ça et je passe par les macro4 histoire de me simplifier la vie et d'avoir une compatibilité 100% avec toute version d'excel

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Activate()
 Dim hwnd&
    H = Me.InsideHeight
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")         'api GetActiveWindow
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94080080 & ")")      'api SetWindowLongA
   Me.Height = Me.Height - (Me.Height - Me.InsideHeight) + (Me.Width - Me.InsideWidth)

End Sub

 

[akni]

Bonjour tout le monde,

Merci pour toutes vos réponses ils m'ont été très utiles et m'ont aidé à résoudre mon problème

Problème Résolu.