Açık Dosyayı Otomatik Kapatmak

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

haydargenc

Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Merhaba,

Bir konuda destek rica ediyorum.
Bir excel dosyasının açık unutulması durumunda yeni kayıt yapılamıyor.
Bu nedenle açıldıktan 10dk sonra, uyarı mesajı vererek, otomatik kapanması gerekiyor. Dosya simge durumuna gelmişse yada bilgisayar dinlenmeye, ekran koruyucu moduna geçmişse dahi kapanmalı...
Elimde aşağıdaki kod var. Ama başka bir dosyanın modülüne yapıştırdığımda çalışmıyor. Yani kodu istediğim hangi dosyaya yerleştirirsem çalışması gerekiyor.
Yeni kodu olan vars gönderirse sevinirim. Aşağıdaki kodda değişiklikler gerekiyorsa yine destek rica ediyorum..


Sub Kapat()
Application.OnTime Now + TimeValue("00:10:00"), "Uyar"
End Sub
Sub Uyar()
Dim Mesaj As Object
On Error Resume Next
Hata.Clear
Set Mesaj = CreateObject("WScript.Shell")
If Hata <> 0 Then
MsgBox "Hataor:" & Hata
Else
Mesaj.PopUp "Çalışma Dosyanız 1 Dakika sonra kapanacaktır.", 5, "UYARI", vbOKOnly + vbExclamation
End If
Set Mesaj = Nothing
Application.OnTime Now + TimeValue("00:00:55"), "KaydetKapat"
End Sub
Sub KaydetKapat()
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
 
Excelde Ajanda Tutulmasını Sağlama
Tarih Geldiğinde İlgiliye Otomatik E-Posta Gönderme
Tarihe göre sırala Oylamaya göre sırala
Dosyalarınızın uzantısının xlsm olduğuna dikkat ediniz.
İkinci olarak da dosyanın açılışında Kapat makrosunu çağırmalısınız.
Ve çağırılan kapat makrosunda gelen uyarıya tamam demediğiniz sürece dosya kapanmayacaktır.

Modüle içerisine yazılacak kod :

Kod: 
Sub Kapat()
Application.OnTime Now + TimeValue("00:10:00"), "Uyar"
End Sub
Sub Uyar()
Dim Mesaj As Object
On Error Resume Next
Hata.Clear
Set Mesaj = CreateObject("WScript.Shell")
If Hata <> 0 Then
MsgBox "Hataor:" & Hata
Else
Mesaj.PopUp "Çalışma Dosyanız 1 dakika sonra kapanacaktır.", 5, "UYARI", vbOKOnly + vbExclamation
End If
Set Mesaj = Nothing
Application.OnTime Now + TimeValue("00:00:55"), "KaydetKapat"
End Sub
Sub KaydetKapat()
        If Workbooks.Count > 1 Then
            Workbooks("asdsdfasd.xlsm").Activate
            Application.DisplayAlerts = False
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        Else
            Application.DisplayAlerts = False
            ActiveWorkbook.Save
            Application.Quit
        End If
End Sub


Woorkbook open kısmına yazılacak kod:

Kod: 
Private Sub Workbook_Open()
Call Kapat
End Sub
 
Oyla 0 Olumsuz oyla
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst