• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Auto_Close'de Dosyanın kapanmasını engellemek.

Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,239
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Merhabalar.
Aşağıdaki kodları Auto_close prosederüne yazdım.
Fakat iptal'ae basınca dosyayı gene kapatıyor.
İptale basınca dosya kapanmaması için ne yapabilirim?
Kod: 
Sub auto_close()
Dim FSO As Object, kapat As Boolean
Set FSO = CreateObject("Scripting.FileSystemObject")
cevap = MsgBox("Dosyayı kaydetmek istiyormusunuz?", vbYesNoCancel)
If cevap = vbYes Then
    kapat = True
    ThisWorkbook.Save
    ElseIf cevap = vbNo Then kapat = False
    [B][COLOR="Red"]Else
    Set FSO = Nothing
    Cancel = True
    Exit Sub[/COLOR][/B]
End If
yol = ThisWorkbook.Path & "\"
yedek = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".xlk"
If Dir(yol & yedek) <> "" Then Kill (yol & yedek)
FSO.GetFile(yol & ThisWorkbook.Name).Copy yol & yedek
Set FSO = Nothing
If kapat = False Then ThisWorkbook.Close False
End Sub
 
Son düzenleme:
Merhaba.
Dosyayı manuel olarak kaydedip kapatmak istediğimde cancel=true görev yapmıyor.İptale bastığım halde dosya genede kapanıyor.
 
Selamlar,

Evren bey,

Kodunuzu a&#351;a&#287;&#305;daki &#351;ekilde de&#287;i&#351;tirip denermisiniz.

Kodu ThisWorkbook b&#246;l&#252;m&#252;ne yazmak daha sa&#287;l&#305;kl&#305; olabilir.

Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Cevap = MsgBox("Dosyay&#305; kaydetmek istiyor musunuz?", vbYesNoCancel)
    If Cevap = vbYes Then
    ThisWorkbook.Save
    ElseIf Cevap = vbNo Then
    Cancel = False
    ElseIf Cevap = vbCancel Then
    Cancel = True
    Exit Sub
    End If
    Yol = ThisWorkbook.Path & "\"
    Yedek = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".xlk"
    If Dir(Yol & Yedek) <> "" Then Kill (Yol & Yedek)
    FSO.GetFile(Yol & ThisWorkbook.Name).Copy Yol & Yedek
    Set FSO = Nothing
    Application.Quit
    Application.DisplayAlerts = False
End Sub
 
Son düzenleme:
Korhan bey konuyu şöyle özetleyim.
Benim dosyam kapanırken xlk uzantılı bir yedeğinide çıkarıyor.
Eğer dosyayı kapatırken çıkan msgbox'a evet dersem dosyayı kaydedicek ve kaydedilmiş dosynın xlk uzantılı kopyasını çıkarıcak.
Hayır dersem dosyayı kaydetmiyecek ve gene xlk uzantılı olarak dosyanın bir yedeğini çıkarıcak .
Eğer İptale Basarsam dosya kapanmayacak.
Kodları aşağıda veriyorum.Bu kodlar olmadı.
Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim FSO As Object, kaydet As Boolean
    Set FSO = CreateObject("Scripting.FileSystemObject")
    cevap = MsgBox("Dosyayı kaydetmek istiyor musunuz?", vbYesNoCancel)
    If cevap = vbYes Then
    ThisWorkbook.Save
    ElseIf cevap = vbNo Then
    kaydet = False
    ElseIf cevap = vbCancel Then
    Cancel = True
    End If
    yol = ThisWorkbook.Path & "\"
    yedek = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".xlk"
    If Dir(yol & yedek) <> "" Then Kill (yol & yedek)
    FSO.GetFile(yol & ThisWorkbook.Name).Copy yol & yedek
    Set FSO = Nothing
    ThisWorkbook.Close kaydet
End Sub
 
Selamlar,

Evren bey &#252;stteki mesaj&#305;mdaki kodu g&#252;ncelledim. Denermisiniz.
 
Korhan bey teşekkür edeim.
Kod: 
Application.Quit
konuyu çözdü.
Başka açık dosyalar varsa onlarıda kapatacak.
Ama napalım bunun dışında bir çözümde yok galiba.
İyi geceler.:)
 
Evren bey,

Aşağıdaki gibi de olabilir. İnceleyiniz.

Kod: 
Sub Auto_Close()
Dim FSO As Object, kapat As Boolean
 
cevap = MsgBox("Dosyayı kaydetmek istiyormusunuz?", vbYesNoCancel)
 
If cevap = vbYes Then
    kapat = True
    ThisWorkbook.Save
    
ElseIf cevap = vbNo Then
    kapat = False
 
Else
    SendKeys "{esc}"
    Exit Sub

End If
 
yol = ThisWorkbook.Path & "\"
yedek = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".xlk"
 
If Dir(yol & yedek) <> "" Then Kill (yol & yedek)
 
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.GetFile(yol & ThisWorkbook.Name).Copy yol & yedek

Set FSO = Nothing
 
If kapat = False Then ThisWorkbook.Close False
 
End Sub
 
Evren Hocam (7 nolu mesajınıza istinaden) daha önceleri bir arkadaşıma yazdığım programda açık olan diğer excel pencerelirinin kapanmaması için aşağıdaki kodları yazmıştım. Üzerinde herhangi bir düzeltme yapmadan ekliyorum. Kendinize uyarlayabilirsiniz.

Private Sub CommandButton5_Click() 'ÇIKIŞ BUTONU
Dim a, b
a = MsgBox("Çıkmak istediğinizden emin misiniz ?", vbYesNo, " Vinç Bakım")
If a = vbYes Then
ThisWorkbook.Save
If Windows.Count > 1 Then
Windows("Malzeme_Takip.xls").Activate
ActiveWindow.Close
Else
Application.Quit
End If
ElseIf a = vbNo Then
Exit Sub
End If
End Sub
 
Ferhat bey 8 numaralı mesajda verdiğiniz kodlarda iptal tuşuna basınca program kapanıyor.
Kapanmaması gerekiyor.
 
Şaban bey.
Teşekkür ederim.
Close bizim kodlarımızda olmuyor.
Mutlaka application.Quit ile çıkmak gerekiyor.
 
Evren Gizlen' Alıntı:
Başka açık dosyalar varsa onlarıda kapatacak.
Ama napalım bunun dışında bir çözümde yok galiba.
Genişletmek için tıkla ...

If Windows.Count > 1 Then
Windows("Dosya_Adınız.xls").Activate
ActiveWindow.Close '1 den fazla excel açıksa sadece bu dosyayı kapat
Else
Application.Quit 'Sadece bu dosya açıksa bu dosyayı kapat.
End If
ElseIf a = vbNo Then
Exit Sub

Evren Hocam, (sadece bildireyim dedim) zaten Application.Quit koduyla çıkış yapılıyor. Kodda dikkatinizi çekti ise Close komutu 1'den fazla excel kitabı açıksa devrede. Ki yanlış anlamadı isem sizin istediğiniz de bu idi. Yani 2 excel dosyası var ise diğeri kapanmasın gibi. Yok 1 tane ise Application.Quit ile çık diyoruz.
 
Şaban Sertkaya' Alıntı:
If Windows.Count > 1 Then
Windows("Dosya_Adınız.xls").Activate
ActiveWindow.Close '1 den fazla excel açıksa sadece bu dosyayı kapat
Else
Application.Quit 'Sadece bu dosya açıksa bu dosyayı kapat.
End If
ElseIf a = vbNo Then
Exit Sub

Evren Hocam, (sadece bildireyim dedim) zaten Application.Quit koduyla çıkış yapılıyor. Kodda dikkatinizi çekti ise Close komutu 1'den fazla excel kitabı açıksa devrede. Ki yanlış anlamadı isem sizin istediğiniz de bu idi. Yani 2 excel dosyası var ise diğeri kapanmasın gibi. Yok 1 tane ise Application.Quit ile çık diyoruz.
Genişletmek için tıkla ...

Şaban hocam ,kodları before close olayına yazdığınız zaman close durumunda yani birden fazla dosya açıksa ,close olayı işleyecek ve bu durumda kodlar 2 kere çalışıyor.
Auto_close ye yazdığımızda ise cancel=true kodu işlemiyor.
Yoksa yalnızca sisin kodlarınızı yazdığımızda ,benim kodları ilave etmezsek sizin kodlarınız kusursuz çalışıyor.
Ama isteseniz benim yazdığım kodlarla birlikte çalıştırıp bir denerseniz memnun olurum.
 
Kusura bakmay&#305;n hocam hakl&#305;s&#305;n&#305;z. Before_Close olay&#305;n&#305; ES ge&#231;mi&#351;im.
 
Bende vbyesnocancel olayını aşağıdaki gibi kullanıyorum.
Cancel fonksiyonu aşağıdaki 2 satırla çalışıyor.

Sub auto_close()
check = MsgBox("Yapılan İşlemleri Kaydetmek İstiyormusunuz? ", vbYesNoCancel + vbQuestion, "...")
If check = vbCancel Then
Run "Yenile" 'SENDKEYS ESC ÇALIŞMASI İÇİN BAŞKA BİR MODULE KULLANMAK ZORUNDA KALDIM. BU MODULE ÖZETLE SAYFAYI YENİLİYOR
SendKeys "{esc}"
ElseIf check = vbYes Then
Application.ScreenUpdating = False
ThisWorkbook.Save
Application.Quit
ThisWorkbook.Save
ElseIf check = vbNo Then
Application.ScreenUpdating = False
ThisWorkbook.Saved = True
End If
End Sub
 
Ancak şunuda belirteyim; SendKeys "{esc}" olayı ağır çalışan bilgisayarda veya Excel'in sürümü düşükse sorun çıkartabiliyor. Yani kodlarım var ama pek kullanışlı değil. Senkeys kullanmadan çözüm yapanlar var ise bilgilerini paylaşmasını isterim. Teşekkürler herkese
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst