Microsoft Excel

Herbers Excel/VBA-Archiv

UserForm Minimiern und Maximiernen


Betrifft: UserForm Minimiern und Maximiernen
von: Dominik
Geschrieben am: 12.08.2017 12:31:26

Hallo an alle,

eine Frage an alle, ich habe einen Code unter:

http://www.vb-fun.de/cgi-bin/loadframe.pl?ID=vb/tipps/tip0164.shtml

gefunden der eigentlich dafür Sorgen soll, dass ich das UserForm groß und klein machen kann (ähnlich einem Standardfenster in Windows. Unter Excel 2010 funktioniert das soweit auch super nur mit Excel 2016 scheint es nicht mehr zu funktionieren. Was muss ich ändern, damit es im Idealfall sowohl unter Excel 2010 als auch unter 2016 läuft?

Vielen Dank euch schon jetzt.

Gruß

Dominik

  

Betrifft: AW: UserForm Minimiern und Maximiernen
von: Nepumuk
Geschrieben am: 12.08.2017 13:24:57

Hallo Dominik,

was passiert in Excel 2016?

Gruß
Nepumuk


  

Betrifft: AW: UserForm Minimiern und Maximiernen
von: Matthias
Geschrieben am: 12.08.2017 13:45:48

Hallo! Evtl. arbeitet dein Excel mit der 64 BIt Version. Da sind einige APIs anders. Hier mal eine Übersicht einiger Funtkionen in beiden Versionen
http://www.jkp-ads.com/articles/apideclarations.asp
VG


  

Betrifft: AW: UserForm Minimiern und Maximiernen
von: Daniel
Geschrieben am: 12.08.2017 15:40:42

Hi
realisiere das Groß- und Klein-machen nicht über APIs, sondern einfach über 2 Commandbuttons in der Userform.
Die Buttons platzierst du so innerhalb der Userform, dass sie auch bei miniemierter Userform sichtbar sind (linke obere Ecke, zumindest den Button fürs großmachen.

das Groß- und Klein-machen geht einfach, in dem du die .Widht und .Heigth-Werte der Userform auf die entsprechenden Werte setzt.

das sollte dann in allen Excelversionen funktionieren.

Gruß Daniel


  

Betrifft: AW: UserForm Minimiern und Maximiernen
von: Luschi
Geschrieben am: 12.08.2017 17:01:08

Hallo Daniel,

diese Variante ist weniger empfehlenswert, wenn Bildschirmgröße und -auflösung eine Rolle spielen.
Auch dann müßte man erst per API die entsprechende Werte auslesen.

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: UserForm Minimiern und Maximiernen
von: Daniel
Geschrieben am: 12.08.2017 17:29:33

Hi
ja mag sein.
aber die Bildschirmauflösung spielt für die maximierte Größe der Userform doch eher selten eine Rolle sondern richtet sich in der Regel nach den Inhalten, die in der Userform angezeigt werden müssen.

Anderenfalls kann man die zur Verfügung stehende Bildschirmgröße des aktuellen Monitors in VBA auch ohne die Verwendung von API ermitteln.

Gruß Daniel


  

Betrifft: AW: UserForm Minimiern und Maximiernen
von: Dominik
Geschrieben am: 15.08.2017 19:26:11

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
'http://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 = fmScrollBarsHorizontal
    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