Klassenmodul-Enter bzw. Exit Anweisungen fehlen
07.01.2004 14:42:21
GraFri
Habe in einer Userform 20 Textboxen. Bei diesen ändere ich mittels Klassenmodul bei Mausberührung die Hintergrundfarbe. Die Enter bzw. Exit Anweisungen fehlen aber leider im Klassenmodul. Daher setze ich die Farbe aller Textboxen per Code in der Userform zurück. Es wäre einfacher, die Exit-Anweisung im Klassenmodul zu verwenden. Bei der Userform sind sie vorhanden, im Klassenmodul nicht. Warum? Vielleicht kennt jemand eine andere Lösung.
'Anfang--------------------------------------------
'Code Userform:
Private oTextBox() As clsTextBox
Private NewTextBox As Control
Private Sub UserForm_Initialize()
Dim a As Long
'TextBoxen
a = 1
For Each objAlle In Me.Controls
If TypeName(objAlle) = "TextBox" Then
ReDim Preserve oTextBox(1 To a)
Set NewTextBox = Controls(objAlle.Name)
Set oTextBox(a) = New clsTextBox
oTextBox(a).Initialise NewTextBox, a
a = a + 1
End If
Next objAlle
End Sub
'Farbe zurücksetzen (Textboxen sind im Frame 'frmDaten'
Private Sub frmDaten_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
'TextBoxen
For Each objAlle In Me.frmDaten.Controls
If TypeName(objAlle) = "TextBox" Then
objAlle.BackColor = &H80000005
End If
Next objAlle
End Sub
'--------------------------------------------------
'Code Klassenmodul 'clsTextBox'
Option Explicit
Option Compare Text
Private WithEvents zoTextBox As MSForms.TextBox
Private zlIndex As Long
Private Sub zoTextBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
zoTextBox.BackColor = &HFFFFC0
End Sub
Private Sub zoTextBox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
zoTextBox.BackColor = &HFFFFC0
End Sub
Private Sub zoTextBox_Gotfocus(ByVal Cancel As MSForms.ReturnBoolean)
zoTextBox.BackColor = &H80000005
End Sub
Sub Initialise(oControl As Object, lControlIndex As Long)
zlIndex = lControlIndex
Select Case TypeName(oControl)
Case "TextBox"
Set zoTextBox = oControl
Case Else
Stop 'Unregistrierte Type
End Select
End Sub
Property Get Index() As Long
Index = zlIndex
End Property
Function Control(sName As String) As Object
Select Case sName
Case "TextBox"
Set Control = zoTextBox
Case Else
Stop
End Select
End Function
Private Sub Class_Terminate()
Set zoTextBox = Nothing
End Sub
'Ende----------------------------------------------
Danke für jede Hilfe
mfg, GraFri
Anzeige