Tipp 0164 UserForm minimieren/maximieren
Autor/Einsender:
Datum:
  Angie
12.09.2004
Entwicklungsumgebung:   Word 2000
Die UserForm hat üblicherweise im Systemmenü nur eine ControlBox zum Schließen der Form. Dieser Tipp zeigt, wie mit Hilfe von API-Funktionen eine UserForm mit einem vollständigen Systemmenü, also auch mit Min- und Max-Button bestückt werden kann. Die UserForm lässt sich also minimieren, maximieren, als auch durch Ziehen der Formränder mit der Maus in der Größe verändern.
Code im Codebereich des Klassenmoduls clsUserForm
 
Option Explicit

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
End Property
 
Code im Codebereich der UserForm
 
Option Explicit

Private m_objUserForm As clsUserForm
Private m_blnFormInit As Boolean

Private Sub UserForm_Activate()
  Set m_objUserForm = New clsUserForm
  Set m_objUserForm.Form = Me
End Sub

Private Sub UserForm_Resize()
  If m_objUserForm.gIsIconic = True Then Exit Sub

  Const cMinHght As Single = 100
  Const cMinWdth As Single = 200
  Const cGap     As Single = 6

  Dim sngTxtBoxHght As Single
  Dim sngTxtBoxWdth As Single

  If Me.Height < cMinHght Then Me.Height = cMinHght
  If Me.Width < cMinWdth Then Me.Width = cMinWdth

  sngTxtBoxHght = (Me.InsideHeight - Me.fraButtons.Height - _
        (cGap * 4)) / 2
  sngTxtBoxWdth = Me.InsideWidth - (cGap * 2)

  txtTop.Move cGap, cGap, sngTxtBoxWdth, sngTxtBoxHght
  txtBot.Move cGap, txtTop.Height + (cGap * 2), _
        sngTxtBoxWdth, sngTxtBoxHght

  Me.fraButtons.Move Me.InsideWidth - Me.fraButtons.Width - cGap, _
        Me.InsideHeight - Me.fraButtons.Height

  If m_objUserForm.gIsZoomed = True Then
    Me.imgGrip.Visible = False
  Else
    Me.imgGrip.Visible = True
    Me.imgGrip.Move Me.InsideWidth - 10, Me.InsideHeight - 10
  End If
End Sub

Private Sub UserForm_Terminate()
  Set m_objUserForm = Nothing
End Sub
 
Links zum Thema
UserForm mit Icon in der Titelleiste
UserForm ohne Titelleiste anzeigen
UserForm Schließen-Schaltfläche deaktivieren
UserForm Schließen-Schaltfläche entfernen
UserForm ungebunden anzeigen
UserForm verschieben verhindern
Hinweis
Die im Download befindlichen *.frm- und *.cls-Dateien können für Excel und PowerPoint im jeweiligen Programm im VB-Editor importiert werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Anwendung/VBA-Version
Access 97
Access 2000
Access XP
Access 2003
Access 2007
Access 2010
Excel 97
Excel 2000
Excel XP
Excel 2003
Excel 2007
Excel 2010
Word 97
Word 2000
Word XP
Word 2003
Word 2007
Word 2010
PPT 97
PPT 2000
PPT XP
PPT 2003
PPT 2007
PPT 2010
Outlook 97
Outlook 2000
Outlook XP
Outlook 2003
Outlook 2007
Outlook 2010


Download  (25,2 kB) Downloads bisher: [ 3744 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 31. Mai 2011