Userform ohne Titelleiste 32 & 64Bit

[Crazy Tom]

moin,

ich nutze einen Code wie in der beiliegenden Datei
um eine Userform ohne Titelleiste zu erzeugen
ich weiß zum verrecken nicht mehr wo ich den Code gefunden habe, meine aber er wäre von Volti

Code:

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

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 DrawMenuBar Lib "user32" ( _
   ByVal hwnd As Long) As Long

'Function fncHasUserformCaption(bState As Boolean)
'   Dim Userform_hWnd As Long
'   Dim Userform_Style As Long
'   Dim Userform_Rect As RECT
'   Const GWL_STYLE = (-16)
'   Const WS_CAPTION = &HC00000
'   Userform_hWnd = FindWindow( _
'      lpClassName:=IIf(Val(Application.Version) > 8, _
'      "ThunderDFrame", "ThunderXFrame"), _
'      lpWindowName:=UserForm1.Caption) '<----Userform Name
'   Userform_Style = GetWindowLong(hwnd:=Userform_hWnd, _
'      nIndex:=GWL_STYLE)
'   If bState = True Then
'      Userform_Style = Userform_Style Or WS_CAPTION
'   Else
'      Userform_Style = Userform_Style And Not WS_CAPTION
'   End If
'   Call SetWindowLong(hwnd:=Userform_hWnd, nIndex:=GWL_STYLE, _
'      dwNewLong:=Userform_Style)
'   Call DrawMenuBar(hwnd:=Userform_hWnd)
'End Function

der Rechner den ich zur Verfügung habe hat Office365 32Bit bei WIN10 64Bit und dort funktioniert es einwandfrei
die Dateien die ich erstellt habe werden aber auch von anderen bearbeitet
und wie ich grade feststellen musste sind verschiedene Rechner mit Office365 64Bit und WIN10 64Bit ausgerüstet
und dort bricht der Code sofort ab bei  

Private Declare Function...

und verlangt die Konvertierung zu 64Bit
wovon ich nicht die geringste Ahnung habe

kann mir da jemand behilflich sein, den Code so abzuändern, dass er sowohl unter 32 als auch unter 64Bit läuft

mfg Tom


  Form ohne Leiste.xlsb (Größe: 20,73 KB / Downloads: 0)

[OnlineExcel]

moin,

ich nutze einen Code wie in der beiliegenden Datei
um eine Userform ohne Titelleiste zu erzeugen
ich weiß zum verrecken nicht mehr wo ich den Code gefunden habe, meine aber er wäre von Volti

Code:

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

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 DrawMenuBar Lib "user32" ( _
   ByVal hwnd As Long) As Long

'Function fncHasUserformCaption(bState As Boolean)
'   Dim Userform_hWnd As Long
'   Dim Userform_Style As Long
'   Dim Userform_Rect As RECT
'   Const GWL_STYLE = (-16)
'   Const WS_CAPTION = &HC00000
'   Userform_hWnd = FindWindow( _
'      lpClassName:=IIf(Val(Application.Version) > 8, _
'      "ThunderDFrame", "ThunderXFrame"), _
'      lpWindowName:=UserForm1.Caption) '<----Userform Name
'   Userform_Style = GetWindowLong(hwnd:=Userform_hWnd, _
'      nIndex:=GWL_STYLE)
'   If bState = True Then
'      Userform_Style = Userform_Style Or WS_CAPTION
'   Else
'      Userform_Style = Userform_Style And Not WS_CAPTION
'   End If
'   Call SetWindowLong(hwnd:=Userform_hWnd, nIndex:=GWL_STYLE, _
'      dwNewLong:=Userform_Style)
'   Call DrawMenuBar(hwnd:=Userform_hWnd)
'End Function

der Rechner den ich zur Verfügung habe hat Office365 32Bit bei WIN10 64Bit und dort funktioniert es einwandfrei
die Dateien die ich erstellt habe werden aber auch von anderen bearbeitet
und wie ich grade feststellen musste sind verschiedene Rechner mit Office365 64Bit und WIN10 64Bit ausgerüstet
und dort bricht der Code sofort ab bei  

Private Declare Function...

und verlangt die Konvertierung zu 64Bit
wovon ich nicht die geringste Ahnung habe

kann mir da jemand behilflich sein, den Code so abzuändern, dass er sowohl unter 32 als auch unter 64Bit läuft

mfg Tom

Du musst die Apis anpassen:
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" ( _
    ByVal hwnd As LongPtr, _
    ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" ( _
    ByVal hwnd As LongPtr, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As LongPtr) As LongPtr

Private Declare PtrSafe Function DrawMenuBar Lib "user32" ( _
    ByVal hwnd As LongPtr) As Long

gegebenenfalls noch die handles (hwnd) auf LongPtr und Aufrufwerte aber das bekommst du dann schon hin.

Dies läuft sowohl au 32 als auch 64 bit offcie unterscheidungen mit VBA7 muss man nicht mehr treffen, denn wer noch Excel2007 benutzt lebt eh hinterm Mond

Gruß P

[Crazy Tom]

Hallo Peter,

vielen Dank für deine Hilfe
nach einigen Anpassungen (Schweißabputz) hab ich es unter 64bit ans laufen gebracht
jedoch lief es dann unter 32bit nicht mehr
so dass ich dann doch noch die Unterscheidung gemacht habe


  Form ohne Leiste.xlsb (Größe: 18,63 KB / Downloads: 3)

mfg Tom

[Egon12]

Hallo,

ändere so:

Code:

#If VBA7 Then
    Dim Userform_hWnd As LongPtr
    Dim Userform_Style As LongPtr
#Else
    Dim Userform_hWnd As Long
    Dim Userform_Style As Long
#End If

Gruß Uwe

---

2 API Funktionen müssen auf Win64 geprüft werden:

Code:

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
   
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" ( _
            ByVal hwnd As LongPtr, _
            ByVal nIndex As Long) As LongPtr
        
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" ( _
            ByVal hwnd As LongPtr, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As LongPtr) As LongPtr
    #else
        Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" ( _
            ByVal hwnd As LongPtr, _
            ByVal nIndex As Long) As LongPtr
        Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" ( _
            ByVal hwnd As LongPtr, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As LongPtr) As LongPtr
    #end if
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" ( _
        ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
       ByVal lpClassName As String, _
       ByVal lpWindowName As String) As Long
   
    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 DrawMenuBar Lib "user32" ( _
       ByVal hwnd As Long) As Long
#End If

Gruß Uwe

[OnlineExcel]

hi,
es geht ohne Unterscheidung man muss nur die Apis etwas anpassen:
Option Explicit

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
   
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, _
        ByVal nIndex As Long) As Long
   
    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 DrawMenuBar Lib "user32" ( _
        ByVal hwnd As LongPtr) As Long


Function fncHasUserformCaption(bState As Boolean)
    Dim Userform_hWnd As LongPtr
   
    Dim Userform_Style As Long
    Dim Userform_Rect As RECT
    Const GWL_STYLE = (-16)
    Const WS_CAPTION = &HC00000

        Userform_hWnd = FindWindow( _
            lpClassName:=IIf(Val(Application.Version) > 8, _
            "ThunderDFrame", "ThunderXFrame"), _
            lpWindowName:=UserForm1.Caption) '<----Userform Name
        Userform_Style = GetWindowLong(hwnd:=Userform_hWnd, _
            nIndex:=GWL_STYLE)
        If bState = True Then
            Userform_Style = Userform_Style Or WS_CAPTION
        Else
            Userform_Style = Userform_Style And Not WS_CAPTION
        End If
        Call SetWindowLong(hwnd:=Userform_hWnd, nIndex:=GWL_STYLE, _
            dwNewLong:=Userform_Style)
        Call DrawMenuBar(hwnd:=Userform_hWnd)

   
End Function

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Call fncHasUserformCaption(False)
End Sub

[Crazy Tom]

Hallo Peter,

das passt perfekt

Hallo Uwe

deinen Code hab ich nicht ans laufen gebracht
es meckerte bei

Code:

Userform_Style = GetWindowLong(hwnd:=Userform_hWnd, _
'      nIndex:=GWL_STYLE)

dass die Funktion GetWindowLong nicht bekannt ist

mfg Tom

[Egon12]

Hallo Tom,

Teste mal.

  Form ohne Leiste.xlsb (Größe: 21,89 KB / Downloads: 1)
Sollte das nicht laufen, wäre die Fehlerausgabe wichtig.
Es kann ja auch manchmal sein dass ich da was falsch zugeordnet habe.

Gruß Uwe

[Crazy Tom]

Hallo Uwe

in 64bit läuft es

in 32bit kommt als erstes der Fehler

   

schreib ich da jeweils ein Private davor
kommt dann bei der Funktion dieser Fehler

   

mfg Tom

[Egon12]

Hallo Tom,

das Private gehört dahin und hatte ich vergessen.

Im Userform das habe ich mir angeschaut kann man theoretisch noch die für beide Funktionen eine Win64 für die Abfrage einbauen.

Das dies praktikabler zu machen geht hast du ja schon. Da braucht es diesen Umbau und die damit verbundene Rückfragen nicht.

Gruß Uwe

[Crazy Tom]

da ich eine funktionierende Lösung habe,
setze ich das Thema als erledigt
und danke an Uwe und Peter

mfg Tom