Rahmen in Zellen abhängig von letzter Zelle
27.10.2014 21:05:47
letzter
Ich habe ein Projekt indem ich in einer Zelle einen Rahmen machen will wenn ich mit dem Cursor eine Zelle weiter gehe. Je nach dem in welche Richtung es geht wird entweder ein Diagonale up, -down oder bottom oder right Rahmen gemacht.
Leider hängt mein Coder gerade beim Rahmen machen. Was mache ich falsch?
Ach ja am besten lässt sich meine Idee erklären mit: Von der ersten Zelle aus wird im Prinzip mit der unteren rechten Ecke der Zelle "gezeichnet".
'Gestartet wir in der Codefenster des Sheets:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Value = Target.Column & Target.Row
Call Zeichnen(Target.Row, Target.Column)
Cancel = True
End Sub
Dann gehts in ein Modul:
Sub Rahmen(mySeite As Variant, myRange As Range)
With Range(myRange)
.Borders (mySeite)
With .Borders
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End With
End Sub
'-->Das mySeite objekt gibt an welche art von Rahmen es sein soll. Leider ist der Typ unverträglich.
Sub Zeichnen(strRow As String, strCol As String)
Dim myLine As Variant
Dim rowNow As String
Dim colNow As String
Dim rowBefore As String
Dim colBefore As String
Dim diagDown1 As String
Dim diagDown2 As String
Dim diagUp1 As String
Dim diagUp2 As String
Dim bottom1 As String
Dim bottom2 As String
Dim right1 As String
Dim right2 As String
diagDown1 = "n1n1"
diagDown2 = "11"
diagUp1 = "n11"
diagUp2 = "1n1"
bottom1 = "0n1"
bottom2 = "01"
right1 = "n10"
right2 = "10"
Dim myWeiche As String
Dim myTest As String
If rowBefore = "" And colBefore = "" Then _
rowBefore = 3 'Ich starte hier einfach bei Zelle C3 wenns das erste mal ist
colBefore = 3 'den Fall muss ich noch irgendwie abfangen.
myTest = Replace(CStr((CInt(strRow) - CInt(rowBefore) & CInt(strCol) - CInt(colBefore))), "-", "n")
If myTest = "00" Then
If StrComp(myTest, diagDown1) Or StrComp(myTest, diagDown1) = 0 Then myWeiche = "Down"
ElseIf StrComp(myTest, diagUp1) Or StrComp(myTest, diagUp2) = 0 Then myWeiche = "Up"
ElseIf StrComp(myTest, bottom1) Or StrComp(myTest, bottom2) = 0 Then myWeiche = "Bottom"
ElseIf StrComp(myTest, right1) Or StrComp(myTest, right2) = 0 Then myWeiche = "Right"
ElseIf StrComp(myTest, diagDown1) Or StrComp(myTest, diagDown1) Or StrComp(myTest, diagUp1) Or StrComp(myTest, diagUp2) Or _
StrComp(myTest, bottom1) Or StrComp(myTest, bottom2) Or StrComp(myTest, right1) Or StrComp(myTest, right2) = Null Then MsgBox ("NULL")
End If
'MsgBox ("-1 , -1" & " " & (strRow - rowBefore) & " , " & (strCol - colBefore))
Select Case myWeiche
Case "Down"
myLine = "xlDiagonalDown"
Call Rahmen(myLine, ActiveCell)
Case "Up"
myLine = "xlDiagonalUp"
Call Rahmen(myLine, ActiveCell)
Case "Bottom"
myLine = "xlEdgeBottom"
Call Rahmen(myLine, ActiveCell)
Case "Right"
myLine = "xlEdgeRight"
Call Rahmen(myLine, ActiveCell)
Case "Zero"
End Select
rowBefore = ActiveCell.Row
colBefore = ActiveCell.Column
End Sub