Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
code
End Sub
hallo werner
geh mal so vor:
füge einen commandbtton aus der steuerelementetoolbox in deine tabelle ein.
dann eine doppelclick darauf.
(Alternativ:
rechte maus
code anzeigen)
dann kommt ein fenster das sieht etwa so aus:
Private Sub CommandButton1_Click()
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
'code
'
End Sub
jetzt schneidest du mal
'
'code
'
aus und fügst ihn hier ein.
Private Sub CommandButton1_Click()
'
'code
'
End Sub
bestimmt wirst du laufzeitfehler bekommen weil der code im
Private Sub Worksheet_BeforeDoubleClick auf target zugeschnitten ist. die kann man aber
korrigieren.
wenn du es nicht schaffst, lade mal eine beispieltabelle mit dem code drin hoch.
ransi
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' Diagonalen in Zelle
Dim RaBereich As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("B3:K25")
' ActiveSheet.Unprotect
' überprüfen ob Zelle im vorgegebenen Bereich
If Not Intersect(Target, RaBereich) Is Nothing Then
' Diagonalen
' dieser Vergleich (ob linien schon vorhanden sind)
If Target.Borders(xlDiagonalDown).LineStyle = 1 Then
With Target
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
Else
With Target
.Borders(xlDiagonalDown).LineStyle = xlContinuous
.Borders(xlDiagonalDown).Weight = xlThick
.Borders(xlDiagonalUp).LineStyle = xlContinuous
.Borders(xlDiagonalUp).Weight = xlThick
.Borders(xlDiagonalUp).ColorIndex = xlAutomatic
End With
End If
Cancel = True
End If
Set RaBereich = Nothing
' ActiveSheet.Protect
End Sub
hallo werner
habe einfach target durch activecell ersetzt.
Private Sub CommandButton1_Click()
Dim RaBereich As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("B3:K25")
' ActiveSheet.Unprotect
' überprüfen ob Zelle im vorgegebenen Bereich
If Not Intersect(ActiveCell, RaBereich) Is Nothing Then
' Diagonalen
' dieser Vergleich (ob linien schon vorhanden sind)
If ActiveCell.Borders(xlDiagonalDown).LineStyle = 1 Then
With ActiveCell
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
Else
With ActiveCell
.Borders(xlDiagonalDown).LineStyle = xlContinuous
.Borders(xlDiagonalDown).Weight = xlThick
.Borders(xlDiagonalUp).LineStyle = xlContinuous
.Borders(xlDiagonalUp).Weight = xlThick
.Borders(xlDiagonalUp).ColorIndex = xlAutomatic
End With
End If
End If
Set RaBereich = Nothing
' ActiveSheet.Protect
End Sub
ransi