Hallo Bastrong,
hier der komplette UF-Code:
Dialog UserForm1Option Explicit
Private Sub CommandButton2_Click() 'Button "Schließen ohne Änderungen"
Unload Me
End Sub
Private Sub CommandButton4_Click() 'Button "Übernehmen und Schließen"
Dim i As Long, j As Long
Cells(Me.Tag, 2).Value = TextBox2.Text 'Infor
Cells(Me.Tag, 3).Value = TextBox3.Text 'Kunde
Cells(Me.Tag, 4).Value = TextBox4.Text 'Ort
Cells(Me.Tag, 5).Value = TextBox5.Text 'Vertretung
Cells(Me.Tag, 6).Value = TextBox6.Text 'Datum
Cells(Me.Tag, 7).Value = TextBox7.Text 'Anfrage-Datum
Cells(Me.Tag, 32).Value = TextBox8.Text 'Angebotswert
Cells(Me.Tag, 34).Value = TextBox10.Text 'Bemerkung
Cells(Me.Tag, 10).Value = TextBox11.Text 'ID
If TextBox11.Value = True Then 'Wenn Textbox Wert bekommt, dann "O" + Range wird farblich markiert
Range("J6:L6").Interior.ColorIndex = 38
Cells(6, 12).Value = "O"
Else
Range("J6:L6").Interior.ColorIndex = xlNone
Cells(6, 12).Value = ""
End If
Cells(Me.Tag, 13).Value = TextBox12.Text 'ID
Cells(Me.Tag, 16).Value = TextBox13.Text 'ID
Cells(Me.Tag, 19).Value = TextBox14.Text 'ID
Cells(Me.Tag, 22).Value = TextBox15.Text 'ID
Cells(Me.Tag, 25).Value = TextBox16.Text 'ID
Cells(Me.Tag, 28).Value = TextBox17.Text 'ID
Cells(Me.Tag, 33).Value = TextBox18.Text 'Bestellwert
Cells(Me.Tag, 11).Value = ComboBox1.Text 'Typ
Cells(Me.Tag, 14).Value = ComboBox2.Text 'Typ
Cells(Me.Tag, 17).Value = ComboBox3.Text 'Typ
Cells(Me.Tag, 20).Value = ComboBox4.Text 'Typ
Cells(Me.Tag, 23).Value = ComboBox5.Text 'Typ
Cells(Me.Tag, 26).Value = ComboBox6.Text 'Typ
Cells(Me.Tag, 29).Value = ComboBox7.Text 'Typ
Cells(Me.Tag, 9).Value = ComboBox8.Text 'Typ
'------ "Kunde hat Bestellt - Checkbox1" / Beginn -------
With Cells(Me.Tag, 1).Resize(1, 35)
'nur wenn momentaner Wert von ursprünglichem Wert abweicht
If CBool(CheckBox1.Value) <> CheckBox1.Tag Then
If CheckBox1.Value = True Then
.Borders.LineStyle = xlContinuous
Range("A6:I6").Interior.ColorIndex = 35
Range("Ae6:Ai6").Interior.ColorIndex = 35
.Cells(1, 9).Value = "X"
Else
.Borders.LineStyle = xlNone
.Interior.ColorIndex = xlNone
.Cells(1, 9).Value = ""
End If
End If
End With
'------ "Kunde hat Bestellt - Checkbox1" / Ende -------
'------ "Angebot verfolgt - Checkbox9" / Beginn -------
With Cells(Me.Tag, 20)
'nur wenn momentaner Wert von ursprünglichem Wert abweicht
If CBool(CheckBox9.Value) <> CheckBox9.Tag Then
If CheckBox9.Value = True Then
.Interior.ColorIndex = 10
.Borders.LineStyle = xlContinuous
If Len(TextBox20.Text) Then
If Len(LabelKommentar) Then
Cells(Me.Tag, 9).Comment.Text LabelKommentar & vbNewLine & _
Format(Date, "dd-mmm-yyyy") & vbNewLine & TextBox20.Text
Else
Cells(Me.Tag, 9).Comment.Text Format(Date, "dd-mmm-yyyy") & vbNewLine & TextBox20.Text
End If
End If
Else
.Borders.LineStyle = xlNone
.Interior.ColorIndex = xlNone
End If
End If
End With
'------ "Angebot verfolgt - Checkbox9" / Ende -------
j = 1
For i = 10 To 28 Step 3
j = j + 1 'Schleife für CheckBoxen 2 - 8
With Cells(Me.Tag, i).Resize(1, 3)
'nur wenn momentaner Wert von ursprünglichem Wert abweicht
If CBool(Me.Controls("CheckBox" & j).Value) <> Me.Controls("CheckBox" & j).Tag Then
.Borders.LineStyle = xlContinuous
If Me.Controls("CheckBox" & j).Value = True Then
.Interior.ColorIndex = 35
.Cells(1, .Cells.Count).Value = "B"
Else
.Interior.ColorIndex = 38
.Cells(1, .Cells.Count).Value = "O"
End If
End If
End With
Next i
Unload Me
End Sub
Private Sub UserForm_Activate()
Dim i As Long
Dim oComment As Comment
Dim varTyp As Variant
Me.Tag = ActiveCell.Row 'Zeilennummer der aktiven Zelle wird gespeichert
TextBox1.Enabled = False 'Textbox1 ist schreibgeschützt
TextBox1.Text = Cells(Me.Tag, 1).Value 'Angebots-Nr.
TextBox2.Text = Cells(Me.Tag, 2).Value 'Infor
TextBox3.Text = Cells(Me.Tag, 3).Value 'Kunde
TextBox4.Text = Cells(Me.Tag, 4).Value 'Ort
TextBox5.Text = Cells(Me.Tag, 5).Value 'Vertretung
TextBox6.Text = Cells(Me.Tag, 6).Value 'Datum
TextBox7.Text = Cells(Me.Tag, 7).Value 'Anfrage-Datum
TextBox8.Text = Cells(Me.Tag, 32).Value 'Angebotswert
TextBox10.Text = Cells(Me.Tag, 34).Value 'Bemerkung
TextBox11.Text = Cells(Me.Tag, 10).Value 'ID
TextBox12.Text = Cells(Me.Tag, 13).Value 'ID
TextBox13.Text = Cells(Me.Tag, 16).Value 'ID
TextBox14.Text = Cells(Me.Tag, 19).Value 'ID
TextBox15.Text = Cells(Me.Tag, 22).Value 'ID
TextBox16.Text = Cells(Me.Tag, 25).Value 'ID
TextBox17.Text = Cells(Me.Tag, 28).Value 'ID
TextBox18.Text = Cells(Me.Tag, 33).Value 'Bestellwert
'###### Kommentar - Anfang ######
With Cells(Me.Tag, 9)
If Not .Comment Is Nothing Then
Set oComment = .Comment
Else
Set oComment = .AddComment
oComment.Shape.OLEFormat.Object.AutoSize = True
End If
End With
LabelKommentar.Caption = oComment.Text
'##### Kommentar - Ende #####
CheckBox1 = Cells(Me.Tag, 9).Value = "X"
CheckBox2 = Cells(Me.Tag, 12).Value = "B"
CheckBox3 = Cells(Me.Tag, 15).Value = "B"
CheckBox4 = Cells(Me.Tag, 18).Value = "B"
CheckBox5 = Cells(Me.Tag, 21).Value = "B"
CheckBox6 = Cells(Me.Tag, 24).Value = "B"
CheckBox7 = Cells(Me.Tag, 27).Value = "B"
CheckBox8 = Cells(Me.Tag, 30).Value = "B"
' CheckBox9 = Cells(Me.Tag, ??).Value = "?" '<<< hier ergänzen!
'Momentane CheckBoxwerte werden im jeweiligen Tag der Checkboxen gespeichert
For i = 1 To 9
Me.Controls("CheckBox" & i).Tag = CBool(Me.Controls("CheckBox" & i).Value)
Next i
'Comboboxen füllen und einstellen
With Sheets("Vorlage")
varTyp = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
ComboBox8.List = .Range(.Cells(3, 8), .Cells(.Rows.Count, 8).End(xlUp)).Value
ComboBox8.Value = Cells(Me.Tag, 8).Value
End With
For i = 1 To 7
Me.Controls("ComboBox" & i).List = varTyp
Me.Controls("ComboBox" & i).Value = Cells(Me.Tag, (i + 2.7) * 3).Value
Next i
End Sub
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0
Beachte den Kommentar zur CheckBox9 im Code.
Gruß Uwe
