Çözüldü Kod Düzeni

[MESUT K]

Herkese Merhaba

Aşağıda yazılı kod düzeni var.Kodlar birincisi takvimi,ikinci saat-zaman çizelgesini açıyor.

Benim istediğim;
açılır takvimin sadece F21,F23,F32,F37 hücrelerine tıklayınca açılmasını istiyorum

saat-zaman çizelgesinin G23 hücresine tıklayınca açılmasını istiyorum

Konu ile ilgili yardımlarınızı istiyorum

Saygılarımla

-----------------------------------------------------------------------------------------------------

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("F21")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Cancel = True
If Target.Address <> Range("F21").Address Then
takvim.Show
If tarih <> Empty Then
'Target = CDate(tarih) 'tarih formatına çeviriyor
Target = Format(tarih, "dd.mm.yyyy")
End If
End If
End If
If Not Application.Intersect(Target, Range("G:G")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Cancel = True
If Target.Address <> Range("G23").Address Then
zaman.Show

End If
End If

End Sub

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("F21, F23, F32, F37")) Is Nothing Then GoTo 10
If Target.Count > 1 Then Exit Sub
Cancel = True
takvim.Show
If tarih <> Empty Then
    'Target = CDate(tarih) 'tarih formatına çeviriyor
    Target = Format(tarih, "dd.mm.yyyy")
End If
10:
If Intersect(Target, Range("G23")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Cancel = True
zaman.Show

End Sub

 

[Muzaffer Ali]

Bu da alternatif olsun.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Cancel = True
    If Not Application.Intersect(Target, Range("F21,F23,F32,F37")) Is Nothing Then
        takvim.Show
        Target = Format(tarih, "dd.mm.yyyy")
    ElseIf Not Application.Intersect(Target, Range("G23")) Is Nothing Then
        zaman.Show
    End If
End Sub

 

[MESUT K]

Aşağıdaki gibi deneyin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("F21, F23, F32, F37")) Is Nothing Then GoTo 10
If Target.Count > 1 Then Exit Sub
Cancel = True
takvim.Show
If tarih <> Empty Then
    'Target = CDate(tarih) 'tarih formatına çeviriyor
    Target = Format(tarih, "dd.mm.yyyy")
End If
10:
If Intersect(Target, Range("G23")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
Cancel = True
zaman.Show

End Sub

Çok teşekkür ederim kod çalışıyor

 

[MESUT K]

Bu da alternatif olsun.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Cancel = True
    If Not Application.Intersect(Target, Range("F21,F23,F32,F37")) Is Nothing Then
        takvim.Show
        Target = Format(tarih, "dd.mm.yyyy")
    ElseIf Not Application.Intersect(Target, Range("G23")) Is Nothing Then
        zaman.Show
    End If
End Sub

Çok teşekürler bu kodda çalışıyor