hücreden kodun içerisine tarih aktarmak

[BirTürk1]

Sub demo()
Dim saat1 As Date
Dim saat2 As Date
    saat1 = "15/10/2005"
    saat2 = Date
    If saat2 > saat1 Then
        MsgBox ("Süreniz dolmuş üzgünüm.")
        ActiveWorkbook.Close
    End If
    MsgBox ("Kullanım için " & saat1 - saat2 & " gününüz kalmıştır.") If sure1 = sure2 Then
    MsgBox "Bu gün SON GÜN"
    End If
End Sub

bu kodu ne şekilde değiştirirsek tarihi sayfa1 b2 hücresinden alır
veya başka formül varmı?
veya sayfa1 b sütununun son dolu satırında yazan tarihi alsın

 

[alibaskan]

Kodlarınızda hatalar mevcut bu haliyle çalışmıyor. Hataları düzelttim. Tarihi B2 satırı ve B sütununun son satırından alacak şekilde hazırladığım dosyalar ektedir.

 

[hamitcan]

B2 için : [B2]
B sütununun son dolu satırı için : Cells([b65536].End(3).Row,"b")

 

[BirTürk1]

yardımlarınız için teşekkür ederim

 

[BirTürk1]

yalnız bir sorun var b sütununda veri yoksa hata veriyor kodlar çalışmayı durduruyor hücreler boş ise kodun o kısmın atlamasını sağlamak mümkünmü

 

[hamitcan]

İf [b2] <> empty then tarih = [b2] şeklinde kullanabilirsiniz.

 

[BirTürk1]

teşekkür ederim sayın hamitcan

        Dim exdate As Date
    exdate = Cells([b65536].End(3).Row, "b")
    If Date > exdate Then
        MsgBox ("Bu Dosya Önceki Döneme Ait Bu Dosya Üzerinde Değişiklik Yapmayınız!")
            MsgBox ("Değişiklik Yapabileceğinzi Son Tarih Olan " & exdate & "  Tarihini  " & exdate - Date & "Gün Geçtiniz")
    End If

kodlar içerisine

İf [b2] <> empty then tarih = [b2]

kodunu nasıl yerleştirmem gerekiyor çalıştıramadım

 

[alibaskan]

Saat2 = Date
satırının altına aşağıdaki satırı ekleyin
If saat1 = "00:00:00" Then Exit Sub

saat1 = [B2] demedim çünkü B sütunu boşsa [B2] de boştur demektir. Dolayısıyla yine hata verecektir.

 

[BirTürk1]

SAYIN ALİBAŞKAN TEŞEKKÜR EDERİM FAKAT PROBLEMİM DEVAM EDİYOR TYPE MİSMATCH DİYE BİR HATA ÇIKTI ACABA KODUN MONTAJINIMI YANLIŞ YAPTIM YARDIMCI OLURSANIZ SEVİNİRİM

Dim exdate As Date
exdate = Cells([b65536].End(3).Row, "b")
If Date > exdate Then
MsgBox ("Bu Dosya Önceki Döneme Ait Bu Dosya Üzerinde Değişiklik Yapmayınız!")
MsgBox ("Değişiklik Yapabileceğinzi Son Tarih Olan " & exdate & " Tarihini " & exdate - Date & "Gün Geçtiniz")
If Date = "00:00:00" Then Exit Sub
End If

 

[alibaskan]

Dosyanın çalışır durumdaki son hali ektedir.

 

[BirTürk1]

Sayın ali başkan verdiğiniz örnekte hücreye değer girerken uyarı veriyor ben fu kodları normalde auto_open kullanmak istiyorum çalışmıyor özür dileyerek son kez yardımınızı istiyeceğim

 

[BirTürk1]

Sub Auto_Open()
    FORM.Show
Dim saat1 As Date
Dim saat2 As Date
    saat1 = Sheets("GÜNLÜK İŞ FORMU").Cells([b65536].End(3).Row, "b")
    saat2 = Date
    If saat1 = "00:00:00" Then Exit Sub
    If saat2 > saat1 Then
MsgBox ("Bu Dosya Önceki Döneme Ait Bu Dosya Üzerinde Değişiklik Yapmak Tamiri Mümkün Olmayan Veri Kayıplarına Yol Açabilir!")
MsgBox ("Değişiklik Yapabileceğinzi Son Tarih Olan " & saat1 & "  Tarihini  " & saat1 - saat2 & "Gün Geçtiniz")
    End If
End Sub

kodları bu şekilde değiştirerek hallettim.
emeği geçen herkese teşekkür ederim

 

[BirTürk1]

yanılmışım yine olmadı hata veriyor