Çift Tıklama İle Sayfaya Doğru ve Yanlış Yazdırma Yardımı

[Believing]

Sayın Uzman Arkadaşlar,

Aşağıdaki kod ile "H3:H1000" aralığındaki istenilen hücreye çift tıklayarak sadec "Doğru" kelimesini yazdırabiliyorum. Oysa ilk iki tıklama ile "Doğru" kelimesini, sonraki çift tıklama ile "Yanlış" ifadesini ve daha sonraki çift tıklama ile de hücreyi boş bırakmasını nasıl sağlayabilirim.

Saygılarımla.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [H3:H1000]) Is Nothing Then Exit Sub
On Error Resume Next
If Target = "" Then
Target = "Doğru"
Target.Offset(0, 1).Select
End If
End Sub

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Dim Say As Byte

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("H3:H1000")) Is Nothing Then Exit Sub
    On Error Resume Next
    Cancel = True
    Say = Say + 1
    Select Case Say
        Case 1: Target = "Doğru"
        Case 2: Target = "Yanlış"
        Case 3: Target = ""
    End Select
    If Say = 3 Then Say = 0
End Sub

 

[Muzaffer Ali]

Alternatif olsun.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [H3:H1000]) Is Nothing Then Exit Sub
    On Error Resume Next
    Cancel = True
    Select Case Target.Value
    Case ""
        Target = True
    Case True
        Target = False
    Case False
        Target = ""
    End Select
End Sub

 

[Believing]

Sayın Korhan Ayhan ve Dalgalikur,

Yardımınız ve konuya gösterdiğini ilgi için sizlere çok teşekkür ederim.
ALLAH sizlerden razı olsun.

Saygılarımla.