Userform ohne Titelleiste

Guten Abend,
ich habe eine Datei gefunden (ausForum), da wird die UF ohne
Rahmen dargestellt.
Nun weiß ich nicht, was ich ändern muss um die UF in die Richtige
Position zu bringen.
Ich möchte gern das die UF genau passend in meine Zeile1 eingepaßt
wird und sich dann nicht verschiebt.
Anbei das Makro, welches dazu gehört.
mfg
philipp
Option Explicit
' Userform mit einem CommandButton (CoEnde), um die Userform
' zu schließen. Mit rechtsklick auf die Maus in der Userform
' wird diese ebenfalls geschlossen. Abschnitt:
' UserForm_MouseDown zum Schließen, dieser Teil ist auskommentiert
' von GraFri
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As _
Long, lpRect As RECT) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private FensterRegion&, Region&
Private Hauptfensternummer&, Clientfensternummer&
Private dummy As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const GW_CHILD = 5
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Private Sub UserForm_Initialize()
Call FensterOhneKopf
End Sub

Sub FensterOhneKopf()
Dim Abmessung As RECT
Dim Abmessung1 As RECT
Dim Pos1x&, Pos1y&, Pos2x&, Pos2y&
If FensterRegion 0 Then Exit Sub
UserForm1.BorderStyle = fmBorderStyleSingle
Call Fensternummer(UserForm1, Abmessung, Abmessung1)
Pos1x = 0
Pos1y = (Abmessung1.Top - Abmessung.Top)
Pos2x = Abmessung.Right - Abmessung.Left
Pos2y = Abmessung.Bottom - Abmessung.Top
Region = CreateRectRgn(Pos1x, Pos1y, Pos2x, Pos2y)
FensterRegion = SetWindowRgn(Hauptfensternummer, Region, True)
End Sub 'Fensterhandles und Infos über Fenster holen

Private Sub Fensternummer(Form As Object, Abmessung As RECT, Abmessung1 As RECT)
Dim Fenstername$, Suchstring$
Suchstring = "UserForm ohne Titelzeile"
Fenstername = Form.Caption
Form.Caption = Suchstring
Hauptfensternummer = FindWindow(vbNullString, Suchstring)
Form.Caption = Fenstername
Clientfensternummer = GetWindow(Hauptfensternummer, GW_CHILD)
dummy = GetWindowRect(Hauptfensternummer, Abmessung)
dummy = GetWindowRect(Clientfensternummer, Abmessung1)
End Sub

'Folgendes ist notwendig, um die Form ohne Titelleiste zu verschieben
'


Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
'ByVal X As Single, ByVal Y As Single)
'    If Button = 1 Then
'        If Hauptfensternummer  0 Then
'            dummy = ReleaseCapture()
'            dummy = SendMessage(Hauptfensternummer, WM_NCLBUTTONDOWN, HTCAPTION, 0)
'        End If
'    Else
'        Unload UserForm1 ' zum Schließen, beim Ausprobieren.
'    End If
'End Sub

Private Sub CoEnde_Click()
Unload Me
End Sub

Hallo Philipp,
teste mal:

Option Explicit

Private Declare Function FindWindowA Lib "user32.dll" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32.dll" ( _
    ByVal hWnd As Long) As Long
Private Declare Function SendMessageA Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function MoveWindow Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal bRepaint As Long) As Long
Private Declare Function IsThemeActive Lib "uxtheme.dll" () As Long

Private Const GC_CLASSNAMEMSUSERFORM As String = "ThunderDFrame"
Private Const GWL_STYLE As Long = -16&
Private Const WS_CAPTION As Long = &HC00000
Private Const HTCAPTION As Long = 2&
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const POINT_TO_PIXEL As Double = 0.75

Private mlngHwndForm As Long

Private Sub CommandButton1_Click()
    Call Unload(Object:=Me)
End Sub

Private Sub UserForm_Initialize()
    Dim lngStyle As Long
    mlngHwndForm = FindWindowA(GC_CLASSNAMEMSUSERFORM, Caption)
    lngStyle = GetWindowLongA(mlngHwndForm, GWL_STYLE)
    lngStyle = lngStyle And Not WS_CAPTION
    Call SetWindowLongA(mlngHwndForm, GWL_STYLE, lngStyle)
    Call DrawMenuBar(mlngHwndForm)
    If IsThemeActive = 1 Then
        Height = Height - 16
    Else
        Height = Height - 14
    End If
End Sub

Private Sub UserForm_Layout()
    Dim lngLeft As Long, lngTop As Long
    With ActiveSheet.Cells(1, 1)
        lngLeft = ActiveWindow.PointsToScreenPixelsX(.Left / POINT_TO_PIXEL)
        lngTop = ActiveWindow.PointsToScreenPixelsY(.Top / POINT_TO_PIXEL)
    End With
    Call MoveWindow(mlngHwndForm, lngLeft, lngTop, _
        Width / POINT_TO_PIXEL, Height / POINT_TO_PIXEL, 1)
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, _
        ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        Call ReleaseCapture
        Call SendMessageA(mlngHwndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

Gruß
Nepumuk

Forumthread: Userform ohne Titelleiste

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial