Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1020to1024
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Userform schliesen fehler (min,max buttons)
04.11.2008 07:19:21
chris
Hallo VBA Profis,
ich glaube ich habe heute ein schweres Problem.
ich komme nicht weiter und das schon lange.
Ich habe eine Datei erstellt mit meheren Userformen usw..
Meine formen können verschoben werden und auch die größe kann mit der Maus verändert werden.
Dazu lade ich die Userform besonders mit folgendem code.
Jetzt mein Problem.
Ich versuche bei
"

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
die Datei zu schliesen also mit
thisworkbook.close false
Aber bei diesem Code hängt sich mein Makro auf.
Jetzt habe ich versucht die funktion die das Makro oder die Makros im Klassenmodul läd zu  _
entfernen.
Diese Hier:
'Erstellen der Min & Max Buttons auf Main Form
With UF
.MaxButton = True
.MinButton = True
.BorderStyle = xlSolid
.Create main_project_form
End With
'Wird ausgeführt beim UserForm_Initialize.
wenn ich den Code entferne klappt das auch mit dem schliesen.
Hier noch der Code den ich im Klassenmodul habe.
Option Explicit
'Zum erstellen der Main Userform
'Für Resize Min Max buttons und   Resize Form mit Maus
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 MoveWindow Lib "User32" (ByVal hwnd As Long, _
ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowPos Lib "User32" Alias "SetWindowPosA" ( _
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 uFlags As Long) As Long
Private Declare Function SetWindowText Lib "User32" Alias "SetWindowTextA" ( _
ByVal hwnd As Long, ByVal lpString As String) As Long
Const MF_APPEND = &H100&
Const MF_BITMAP = &H4&
Const MF_BYPOSITION = &H400&
Const MF_CHECKED = &H8&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Const MIIM_CHECKMARKS As Long = &H8
Const MIIM_DATA As Long = &H20
Const MIIM_ID As Long = &H2&
Const MIIM_STATE As Long = &H1&
Const MIIM_SUBMENU As Long = &H4
Const MIIM_TYPE As Long = &H10
Const MIIM_STRING As Long = &H40
Const MIIM_BITMAP As Long = &H80
Const MIIM_FTYPE As Long = &H100
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_BITMAP  As Long = &H4&
Const MFT_MENUBARBREAK  As Long = &H20&
Const MFT_MENUBREAK  As Long = &H40&
Const MFT_OWNERDRAW  As Long = &H100&
Const GWL_WNDPROC = (-4)
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 m_Handle&, hIcon&, Border&
Dim hMainMenu&, hSubMenu&, hSubSubMenu&
Dim FormCaption$
Dim MaxBox As Boolean, MinBox As Boolean
Dim UFIconImage As Object
Public Enum BorderStyles
xlSolid = 0
xlChangeable = 1
End Enum


Public Sub Create(UF As MSForms.UserForm)
Set myUserForm = UF
FormCaption = myUserForm.Caption
m_Handle = GetHandle
SetWindowLong m_Handle, GWL_STYLE, GetStyle Or WS_OVERLAPPEDWINDOW
SetWindowLong m_Handle, GWL_STYLE, GetStyle Or Border
If MaxBox Then SetWindowLong m_Handle, GWL_STYLE, GetStyle Or WS_MAXIMIZEBOX
If MinBox Then SetWindowLong m_Handle, GWL_STYLE, GetStyle Or WS_MINIMIZEBOX
SetWindowLong m_Handle, GWL_EXSTYLE, GetStyle And WS_EX_WINDOWEDGE
If (hIcon) Then SendMessage m_Handle, WM_SETICON, ICON_SMALL, hIcon
End Sub



Private Function GetHandle() As Long
Select Case Int(Val(Application.Version))
Case 8 'Excel 97
GetHandle = FindWindow("ThunderXFrame", vbNullString)
Case 9, 10, 11 'Excel 2000, XP, 2003
GetHandle = FindWindow("ThunderDFrame", vbNullString)
End Select
End Function


Public Property Get hwnd() As Boolean
hwnd = m_Handle
End Property
Public Property Get Caption() As String
Caption = FormCaption
End Property
Public Property Let Caption(Title As String)
SetWindowText m_Handle, 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 m_Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0&
End Sub



Public Sub Minimize()
SendMessage m_Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0&
End Sub



Public Sub Screensaver()
SendMessage m_Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0&
End Sub



Private Function GetStyle() As Long
GetStyle = GetWindowLong(m_Handle, GWL_STYLE)
End Function



Private Sub Class_Initialize()
MaxBox = True
MinBox = True
End Sub


Würde mich sehr freuen wenn ihr mir helfen könntet.Ich möchte es schaffen das beim:
"


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
die Datei geschlossen wird.
Vielen Dank für eure Hilfe !!!
gruß Chris


		

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: mit Beispieldatei
04.11.2008 08:10:00
chris
Hallo habe hier ein Beispiel erstellt an dem es sichtbat ist das sich die datei nicht schliesen lässt über x
https://www.herber.de/bbs/user/56489.zip
Danke noch einmal !
AW: mit Beispieldatei
04.11.2008 08:19:39
Nepumuk
Hallo Chris,
du musst mit Set UF = Nothing die Klasse entladen.
Gruß
Nepumuk
AW: mit Beispieldatei
04.11.2008 08:24:47
chris
Hallo Nepumuk,
wollte gerade noch einen Kollegen fragen mit dem wir gestern erst nach dem fehler gesucht haben.
Aber das brauche ich jetzt nicht mehr.
Dein Tipp Klappt !!!
Vielen vielen Dank und schönen Tag noch !!!
gruß Christian
Anzeige

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige