Thomas Risi Softwareentwicklung

CTextBox (Klasse)

Diese Klasse stellt eine Verbindung zwischen einer TextBox in einer UserForm und einer Zelle in einem Excel-Tabellenblatt her.


Code für UserForm ...

Option Explicit Dim TClass(1) As New CTextBox ' Zwei Instanzen erstellen ' Eine 'UserForm' mit zwei TextBoxes, die direkt mit einer ' Zelle in einer Tabelle verbunden werden sollen. Wenn Sie ' mit xl2000 o. höher arbeiten, setzen Sie die 'ShowModal'- ' Eigenschaft der Userform auf 'False'. Private Sub UserForm_Activate() ' TextBox1 wird der Klasseninstanz 'TClass(0)' zugeordnet ... TClass(0).Create Me.TextBox1 ' und Textbox2 der Instanz 'TClass(1)'. TClass(1).Create Me.TextBox2 ' Den Klasseninstanzen eine Zellen zuweisen ... Set TClass(0).TargetCell = _ ActiveWorkbook.Worksheets.Item("Tabelle1").Range("C3") Set TClass(1).TargetCell = _ ActiveWorkbook.Worksheets.Item("Tabelle1").Range("G3") End Sub

Code für Klassenmodul (CTextBox) ...

Option Explicit Dim WithEvents TB As MSForms.TextBox Dim WithEvents WS As Excel.Worksheet Dim myTarget As Excel.Range Dim WFormats As Boolean Dim DefColor As Long Dim DefBold As Boolean Dim DefItalic As Boolean Public Function Create(TextBox As MSForms.TextBox) As Boolean Set TB = TextBox DefColor = TextBox.ForeColor DefBold = TextBox.Font.Bold DefItalic = TextBox.Font.Italic End Function Public Property Set TargetCell(Target As Excel.Range) Set myTarget = Target Set WS = Target.Worksheet On Error Resume Next TB.Text = Target.Value End Property Public Property Get TargetCell() As Excel.Range Set TargetCell = myTarget End Property Public Property Let WithFormat(Status As Boolean) WFormats = Status On Error Resume Next If Status Then TB.ForeColor = myTarget.Font.Color TB.Font.Bold = myTarget.Font.Bold TB.Font.Italic = myTarget.Font.Italic Else TB.ForeColor = DefColor TB.Font.Bold = DefBold TB.Font.Italic = DefItalic End If End Property Public Property Get WithFormat() As Boolean WithFormat = WFormats End Property Private Sub Class_Initialize() WFormats = False End Sub Private Sub Class_Terminate() Set WS = Nothing Set TB = Nothing Set myTarget = Nothing End Sub Private Sub TB_Change() On Error Resume Next myTarget.Value = TB.Text End Sub Private Sub WS_Change(ByVal Target As Range) On Error Resume Next If Target.Address = myTarget.Address Then TB.Text = Target.Value If WFormats Then TB.ForeColor = Target.Font.Color TB.Font.Bold = Target.Font.Bold TB.Font.Italic = Target.Font.Italic Else TB.ForeColor = DefColor TB.Font.Bold = DefBold TB.Font.Italic = DefItalic End If End If End Sub

Bewerten Sie bitte dieses Programm.
1 2 3 4 5
Weniger nützlich Sehr nützlich
Bitte teilen Sie uns mit, warum Sie das Programm so bewertet haben. (optional)