Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1672to1676
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
Inhaltsverzeichnis

Modul und Klassenmodul

Modul und Klassenmodul
07.02.2019 15:25:40
Frank
Hallo,
wenn ich aus Foren ein Modul erhalte:
Einfach ein Moduleinfügen und Code einfügen?
Habe z.B. folgenden Code testen wollen:
http://www.office-loesung.de/ftopic174250_0_0_asc.php
Aber nur mit Modul und Code einfügen funktioniert hier nichts...
Fehlt was?
Gruß Frank.

29
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Modul und Klassenmodul
07.02.2019 16:34:34
Werner
Hallo Frank,
da steht doch wo der Code hin muss. Der untere Teil in ein allgemeines Modul, der obere Code ins Klassenmodul der Userform.
Gruß Werner
AW: Modul und Klassenmodul
07.02.2019 16:44:32
Frank
ja schon, ich arbeite das erste mal mit Modulen...
Die Module wurden eingefügt und der dementsprechende Code in das Modul.
Ich vermute aber, das noch ein Verweis oder ähnliches von der Userform zum Modul fehlt?
AW: Modul und Klassenmodul
07.02.2019 16:48:35
Werner
Hallo Frank,
hier hat niemand eine Ahnung was du gemacht hast, weil niemand deine Datei sieht. Wie wäre es micht hochladen derselben?
Ein Klassenmodul für die Userform brauchst du nicht einzufügen. Im VBA-Editor in eine freie Fläche deiner Userform doppelklick, dann bist du im Klassenmdodul der Userform, dort gehört dann der entsprechende Code rein.
Gruß Werner
Anzeige
AW: Modul und Klassenmodul
07.02.2019 20:56:58
Frank
folgendes Beispiel:
ich habe folgenden Code in jeder Userform, um das X (Beenden) rechts oben am Formular zu entfernen.
Option Explicit
'das [X] rechts oben entfernen
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Const GWL_STYLE = -&H10
Private Const WS_SYSMENU = &H80000
Private Const GC_CLASSNAMEMSEXCELFORM = "ThunderDFrame"
Bildschirmgrösse ermitteln
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByRef lpRect As RECT) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const GC_CLASSNAMETASKBAR As String = "Shell_TrayWnd"

Private Sub UserForm_Activate()
'das [X] rechts oben entfernen
Dim hWndForm As Long
hWndForm = FindWindow(GC_CLASSNAMEMSEXCELFORM, Me.Caption)
If hWndForm  0 Then
SetWindowLong hWndForm, GWL_STYLE, GetWindowLong(hWndForm, GWL_STYLE) And Not WS_SYSMENU
DrawMenuBar hWndForm
End If
End Sub
aber als Modul bekomme ich es nicht zum laufen, nur wenn der gesammte Code in jeder Userform ist.
Warum funktioniert es als Modul nicht?
Gruß Frank.
Anzeige
AW: Modul und Klassenmodul
07.02.2019 21:04:33
Frank
Fehlerteufel, hier der verwendete Code:
Option Explicit
'das [X] rechts oben entfernen
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Const GWL_STYLE = -&H10
Private Const WS_SYSMENU = &H80000
Private Const GC_CLASSNAMEMSEXCELFORM = "ThunderDFrame"

Private Sub UserForm_Activate()
'das [X] rechts oben entfernen
Dim hWndForm As Long
hWndForm = FindWindow(GC_CLASSNAMEMSEXCELFORM, Me.Caption)
If hWndForm  0 Then
SetWindowLong hWndForm, GWL_STYLE, GetWindowLong(hWndForm, GWL_STYLE) And Not WS_SYSMENU
DrawMenuBar hWndForm
End If
End Sub

Anzeige
AW: Modul und Klassenmodul
07.02.2019 21:09:26
Mullit
Hallo,
na das is doch ne klare Sache, das Activate-Event muß schließlich in der Form stehen, wenn es als Event gefeuert werden soll, die Apis könnten durchaus in einem Std.-Modul stehen, dann müsstest Du sie aber Public setzen...
Gruß, Mullit
AW: Modul und Klassenmodul
08.02.2019 00:27:02
Frank
Und wie muss der Code angepasst werden, damit das Modul angesprochen wird?
Warum muss in jeder Form der gleiche Code für eine Funktion stehen, kommt ein Modul nicht damit klar, den Code auf jeder Form auszuführen?
AW: Modul und Klassenmodul
08.02.2019 01:05:19
Frank
Ok, Codewörter im Modul von Private auf Puplic geändert und Modul funktioniert!
Schade nur, das ich den zweiten Code in jeder Userform anhängen muss...?
Oder gibt es hierfür auch noch einen Lösungsansatz?
Anzeige
AW: Modul und Klassenmodul
08.02.2019 09:29:50
Nepumuk
Hallo Frank,
in einem Standardmodul:
Option Explicit

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32.dll" ( _
    ByVal hwnd As Long) As Long

Private Const GWL_STYLE = -&H10
Private Const WS_SYSMENU = &H80000
Private Const GC_CLASSNAMEMSEXCELFORM = "ThunderDFrame"

Public Sub RemoveSysmenu(ByRef mobjUserFrom As Object)
    'das [X] rechts oben entfernen
    Dim lnghwndForm As Long, lngStyle As Long
    lnghwndForm = FindWindow(GC_CLASSNAMEMSEXCELFORM, mobjUserFrom.Caption)
    lngStyle = GetWindowLong(lnghwndForm, GWL_STYLE)
    lngStyle = lngStyle And Not WS_SYSMENU
    Call SetWindowLong(lnghwndForm, GWL_STYLE, lngStyle)
    Call DrawMenuBar(lnghwndForm)
End Sub

Im Modul des UserForms:
Private Sub UserForm_Activate()
    Call RemoveSysmenu(Me)
End Sub

Gruß
Nepumuk
Anzeige
AW: Modul und Klassenmodul
08.02.2019 17:38:45
Frank
Vielen, vielen Dank. Funktioniert super!
Allerdings habe ich einen zweiten Code und wollte diesen auch nach gleichem Muster als komplettes Modul umbauen, es will einfach nicht funktionieren...
Hier der Code als Modul - bereits als Public deklariert:
Option Explicit
'Bildschirmgrösse ermitteln
Public Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
ByVal nIndex As Long) As Long
Public Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByRef lpRect As RECT) As Long
Public Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Const SM_CXSCREEN As Long = 0
Public Const SM_CYSCREEN As Long = 1
Public Const GC_CLASSNAMETASKBAR As String = "Shell_TrayWnd"
und hier der Ergänzungscode:
Dim lngptrhWnd As LongPtr
Dim udtRectangle As RECT
lngptrhWnd = FindWindowA(GC_CLASSNAMETASKBAR, vbNullString)
Call GetWindowRect(lngptrhWnd, udtRectangle)
Left = GetSystemMetrics(SM_CXSCREEN) * 0.75 - Width
Top = GetSystemMetrics(SM_CYSCREEN) * 0.75 - Height - _
(udtRectangle.Bottom - udtRectangle.Top) * 0.75

Anzeige
AW: Modul und Klassenmodul
08.02.2019 17:42:35
Nepumuk
Hallo Frank,
wenn du mir verrätst was du vor hast täte ich mir leichter.
Gruß
Nepumuk
AW: Modul und Klassenmodul
08.02.2019 17:55:40
Frank
Hallo Nepumuk,
hier soll die Bildschirmgröße ermittelt werden, damit man in den Eistellungen die Userform verschieben kann - aber nicht aus dem Bildschirmrand heraus.
AW: Modul und Klassenmodul
08.02.2019 18:08:29
Nepumuk
Hallo Frank,
in einem Standardmodul:
Option Explicit

Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
    ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByRef lpRect As RECT) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const GC_CLASSNAMETASKBAR As String = "Shell_TrayWnd"

Public Sub MoveForm(ByRef mobjUserFrom As Object)
    Dim lngptrhWnd As LongPtr
    Dim udtRectangle As RECT
    With mobjUserFrom
        If .Left < 0 Or .Top < 0 Then
            .Left = Application.Max(0, .Left)
            .Top = Application.Max(0, .Top)
        Else
            lngptrhWnd = FindWindowA(GC_CLASSNAMETASKBAR, vbNullString)
            Call GetWindowRect(lngptrhWnd, udtRectangle)
            .Left = Application.Min(.Left, GetSystemMetrics(SM_CXSCREEN) * 0.75 - .Width)
            .Top = Application.Min(.Top, GetSystemMetrics(SM_CYSCREEN) * 0.75 - .Height - _
                (udtRectangle.Bottom - udtRectangle.Top) * 0.75)
        End If
    End With
End Sub

Im Modul des Userforms:
Private Sub UserForm_Layout()
    Call MoveForm(Me)
End Sub

Gruß
Nepumuk
Anzeige
AW: Modul und Klassenmodul
08.02.2019 18:35:57
Frank
Vielen Dank Nepumuk (ich muss mich da echt noch einarbeiten)!
Kannst du mir vielleicht noch verraten, ob sich der Code aus dem Link im ersten Thread auch so umbauen lässt?
Das Modul soll das scrollen mit dem Mausrad in Listboxen ermöglichen,
Gruß Frank.
AW: Modul und Klassenmodul
08.02.2019 18:40:48
Nepumuk
Hallo Frank,
das funktioniert unter den neuen Excelversionen nicht mehr. Ich arbeite an einer Lösung, aber die gibt es frühestens morgen.
Gruß
Nepumuk
AW: Modul und Klassenmodul
08.02.2019 18:59:03
Frank
Das hört sich vielversprechend an!
Ich danke dir für deine Unterstützung, Gruß Frank.
AW: Modul und Klassenmodul
09.02.2019 11:39:54
Nepumuk
Hallo Frank,
der notwendige Code im Modul des Userforms:
Option Explicit

Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
        ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Call HookMouse(ListBox1)
End Sub

Private Sub UserForm_Deactivate()
    Call UnhookMouse
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Call UnhookMouse
End Sub

folgender Code in ein Standardmodul:
Option Explicit
Option Private Module

Private Declare Function GetWindowLongA Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookExA Lib "user32.dll" ( _
    ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32.dll" ( _
    ByVal hHook As Long, _
    ByVal nCode As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" ( _
    ByVal hHook As Long) As Long
Private Declare Function WindowFromPoint Lib "user32.dll" ( _
    ByVal xPoint As Long, _
    ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( _
    ByRef lpPoint As POINTAPI) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Private Const WH_MOUSE_LL As Long = 14&
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0&
Private Const GWL_HINSTANCE As Long = -6&

Private llngMouseHook As Long
Private llngControlHwnd As Long
Private lblnHook As Boolean
Private lobjControl As MSForms.Control

Public Sub HookMouse(ByRef probjControl As MSForms.Control)
    Dim lngHinstance As Long
    Dim lngHwndUnderCursor As Long
    Dim udtPoint As POINTAPI
    Call GetCursorPos(udtPoint)
    lngHwndUnderCursor = WindowFromPoint(udtPoint.X, udtPoint.Y)
    If llngControlHwnd <> lngHwndUnderCursor Then
        Call UnhookMouse
        Set lobjControl = probjControl
        llngControlHwnd = lngHwndUnderCursor
        lngHinstance = GetWindowLongA(llngControlHwnd, GWL_HINSTANCE)
        If Not lblnHook Then
            llngMouseHook = SetWindowsHookExA(WH_MOUSE_LL, AddressOf MouseProc, lngHinstance, 0&)
            lblnHook = llngMouseHook <> 0
        End If
    End If
End Sub

Public Sub UnhookMouse()
    If lblnHook Then
        Set lobjControl = Nothing
        Call UnhookWindowsHookEx(llngMouseHook)
        llngMouseHook = 0
        llngControlHwnd = 0
        lblnHook = False
    End If
End Sub

Private Function MouseProc(ByVal pvlngCode As Long, _
        ByVal pvlngParam As Long, ByRef prudtParam As MOUSEHOOKSTRUCT) As Long

    On Error GoTo err_exit
    If pvlngCode = HC_ACTION Then
        If WindowFromPoint(prudtParam.pt.X, prudtParam.pt.Y) = llngControlHwnd Then
            If pvlngParam = WM_MOUSEWHEEL Then
                With lobjControl
                    If prudtParam.hwnd > 0 Then
                        If .TopIndex > 0 Then
                            If .TopIndex > 3 Then
                                .TopIndex = .TopIndex - 3
                            Else
                                .TopIndex = 0
                            End If
                        End If
                    Else
                        .TopIndex = .TopIndex + 3
                    End If
                End With
                Exit Function
            End If
        Else
            Call UnhookMouse
        End If
    End If
    MouseProc = CallNextHookEx(llngMouseHook, pvlngCode, pvlngParam, ByVal prudtParam)
    Exit Function
    err_exit:
    Call UnhookMouse
End Function

Gruß
Nepumuk
Anzeige
AW: Modul und Klassenmodul
09.02.2019 17:15:59
Frank
Vielen Dank hierfür!
Eine sehr gute Arbeit, welche du hier ablieferst -Top!
eine Frage am Rande zu deinem zweiten Modul:
es läuft soweit alles wie gewünscht, nur hätte ich gerne eine Abfrage, wenn Excel gestartet wird, ob die aktuelle Position kleiner ist als der gespeicherte Wert.
Hiermit möchte ich abfangen, sollte das Projekt an einem kleineren Monitor gestartet werden und die Einstellungen von einer höheren Auflösung kommen, die Einstellungen überschrieben werden.
Mein Code hierfür bisher:
Private Sub UserForm_Activate()
Call RemoveSysmenu(Me) 'Modul1
Call MoveForm(Me) 'Modul2
With Sheets("Berechnung")
If .Range("B25").Value = "Y" And .Range("B26").Value > Me.Left Then
.Range("B26").Value = Me.Left
ThisWorkbook.Save
End If
If .Range("B25").Value = "Y" And .Range("B27").Value > Me.Top Then
.Range("B27").Value = Me.Top
ThisWorkbook.Save
End If
End With
End Sub
Hier wird aber bei einer erneuten Anzeige immer wieder gespeichert, es soll aber nur bei der erstmaligen Anzeige der Wert mit den Einstellungen verglichen werden.
Wie heißt das richtige Sub-Menü?
Anzeige
AW: Modul und Klassenmodul
09.02.2019 18:50:32
Nepumuk
Hallo Frank,
in einem Standardmodul:
Public gblnSaveFormPosition As Boolean

In deinem Userform:
Private Sub UserForm_Activate()
    Call RemoveSysmenu(Me) 'Modul1
    Call MoveForm(Me) 'Modul2
    If Not gblnSaveFormPosition Then
        With Sheets("Berechnung")
            If .Range("B25").Value = "Y" And .Range("B26").Value > Me.Left Then
                .Range("B26").Value = Me.Left
                ThisWorkbook.Save
            End If
            If .Range("B25").Value = "Y" And .Range("B27").Value > Me.Top Then
                .Range("B27").Value = Me.Top
                ThisWorkbook.Save
            End If
        End With
        gblnSaveFormPosition = True
    End If
End Sub

Gruß
Nepumuk
AW: Modul und Klassenmodul
09.02.2019 22:14:50
Frank
Hallo Nepumuk,
leider erhalte ich einen Fehler an deinem zweiten Modul beim öffnen einer bestimmten UserForm.
Daher ist der Fehler auch nicht im Modul zu suchen, sondern im Code der bestimmten Userform.
Ich konnte inzwischen bereits ausfindig machen, welcher Teil des UserCodes eine Störung an Modul2 verursacht...
Code:
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim AnzahlZeilen As Long
Dim m As Integer
m = Month(Now)
With Sheets("Tabelle1").Cells(1, 1).CurrentRegion
With .Columns(.Columns.Count + 1)
If m = 1 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC5>0),1,""x"")"
ElseIf m = 2 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC6>0),1,""x"")"
ElseIf m = 3 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC7>0),1,""x"")"
ElseIf m = 4 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC8>0),1,""x"")"
ElseIf m = 5 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC9>0),1,""x"")"
ElseIf m = 6 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC10>0),1,""x"")"
ElseIf m = 7 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC11>0),1,""x"")"
ElseIf m = 8 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC12>0),1,""x"")"
ElseIf m = 9 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC13>0),1,""x"")"
ElseIf m = 10 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC14>0),1,""x"")"
ElseIf m = 11 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC15>0),1,""x"")"
ElseIf m = 12 Then
.FormulaR1C1 = "=IF(AND(OR(RC4=0,RC4=Year(Today())),RC16>0),1,""x"")"
End If
.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
AnzahlZeilen = WorksheetFunction.Sum(.Cells) + 1
.ClearContents
End With
End With
With ListBox1
.ColumnCount = 4
.ColumnWidths = "1,5cm;5cm;5cm;1,5cm"
.ColumnHeads = True
.RowSource = "Tabelle1!A2:P" & AnzahlZeilen
End With
End Sub
Wird dieser Teil in der UserForm ausgeblendet, läuft auch dein Modul mit dem Aufruf
Private Sub UserForm_Layout()
Call MoveForm(Me) 'Modul2
End Sub
Aber was stört?
Gruß Frank.
AW: Modul und Klassenmodul
10.02.2019 08:11:51
Nepumuk
Hallo Frank,
welchen Fehler (Nummer und Text) in welcher Zeile?
Gruß
Nepumuk
AW: Modul und Klassenmodul
10.02.2019 09:09:34
Frank
Hallo,
ich erhalte den Laufzeitfehler 50290 (Anwendungs- oder objektdefinierter Fehler).
Beim Debuggen ist die Zeile .Left = Application.Min(.Left, GetSystemMetrics(SM_CXSCREEN) * 0.75 - .Width) gelb markiert im folgenden Code:
Public Sub MoveForm(ByRef mobjUserFrom As Object)
Dim lngptrhWnd As LongPtr
Dim udtRectangle As RECT
With mobjUserFrom
If .Left 
Gruß Frank.
AW: Modul und Klassenmodul
10.02.2019 10:26:21
Frank
Ach ja, der Fehler tritt übrigens nicht im Editor auf, sondern nur wenn Excel neu gestartet wird...?
AW: Modul und Klassenmodul
10.02.2019 12:49:13
Nepumuk
Hallo Frank,
teste mal:
Public Sub MoveForm(ByRef mobjUserFrom As Object)
    Dim lngptrhWnd As LongPtr
    Dim udtRectangle As RECT
    Dim lngScreenWidth As Long, lngScreenHeight As Long
    lngScreenWidth = GetSystemMetrics(SM_CXSCREEN)
    lngScreenHeight = GetSystemMetrics(SM_CYSCREEN)
    On Error Resume Next
    Do
        Call Err.Clear
        With mobjUserFrom
            If .Left < 0 Or .Top < 0 Then
                .Left = Application.Max(0, .Left)
                .Top = Application.Max(0, .Top)
            Else
                .Left = Application.Min(.Left, lngScreenWidth * 0.75 - .Width)
                .Top = Application.Min(.Top, lngScreenHeight * 0.75 - .Height - _
                    (udtRectangle.Bottom - udtRectangle.Top) * 0.75)
            End If
        End With
        DoEvents
    Loop Until Err.Number = 0
End Sub

Gruß
Nepumuk
AW: Modul und Klassenmodul
10.02.2019 14:36:09
Frank
Hallo Nepumuk,
der Code würde eigentlich funktionieren, aber ich habe folgende Besonderheit in meiner Arbeitsmappe gespeichert:
Private Sub Workbook_Open()
Application.Visible = False
UserForm1.Show
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Visible = True
Application.Quit
End Sub
Das bewirkt, das nach dem Aufruf von UserForm2 keine UserForm mehr zu sehen ist, und da ich Application.Visible = False gesetzt habe, habe ich keine Steuerung mehr von Ecxel.
Hier hilft nur ein Neustart des Rechners.
Setze ich aber Application.Visible nicht auf False funktioniert auch dein Code...?
Zusätzlicher Hinweis meiner Erfahrungen bisher:
Setze ich meinen "Störcode" von UserForm_Initialize() in UserForm_Activate() ein würde es auch mit deinem vorherigen Code mit dem "Nachteil von Activate" (= wird bei jedem erneuten Aufruf gestartet)funktionieren.
Gruß Frank.
AW: Modul und Klassenmodul
10.02.2019 14:44:52
Frank
und noch was anderes ist mir aufgefallen zum Modul "scrollen in ListBox":
Private Sub CheckBox1_Click()
Call UnhookMouse 'Modul4
End Sub
Diese Funktion funktioniert nicht - ist das so vorgesehen?
Es soll bewirken, wenn CheckBox1 aktiviert ist, soll ListBox1 gesperrt sein.
ListBox ist gesperrt, aber scrollen ist noch möglich...
Gruß Frank.
AW: Modul und Klassenmodul
10.02.2019 15:02:26
Frank
Edit zu Call UnhookMouse:
Funktioniert natürlich, habe den Code angepasst:
Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If CheckBox1.Value = False And CheckBox2.Value = False Then
Call HookMouse(ListBox1) 'Modul4
End If
End Sub
Wäre nur noch das vorherige Problem...
Gruß Frank.
AW: Modul und Klassenmodul
10.02.2019 15:10:13
Nepumuk
Hallo Frank.
du erwartest hoffentlich nicht, dass ich aus ein paar Codeschnipsel deine Mappe rekonstruiere. Also erstelle eine Mustermappe und lade sie hoch.
Eine unsichtbare Excelmappe kannst du hart über den Taskmanager beenden. Besser du öffnest irgendeine vorhandene Excelmappe (aber nicht eine die beim Start schon die Application ausblendet).
Gruß
Nepumuk
AW: Modul und Klassenmodul
10.02.2019 15:31:12
Frank
Hallo Nepumuk,
erwarten tue ich von dir nichts, aber für deine bisherige Arbeit bin ich dir natürlich sehr zum Dank verpflichtet.
Ich habe auch schon eine Beispielmappe bereitgestellt, in welcher nur die UserFormen und die Codes beinhaltet, welche Probleme machen.
Leider lässt sich dort der Fehler nicht reproduzieren und läuft fehlerfrei durch, somit bringt es auch nichts, diese Mappe zur Überprüfung bereitzustellen.
Sollte dir aber auch nichts besseres Einfallen, lasse ich den Code unter "Activate" anstatt unter "Initialize".
Viele Grüße, Frank.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige