AW: Zeilen Nummerierung
20.01.2018 15:59:00
Marcus
Hallo,
sry das ich mich jetzt erst melde aber ging leider nicht eher...
Das ist die Sub für das übernehmen des eingetragenen Textes:
Private Sub xxxxx
With Worksheets("xxxx")
If Not Me.CheckBox1 And _
Not Me.CheckBox2 And _
Not Me.CheckBox3 Then
Form_blink
Exit Sub
End If
letzteZeile = .Cells(.Rows.Count, 1).End(xlUp).row + 1
.Cells(letzteZeile, 1) = letzteZeile - 5
.Cells(letzteZeile, 2) = Format(Now, "HH:MM") & " Uhr"
.Cells(letzteZeile, 2).HorizontalAlignment = xlCenter
.Cells(letzteZeile, 3).WrapText = True
.Cells(letzteZeile, 3) = xxxxx.text
.Cells(letzteZeile, 4).WrapText = True
.Cells(letzteZeile, 4) = xxxxx.text
If CheckBox1.Value Then
.Cells(letzteZeile, 5).Value = CheckBox1.Caption
Range(Cells(letzteZeile, 1), Cells(letzteZeile, 7)).Font.Color = vbBlack
End If
If CheckBox2.Value Then
.Cells(letzteZeile, 5).Value = CheckBox2.Caption
Range(Cells(letzteZeile, 1), Cells(letzteZeile, 7)).Font.Color = vbRed
End If
If CheckBox3.Value Then
.Cells(letzteZeile, 5).Value = CheckBox3.Caption
Range(Cells(letzteZeile, 1), Cells(letzteZeile, 7)).Font.Color = vbGreen
End If
.Cells(letzteZeile, 6).WrapText = True
.Cells(letzteZeile, 6) = xxxxx.Value
.Cells(letzteZeile, 7).WrapText = True
.Cells(letzteZeile, 7) = xxxxx.Value
.Rows(letzteZeile).AutoFit
.Rows(letzteZeile).VerticalAlignment = xlTop
With .Range(.Cells(letzteZeile, 1), .Cells(letzteZeile, 7))
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End With
xxxx.Text = ""
xxxx.Text = ""
xxxx.Text = ""
xxxx.Text = ""
CheckBox1 = False
CheckBox2 = False
CheckBox3 = False
End With
End Sub
Das ist die Sub für einen Nachtrag zur einer Zeile aus der Ersten:
Private Sub xxxx
EintragNr = CInt(UserForm3.TextBox1.Value)
Eintrag1 = xxxxxxxx
Eintrag2 = xxxxxxxx
Eintrag3 = TextBox1.Value
Bemerkung = TextBox2.Value
letzteZeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).row
For InsertPos = letzteZeile To 6 Step -1
Zelle1 = "A" & InsertPos
zeile = Range(Zelle1)
If zeile = EintragNr Then
Exit For
End If
Next InsertPos
Zelle1 = InsertPos + 1
Rows(Zelle1).Insert
Timestamp = Format(Now, "HH"":""MM""Uhr")
Cells(Zelle1, 1) = UserForm3.TextBox1.Value
Cells(Zelle1, 2) = "'" & Timestamp
Cells(Zelle1, 3) = Eintrag1
Cells(Zelle1, 4) = Eintrag2
Cells(Zelle1, 6).WrapText = True
Cells(Zelle1, 6) = Eintrag3
Cells(Zelle1, 7).WrapText = True
Cells(Zelle1, 7) = Bemerkung
Eintragszellen = "A" & Zelle1 & ":G" & Zelle1
SetBorders Eintragszellen
Range(Eintragszellen).Font.ColorIndex = 5
Range(Eintragszellen).VerticalAlignment = xlCenter
xxxx.Text = ""
xxxx.Text = ""
xxxx.Text = ""
xxxx.Text = ""
Unload Me
UserForm2.Show
End Sub
Ich hoffe das hilft euch.