Problem mit Programmiercode
20.06.2007 13:12:00
Losos
ich habe ein Problem mit einem Code.
Den Codebeispiel habe ich hier in Forum gefunden und an meine Anwendung anpassen wollen.
Leider sind meine Kenntnisse nicht ausreichend um den Code zu nutzen und brauche Hilfe.
Der angehängte Code-Auszug ist zu beseren Darstellungs meines Problems gedacht.
Auf dem UserForm1 habe ich 2 TextBoxen, wenn ich den Code über ein DoppelClick (TextBox1) aufrufe wird ColorPicker1 gezeigt und ich kann meine Farben ( Hintergrund und Schriftfarbe) auswählen, und die Farben auf dem Tabelleblatt ändern. Ferner werden auch Texte aus dem TextBox übernehmen.
Ich habe aber mehrere TextBoxen die mit unterschiedlichen Farben versehen wollte.
Leider kann ich den Code nur an das eine TextBox zuordnen.
Wenn ich den Code für das zweite TextBox (kopiert und angepasst) auch mit DoppelClick anspreche bricht daß ganze zusammen weil die erste ist noch ofen. Also muss ich jedes mal erst das erste ColorPicker schliesen um das zweite zu öfnen.
Aber wenn ich an die 20 TextBoxen habe und für alle fast das gleiche Code schreiben muss wird das sehr unübersichtlich.
Kann man es vereinfachen?
Hier ist der Code:
Public clrArt As Boolean
Sub ColorPicker1()
Dim dlgFarben As DialogSheet
Dim btnOK As Button, btnCancel As Button
Dim optInterior As OptionButton, optFont As OptionButton
Dim txtClr As TextBox
Dim intRow As Integer, intCol As Integer
Dim l As Integer, t As Integer, intClr As Integer
Application.ScreenUpdating = False
Set dlgFarben = DialogSheets.Add
With dlgFarben
.Name = "dlgFarben"
With .DialogFrame
.Top = 0
.Left = 0
.Height = 200
.Width = 170
.Caption = "Farben Picker"
End With
l = 15
t = 15
Set optInterior = .OptionButtons.Add(l, t, 75, 15)
optInterior.Caption = "Hintergrundfarbe"
optInterior.Value = xlOn
Set optFont = .OptionButtons.Add(l + 75, t, 75, 15)
optFont.Caption = "Schriftfarbe"
t = t + 20
For intRow = 1 To 7
l = 15
For intCol = 1 To 8
intClr = intClr + 1
Set txtClr = .TextBoxes.Add(l, t, 16, 16)
With txtClr
.Interior.ColorIndex = intClr
.OnAction = "FarbAuswahl1"
.Name = "clr" & intClr
End With
l = l + 18
Next intCol
t = t + 18
Next intRow
Set btnOK = .Buttons(1)
Set btnCancel = .Buttons(2)
btnOK.Top = 180
btnOK.Left = 25
btnCancel.Top = 180
btnCancel.Left = 100
Worksheets(1).Select
.Show
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub
Sub FarbAuswahl1()
Dim strAc As String
Worksheets("Tabelle1").Select
Range("a1").Select
Application.ScreenUpdating = True
strAc = Application.Caller
If DialogSheets("dlgFarben").OptionButtons(1).Value = xlOn Then
Selection.Interior.ColorIndex = CInt(Right(strAc, Len(strAc) - 3))
UserForm1.TextBox1.BackColor = Selection.Interior.Color
Else
Selection.Font.ColorIndex = CInt(Right(strAc, Len(strAc) - 3))
UserForm1.TextBox1.ForeColor = Selection.Font.Color
End If
End Sub