UserForm

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: UserForm
von: Michael. M
Geschrieben am: 20.02.2005 13:46:22
Hallo
Ist es möglich in der UserForm Titelleiste zusätzlich zu dem schließen ( X ) auch das Minimieren und Verkleinern rein zu bekommen, wenn ja wie müßte der Weg dann aussehen bzw. der Code dafür ?
Für eine Hilfe wäre ich Euch dankbar
Gruß
Michael. M

Bild

Betrifft: AW: UserForm
von: Ramses
Geschrieben am: 20.02.2005 13:54:48
Hallo
Dieser Code wurde mal von Thomas Risi entwickelt.
Estelle ein Klassenmodul und benenne es mit "CUserForm"
Kopiere den Code da rein


'-------------------------------------------------------------------------
'Neue Codesequenz
' CUserForm                      Version 1.2
' Copyright 2002 Risi Thomas     webmaster@rtsoftwaredevelopment.de
' Created 20/06/02               Last Modified 13/07/02
COLOR=#008000>' Website                        http://rtsoftwaredevelopment.de
' COPYRIGHT NOTICE
' Copyright 2002 Thomas Risi All Rights Reserved.
'
' CUserForm may be used and modified free of charge by anyone so long as this
' copyright notice and the comments above remain intact. By using this
' code you agree to indemnify Thomas Risi from any liability that
' might arise from its use.
'
' Selling the code for this program without prior written consent is
' expressly forbidden. In other words, please ask first before you try and
' make money of my program.
'
' Obtain permission before redistributing this software over the Internet or
' in any other medium. In all cases copyright and header must remain intact
Option Explicit
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" ( _
 ByVal hMenu As LongByVal uFlags As LongByVal idNewItem As Long, _
 ByVal lpszNewItem As StringAs Long
Private Declare Function CreateMenu Lib "user32" () As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As LongAs Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
 ByVal lpClassName As StringByVal lpWindowName As StringAs Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
 ByVal hwnd As LongByVal nIndex As LongAs Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
 ByVal hwnd As LongByVal nIndex As LongByVal dwNewLong As LongAs Long
Private Declare Function SetMenu Lib "user32" ( _
 ByVal hwnd As LongByVal hMenu As LongAs Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, _
 ByVal As LongByVal As LongByVal nWidth As Long, _
 ByVal nHeight As LongByVal bRepaint As LongAs Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
 ByVal hwnd As LongByVal Msg As LongByVal wParam As LongByVal lParam As LongAs Long
Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPosA" ( _
 ByVal hwnd As LongByVal hWndInsertAfter As LongByVal As LongByVal As Long, _
 ByVal cx As LongByVal cy As LongByVal uFlags As LongAs Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" ( _
 ByVal hwnd As LongByVal lpString As StringAs Long
Const WS_BORDER  As Long = &H800000
Const WS_CAPTION As Long = &HC00000
Const WS_CHILD As Long = &H40000000
Const WS_CLIPSIBLINGS  As Long = &H4000000
Const WS_DLGFRAME As Long = &H400000
Const WS_MAXIMIZE As Long = &H1000000
Const WS_MAXIMIZEBOX  As Long = &H10000
Const WS_MINIMIZEBOX  As Long = &H20000
Const WS_OVERLAPPED  As Long = 0
Const WS_POPUP As Long = &H80000000
Const WS_SIZEBOX  As Long = &H40000
Const WS_SYSMENU  As Long = &H80000
Const WS_THICKFRAME  As Long = &H40000
Const WS_OVERLAPPEDWINDOW  As Long = WS_OVERLAPPED Or _
                                     WS_CAPTION Or _
                                     WS_SYSMENU Or _
                                     WS_THICKFRAME 'Or _
                                     WS_MINIMIZEBOX Or _
                                     WS_MAXIMIZEBOX
Const WS_EX_DLGMODALFRAME As Long = &H1
Const WS_EX_ACCEPTFILES As Long = &H10
Const WS_EX_STATICEDGE  As Long = &H20000
Const WS_EX_TOOLWINDOW  As Long = &H80
Const WS_EX_TRANSPARENT As Long = &H20
Const WS_EX_WINDOWEDGE As Long = &H100
Const MFT_STRING  As Long = 0
Const MFT_MENUBARBREAK  As Long = &H20
Const GWL_STYLE  As Long = (-16)
Const GWL_EXSTYLE  As Long = (-20)
Const SM_CXSCREEN As Long = 0
Const SM_CYSCREEN As Long = 1
Const WM_SETICON As Long = &H80&
Const WM_SYSCOMMAND As Long = &H112&
Const SC_MINIMIZE As Long = &HF020&
Const SC_MAXIMIZE As Long = &HF030&
Const SC_CLOSE As Long = &HF060&
Const SC_SCREENSAVE As Long = &HF140&
Const ICON_SMALL As Long = &H0&
Const ICON_BIG As Long = &H1&
Dim WithEvents myUserForm As MSForms.UserForm
Dim myHandle&, hIcon&, Border&
Dim FormCaption$
Dim MaxBox As Boolean, MinBox As Boolean
Dim UFIconImage As Object
Public Enum BorderStyles
    xlFest = 0
    xlÄÄnderbar = 1
End Enum

Public Sub Create(UF As MSForms.UserForm)
    Set myUserForm = UF
    
    FormCaption = myUserForm.Caption
    
    myHandle = GetHandle
    
    SetWindowLong myHandle, GWL_STYLE, GetStyle Or WS_OVERLAPPEDWINDOW
    SetWindowLong myHandle, GWL_STYLE, GetStyle Or Border
    
    If MaxBox Then SetWindowLong myHandle, GWL_STYLE, GetStyle Or WS_MAXIMIZEBOX
    If MinBox Then SetWindowLong myHandle, GWL_STYLE, GetStyle Or WS_MINIMIZEBOX
    
    SetWindowLong myHandle, GWL_EXSTYLE, GetStyle And WS_EX_WINDOWEDGE
    
    ' Um ein eigenes Icon in die Symbolleiste einzufügen, muß die Userform ein
    ' 'Image'-Control enthalten. In der 'Picture'-Eigenschaft von Image1 wird
    ' nun der Pfad zum Icon angegeben. Dann wird noch die 'Visible'-Eigenschaft
    ' von Image1 auf 'False' gesetzt ...
    '
    On Error GoTo 10
    
    Set UFIconImage = UF.Image1
    hIcon = UFIconImage.Picture
    If (hIcon) Then SendMessage myHandle, WM_SETICON, ICON_SMALL, hIcon
    
10:
    
    On Error GoTo 0
    
    ' Wer will, kann auch noch ein Menü erstellen, das aber (noch) nicht
    ' funktioniert ... (einfach auskommentieren)
    
    'hMenu = CreateMenu
    'AppendMenu hMenu, MFT_STRING, 120, "&Datei"
    'AppendMenu hMenu, MFT_STRING, 130, "&Bearbeiten"
    'AppendMenu hMenu, MFT_STRING, 140, "&?"
    'SetMenu myHandle, hMenu
    
End Sub
Private Function GetHandle() As Long
    Select Case Int(Val(Application.Version))
    Case 'Excel 97
        GetHandle = FindWindow("ThunderXFrame", vbNullString)
    Case 9, 10 'Excel 2000, XP
        GetHandle = FindWindow("ThunderDFrame", vbNullString)
    End Select
End Function
Public Property Get hwnd() As Boolean
    hwnd = myHandle
End Property
Public Property Get Caption() As String
    Caption = FormCaption
End Property
Public Property Let Caption(Title As String)
    SetWindowText myHandle, Title
    FormCaption = Title
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: Border = 0
    Case 1: Border = WS_SIZEBOX
    End Select
End Property
Public Sub CloseForm()
    Unload myUserForm
End Sub
Public Sub Maximize()
    SendMessage myHandle, WM_SYSCOMMAND, SC_MAXIMIZE, 0&
End Sub
Public Sub Minimize()
    SendMessage myHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0&
End Sub
Public Sub Screensaver()
    SendMessage myHandle, WM_SYSCOMMAND, SC_SCREENSAVE, 0&
End Sub
Private Function GetStyle() As Long
    GetStyle = GetWindowLong(myHandle, GWL_STYLE)
End Function
Private Sub Class_Initialize()
    MaxBox = False
    MinBox = False
End Sub
'--------------------------------------------------------------------------------


     Code eingefügt mit Syntaxhighlighter 2.5

Erstelle deine UF und füge folgenden Code hinzu
'Option Explicit
Dim UF As New CUserForm

Private Sub CommandButton1_Click()
'Zum Schliessen der Userform !!!!
    UF.CloseForm
End Sub


Private Sub UserForm_Activate()
'Je nach Bedarf zu aktivieren oder eben nicht
    'UF.Maximize ' UserForm maximieren
    'UF.Minimize ' UserForm minimieren
End Sub


Private Sub UserForm_Initialize()
    With UF
        .MaxButton = False
        .MinButton = True
        .BorderStyle = xlÄnderbar
        .Create Me
    End With
End Sub


Gruss Rainer
Bild

Betrifft: AW: UserForm
von: Michael. M
Geschrieben am: 20.02.2005 14:55:15
Hallo Rainer
Vielen Dank, nun noch eine Frage :
Kann ich den Code auch in eine Bestehende UserForm einfügen oder muß ich jetzt eine neue anlegen ? Ich bräuchte dann doch eigendlich nur überall UserForm gegen den Namen meiner UF austauschen, oder bin ich da aufm Holzweg ?
Gruß
Michael. M
Bild

Betrifft: AW: UserForm
von: Ramses
Geschrieben am: 20.02.2005 15:07:29
Hallo
Du solltest damit jede UF damit "updaten" können :-) mit den kleinen Einschränkungen eben.
Allenfalls mit Thomas mal direkt Kontakt aufnehmen
Gruss Rainer
Bild

Betrifft: AW: UserForm
von: Michael. M
Geschrieben am: 20.02.2005 20:04:15
Hallo Rainer
Danke für deine Hilfe, hat so geklappt brauchte nichts umschreiben.
Gruß
Michael. M
Bild

Betrifft: AW: UserForm noch ne Frage
von: Michael. M
Geschrieben am: 20.02.2005 22:24:27
Hallo
kann mann das X in der UserForm auch so Belegen das es die gesammt Mappe schließt und Speichert an einem angegebenen Ort?
Gruß
Michael. M
 Bild

Beiträge aus den Excel-Beispielen zum Thema "UserForm "