• DİKKAT

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

VbYesNOCancel yardımı

Katılım
18 Temmuz 2009
Mesajlar
56
Excel Vers. ve Dili
2007
Aşağıdaki şekilde bir kodları çalıştırdığımda dosyayı kapatıyor. Fakat ben "İptal" butonuna tıkladığımda kapanmasın istiyorum. Yardımlarınız için teşekkür ederim.
Sub Auto_Close()
Application.DisplayAlerts = False
soru = MsgBox("Yaptığınız Değişiklikler Kaydedilsin mi?", vbYesNoCancel, "KAPANIYOR")

If soru = vbNo Then GoTo kapat
ActiveWorkbook.Save
kapat:
MsgBox "TEKRAR GÖRÜŞMEK DİLEĞİYLE"
ActiveWorkbook.Close True
Application.DisplayAlerts = True
If soru = vbCancel Then exit sub
End Sub
 
Merhaba,
Aşağıdaki şekilde deneyiniz.
Kod:
Sub Auto_Close()
Application.DisplayAlerts = False
soru = MsgBox("Yaptığınız Değişiklikler Kaydedilsin mi?", vbYesNoCancel, "KAPANIYOR")
If soru = vbCancel Then
    Exit Sub
ElseIf soru = vbNo Then
    MsgBox "TEKRAR GÖRÜŞMEK DİLEĞİYLE"
Else
    ActiveWorkbook.Save
End If
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
 
Teşekkürler ÖmerBey eline sağlık, Kodları denedim "İptal" tıkladığım halde dosyayı yine kapatıyor.
 
Son düzenleme:
Kod:
Sub Auto_Close()
Application.DisplayAlerts = False
soru = MsgBox("Yaptığınız Değişiklikler Kaydedilsin mi?", vbYesNoCancel, "KAPANIYOR")
If soru = vbCancel Then
    Exit Sub
ElseIf soru = vbNo Then
    MsgBox "TEKRAR GÖRÜŞMEK DİLEĞİYLE" & vbLf & vbLf & "KAYDETMEDEN KAPANIYOR"
    ActiveWorkbook.Close False
Else
MsgBox "TEKRAR GÖRÜŞMEK DİLEĞİYLE" & vbLf & vbLf & "YAPTIĞINIZ DEĞİŞİKLİKLER KAYDEDİLECEK"
    ActiveWorkbook.Close True

End If

Application.DisplayAlerts = True
End Sub
 
Kodları denedim "İptal" tıkladığım halde dosyayı yine kapatıyor.
Tekrar merhaba,
Auto_Close kodlarını silip ThisWorkBook kod bölümüne aşağıdaki kodu kopyalayınız.
Kod:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
soru = MsgBox("Yaptığınız Değişiklikler Kaydedilsin mi?", vbYesNoCancel, "KAPANIYOR")
If soru = vbCancel Then
    [COLOR="Red"]Cancel = True[/COLOR]
    Exit Sub
ElseIf soru = vbNo Then
    MsgBox "TEKRAR GÖRÜŞMEK DİLEĞİYLE"
Else
    ActiveWorkbook.Save
End If
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
 
Bir alternatif de ben ekliyorum kırmızı yerleri silebilirsiniz.

Kod:
Dim deg

Private Sub Workbook_BeforeClose(Cancel As Boolean)

If Val(deg) = 0 Then
a = MsgBox("Kayıt yapmak istiyormusunuz.?", vbYesNoCancel, "uyarı")
End If

If a = 6 Then
deg = 1
[COLOR="Red"]MsgBox "evet seçeneğini tıkladınız."[/COLOR]
ActiveWorkbook.Save
ThisWorkbook.Close savechanges:=False
Cancel = True
ElseIf a = 7 Then
deg = 1
[COLOR="red"]MsgBox "hayır seçeneğini tıkladınız."[/COLOR]
ThisWorkbook.Close savechanges:=False
Cancel = True
ElseIf a = 2 Then
deg = 0
[COLOR="red"]MsgBox "iptal seçeneğini tıkladınız."[/COLOR]
Cancel = True
End If

End Sub
 
İlginiz için Teşekkür ederim. Emeğinize sağlık çok iyi geldi..
 
Geri
Üst