Code Proplem
18.07.2008 01:50:00
Heiko
ich habe da ein Problem mit einem Code. Ich hoffe ihr könnt mir helfen. Das ist der Code von der UF wo die Werte in die bestimmten Zellen eingetragen werden.
Private Sub CommandButton1_Click()
Dim Zei As Long, N As Integer
Application.ScreenUpdating = False
For Zei = 4 To 26 Step 2
Cells(Zei, 91) = Me.Controls("TextBox" & N + 1)
Cells(Zei, 92) = Me.Controls("TextBox" & N + 2)
Cells(Zei, 93) = Me.Controls("TextBox" & N + 3)
Cells(Zei, 94) = Me.Controls("TextBox" & N + 4)
Cells(Zei, 95) = Me.Controls("TextBox" & N + 5)
Cells(Zei, 96) = Me.Controls("TextBox" & N + 6)
N = N + 6
Next Zei
Application.ScreenUpdating = True
Unload Me
Spiel77.Show
End Sub
Dieser Code setzt bei übereinstimmung ein Diagonales Kreutz in die Zelle. Wenn ich nun in der UF keine Zahlen eintrage und auf übernehmen gehe sollten die Diagonalen Kreutze verschwinden. Das passiert aber nicht.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Zahl As Range
Dim Spiel As Range
Dim Tipp As Range
If Target.Column > Range("CR1").Column Then Exit Sub
If Target.Column
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim inControls As Integer
Select Case Target.Address
Case "$B$36", "$F$36", "$V$368", "$BP$36", "$V$34", "$Z$34", "$AD$34", "$AH$34", "$AL$ _
34", "$AP$34", "$AT$34", "$BP$34", "$BX$34", "$AX$41", "$BF$41", "$BX$41", "$CF$41"
Cancel = True
With Target
If .Borders(xlDiagonalUp).LineStyle = xlNone Then
With .Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With .Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
Else
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End If
End With
Case Else
End Select
End Sub
Was muß ich an der UF oder am Code ändern das es klappt. Bitte um hilfe.
Gruß Heiko