dosyadaki bilgiyi ve dosyayı silmek

[gurbuzs]

Merhaba 2 yıl önce yapmıştım ama bilgisayarım değişince dosyalarıma ulaşamadım.
Yapmak istediğim;
Macro'ya tarih gireceğim, mesela 1 Mayıs 2016 gibi. dosya açıldığında eğer ilgili tarihi geçtiyse dosya içeriğini silip save edip sonra da doayayı geri dönüşüm kutusuna gönderiyordu
Bu macroyu da aslında buradan bulmuştum ama tekrar aramama rağmen ulaşamadım.
Yardımınızı rica ederim

 

[antonio]

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:05"), "silinebilir"
End Sub

Devamındaki makroyu bir modüle yapıştırınız:

Sub silinebilir()
If Date >= CDate("12.02.2014") Then
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End If
End Sub

Aşağıdaki konu başlığı altında işlenmişti:
http://www.excel.web.tr/f48/belli-bir-tarihten-sonra-program-otomatik-silinsin-t101625.html

 

[gurbuzs]

teşekkürler antonio
peki silmeden önce sayfaları tespit edip içeriğini sil yapıp kaydedip sonra silebilir mi

 

[antonio]

teşekkürler antonio
peki silmeden önce sayfaları tespit edip içeriğini sil yapıp kaydedip sonra silebilir mi

Aşağıdaki şekilde yapılabilir:
Önce çalışma kitabının açılışında gereken kontrol yapılsın:

Private Sub Workbook_Open()
    Application.OnTime Now + TimeValue("00:00:02"), "silinebilir"
End Sub

Ekleyeceğimiz modüle bir kodda içerik temizlemek ve kaydetmek için ekliyoruz:

Sub silinebilir()
If Date >= CDate("12.02.2014") Then
    Call temizle
Application.DisplayAlerts = False
Application.Wait Now + TimeValue("00:00:02")
MsgBox "Şimdide silinecek!"
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End If
End Sub

Sub temizle()
Application.DisplayAlerts = False
For i = 1 To ThisWorkbook.Sheets.Count
With Sheets(i)
    .UsedRange.Clear
End With
Next i
ThisWorkbook.Save
MsgBox "Tüm sayfaların içeriği temizlendi. Dosya kaydedildi."
End Sub

Mesajların görüntülenmesini istemiyorsanız silersiniz.
Kolay gelsin.

 

[gurbuzs]

yardımlarınız için teşekkürler
işimi gördü