Automatische Zeilenerweiterung funktioniert nicht!
22.08.2003 09:52:34
Chris
ich habe ein Problem!
Ich habe eine Tabelle in einem Arbeitsblatt, welches gesperrt ist, wenn in der ersten Spalte die Zeilen nicht mehr ausreichen, wird automatisch eine neue Zeile hinzugefügt!
Mein Makro funktioniert soweit einwandfrei, bis auf dass bei der neu eingefügten Zeile, wenn er diese umrandet er immer auf die letzte Zeile springt, anstatt auf der ersten Zeile bleibt!
Kann mir vielleicht jemand mein Makro anpassen?
LG Chris
Mein Makro:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Worksheets("Übungsblatt").Activate
ActiveSheet.Unprotect "6666"
Dim i As Integer
Dim k As Integer
Dim l As Integer
If Target.Column = 1 And Target.Row > 44 Then
If Target.Value <> "" Then
Rows(Target.Row + 1).Insert
For i = 45 To 60
With Cells(i, 11)
ActiveSheet.Unprotect "6666"
If .Borders(xlEdgeLeft).LineStyle = xlContinuous And _
.Borders(xlEdgeTop).LineStyle = xlContinuous And _
.Borders(xlEdgeBottom).LineStyle = xlContinuous And _
.Borders(xlEdgeRight).LineStyle = xlContinuous Then
.FormulaR1C1 = Cells(40, 11).FormulaR1C1
End If
End With
Next i
ElseIf Target.Row > 45 Then
If Range("A48").Value = "Bemerkung:" Then
GoTo ende
End If
Rows(Target.Row).Delete
Application.ScreenUpdating = True
End If
ende:
End If
'RAHMEN EINGÜGEN
For l = 1 To 12
For k = 45 To 60
Application.ScreenUpdating = False
If Cells(k, 1).Interior.ColorIndex = 15 Then
Range(Cells(k, l), Cells(k, l)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' .Borders.Weight = xlThin '--> MIT DIESEM MAKRO HAT ES
FUNKTIONIERT, ABER DIE
ANDEREN MAKRO STÖRT ES!!
End If
Next k
Next l
ActiveSheet.Protect "6666", DrawingObjects:=False
End Sub