AW: UserForm in Tabellenblatt einbinden
03.09.2014 10:29:03
Rudi
Hallo,
frag mich nicht, wie das funktioniert. ;-)
'##### Modul: UserForm1 #####
'##### Typ: UserForm #####
Option Explicit
Dim objForm As clsUserForm
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Activate()
Set objForm = New clsUserForm
With objForm
.MaxButton = True
.MinButton = True
.BorderStyle = xlAenderbar
.Create UserForm1
Call SetWindowPos(.GetHandle, HWND_TOPMOST, _
0&, 0&, 0&, 0&, SWP_NOMOVE Or SWP_NOSIZE)
End With
End Sub
'##### Modul: Modul1 #####
'##### Typ: StdModule #####
Option Explicit
Option Private Module
Public Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Const WS_BORDER = &H800000
Public Const WS_CAPTION = &HC00000
Public Const WS_CHILD = &H40000000
Public Const WS_HSCROLL = &H100000
Public Const WS_MAXIMIZE = &H10000000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_THICKFRAME = &H40000
Public Const WS_SIZEBOX = WS_THICKFRAME
Public Const WS_SYSMENU = &H80000
Public Const WS_EX_ACCEPTFILES = &H10
Public Const WS_EX_STATICEDGE = &H20000
Public Const WS_EX_TOOLWINDOW = &H80
Public Const WS_EX_TRANSPARENT = &H20
Public Const WS_EX_WINDOWEDGE = &H100
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
'##### Modul: clsUserForm #####
'##### Typ: ClassModule #####
Option Explicit
Private WithEvents mUserForm As MSForms.UserForm
Private lnghWnd As Long, lngBorder As Long
Private MaxBox As Boolean, MinBox As Boolean
Public Enum BorderStyles
xlFest = 0
xlAenderbar = 1
End Enum
Public Sub Create(UF As MSForms.UserForm)
Dim ret&
Set mUserForm = UF
lnghWnd = GetHandle
SetWindowLong lnghWnd, GWL_STYLE, GetStyle Or WS_CAPTION Or lngBorder
If MaxBox Then SetWindowLong lnghWnd, GWL_STYLE, GetStyle Or WS_MAXIMIZEBOX
If MinBox Then SetWindowLong lnghWnd, GWL_STYLE, GetStyle Or WS_MINIMIZEBOX
SetWindowLong lnghWnd, GWL_EXSTYLE, GetStyle And WS_EX_STATICEDGE And WS_EX_WINDOWEDGE
End Sub
Public Function GetHandle() As Long
Select Case Val(Application.Version)
Case 8
GetHandle = FindWindow("ThunderXFrame", vbNullString)
Case Else
GetHandle = FindWindow("ThunderDFrame", vbNullString)
End Select
End Function
Public Property Get hwnd() As Boolean
hwnd = lnghWnd
End Property
Public Property Get MaxButton() As Boolean
MaxButton = MaxBox
End Property
Public Property Let MaxButton(Status As Boolean)
MaxBox = Status
End Property
Public Property Get MinButton() As Boolean
MinButton = MinBox
End Property
Public Property Let MinButton(Status As Boolean)
MinBox = Status
End Property
Public Property Let BorderStyle(Style As BorderStyles)
Select Case Style
Case 0: lngBorder = 0
Case 1: lngBorder = WS_SIZEBOX
End Select
End Property
Private Function GetStyle() As Long
GetStyle = GetWindowLong(lnghWnd, GWL_STYLE)
End Function
Private Sub Class_Initialize()
MaxBox = False
MinBox = False
End Sub
Gruß
Rudi