AW: UserForm Minimiern und Maximiernen
15.08.2017 19:26:11
Dominik
Hallo an alle,
also das Problem war viel einfacher zu lösen als gedacht. Das Problem mein Code ist noch etwas weiter gewachsen als der Ausgangscode. Ich dachte aber es liegt an der Excel-Version. Als ich diese Woche den Code mit Excel 2010 getestet habe und er dort auch nicht mehr funktionierte wusste ich das der Fehler an einer anderen Stelle wie der Version zu suchen ist. Der Fehler in meinem Code war, dass ich die Überschrift des UserForms nach dem aufrufen des "Minimieren/Maximiern Befehls" geändert habe. Die Überschrift darf aber nur vor dem aufrufen geändert werden.
Vielen Dank Euch trotzdem für die Hilfeversuche.
Gruß
Dominik
Mein geänderter Cod lautet nun wie folgt.
In UserForm
'Deklarationen für Minimieren/Maximieren
'Quelle fuer Code UserForm Minimieren/Maximieren aus
'https://www.herber.de/forum/archiv/1244to1248/1245764_VBA_Userform_Minimieren_Maximieren_Klassenmodul.html
'http://www.vb-fun.de/cgi-bin/loadframe.pl?ID=vb/tipps/tip0164.shtml
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPlacement Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByRef lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function GetWindowPlacement Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByRef lpwndpl As WINDOWPLACEMENT) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private m_objUserForm As clsUserForm
Private m_blnFormInit As Boolean
Private Const GC_CLASSNAMEMSUSERFORM = "ThunderDFrame"
Private Const SW_MAXIMIZE = 1
'Deklaration für Eingabebeschränkung
Dim objTxbZahlen As New clsEingabeNurZahl
'Deklaration für UserForm Überschrift
Dim m_strMsgBoxBezeichnung As String
'
Private Sub UserForm_Activate()
'Überschrift UserForm festlegen
m_strMsgBoxBezeichnung = p_cstrAppTitel & " Test"
usfSchildEinpflegen.Caption = m_strMsgBoxBezeichnung
'Minimiern und Maximieren des Fensters ermöglichen mit Klasse clsUserForm
Dim lngHwnd As Long
Dim udtWinEst As WINDOWPLACEMENT
Set m_objUserForm = New clsUserForm
Set m_objUserForm.Form = Me
lngHwnd = FindWindow(GC_CLASSNAMEMSUSERFORM, Caption)
Call GetWindowPlacement(lngHwnd, udtWinEst)
udtWinEst.showCmd = SW_MAXIMIZE
Call SetWindowPlacement(lngHwnd, udtWinEst)
Private Sub UserForm_Resize()
If Height >= ScrollHeight And Width >= ScrollWidth Then 'ScrollHeight und _
SrcollWidth kann in UserForm Eigenschaften gesetzt werden
ScrollBars = fmScrollBarsNone
ElseIf Height >= ScrollHeight And Width = ScrollWidth Then
ScrollBars = fmScrollBarsVertical
Else
ScrollBars = fmScrollBarsBoth
End If
End Sub
In Klassenmodul clsUserForm
'Quelle http://www.vb-fun.de/cgi-bin/loadframe.pl?ID=vb/tipps/tip0164.shtml
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 ShowWindow Lib "user32" (ByVal _
hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal _
hwnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal _
hwnd As Long) As Long
Private Declare Function IsIconic Lib "user32" (ByVal _
hwnd As Long) As Long
Private Declare Function IsZoomed Lib "user32" (ByVal _
hwnd As Long) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const SW_SHOW As Long = 5
Private m_objUserForm As Object
Private m_hWndForm As Long
Private Sub Class_Terminate()
Set m_objUserForm = Nothing
End Sub
Public Property Set Form(ByVal objForm As Object)
Dim nStyle As Long
Set m_objUserForm = objForm
m_hWndForm = FindWindow(vbNullString, m_objUserForm.Caption)
If m_hWndForm 0 Then
nStyle = GetWindowLong(m_hWndForm, GWL_STYLE)
nStyle = nStyle Or WS_THICKFRAME Or WS_SYSMENU Or _
WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
SetWindowLong m_hWndForm, GWL_STYLE, nStyle
ShowWindow m_hWndForm, SW_SHOW
DrawMenuBar m_hWndForm
SetFocus m_hWndForm
End If
End Property
Public Property Get gIsIconic() As Boolean
If m_hWndForm 0 Then
gIsIconic = CBool(IsIconic(m_hWndForm))
End If
End Property
Public Property Get gIsZoomed() As Boolean
If m_hWndForm 0 Then
gIsZoomed = CBool(IsZoomed(m_hWndForm))
End If