Kapalı dosyaya veri aktar ve KONTROL =True ile kapat

[meslek5]

Değerli üstadlarım bir konuda yardımlarınızı bekliyorum
Kapalı bir excel dosyasına veri aktarabiliyorum ancak, kapalı excel dosyasına sayfadan kapatılmasını engellemek için daha önceden bir kod yazmıştım. Ve kapatma işlemi sadece userformda KONTROL=True ile yapılmaktadır.

Yukarıda belirttiğim kod nedeniyle bahse konu kapalı excel dosyasına veri aktardıktan sonra kapatma işlemi yapamıyorum.

NOT: Foruma Dosya Yükleyemediğim için Örnek dosyayı başka bir siteye yükledim
http://www.dosyayukleyin.com/do.php?id=5099]AÇIK-KAPALI.rar

Bu konuda siz değerli üstadlarımdam yardım bekliyorum. İyi bayramlar dileğiyle

 

[Erdem Akdemir]

Örnek dosya ekleyebilir misiniz?

 

[meslek5]

Foruma Dosya Yükleyemediğim için Örnek dosyayı başka bir siteye yükledim
http://www.dosyayukleyin.com/do.php?id=5099]AÇIK-KAPALI.rar

 

[Ömer BARAN]

Merhaba.

Kod'un en başındaki ve ortalarındaki KONTROL ibarelerini CONTROL olarak değiştirip dener misiniz?

 

[Ömer BARAN]

Tekrar merhaba, umarım yanlış anlamadım.
Kod'u aşağıdaki ile değiştirdiğinizde KAPALI adlı dosya açılıyor, veri yazılıyor, LÜTFEN FORM ÜZERİNDEN KAPATIN uyarısı ekrana geliyor ve FORM beliriyor, FORM'un köşesindeki kapatma düğmesine basılınca, KAPALI adlı dosya kaydedilip, kapatılıyor ve ekran tekrar AÇIK adlı belgeye dönüyor.

Public [B][COLOR="red"]C[/COLOR][/B]ONTROL As Boolean

Sub KAPALI_DOSYAYA_AKTAR()
Application.ScreenUpdating = False

'KAPALI DOSYAYA VERİ AKTARIYORUM
yol = ThisWorkbook.Path & "\KAPALI.xlsm"
Workbooks.Open (yol)
Workbooks("KAPALI.xlsm").Sheets("Sayfa1").Range("A1").Value = "ÖRNEK 1234"

'ANCAK KAPALI EXCELİ KAPATAMIYORUM
[B][COLOR="Red"]C[/COLOR][/B]ONTROL = True
ThisWorkbook[B][COLOR="red"].Save[/COLOR][/B]
Application.DisplayAlerts = False
Application[COLOR="red"][B].Quit[/B][/COLOR]
Application.ScreenUpdating = True
End Sub

 

[meslek5]

Hocam zaman ayırıp cevapladığınız için teşekkür ederim.
Ancak, benim istediğim o uyarı penceresinin çıkmaması. Yani kapalı dosya üzerinde çalışırken kapatma işleminin formdan yapılması, açık dosyadan kapalı dosyaya veri aktarırken de uyarı penceresinin gelmeden veri aktarıp kapatılabilmesi.

 

[halit3]

kamalı dosyadaki bütün makroları silin ve kayıt edin sonra açık dosyadaki bütün makroları silin aşağıdaki makro kodunu çalıştırın.

Sub KAPALI_DOSYAYA_AKTAR()
Application.ScreenUpdating = False
yol = ThisWorkbook.Path & "\KAPALI.xlsm"
Workbooks.Open (yol)
Workbooks("KAPALI.xlsm").Sheets("Sayfa1").Range("A1").Value = "ÖRNEK 1234"
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub

 

[meslek5]

Sayın Ömer.Baran ve Halit3 hocam sorum yanlış anlaşılmış olabilir. KAPALI.xlsm dosyasındaki kodlar silinmeyecek çünkü o kodlar kapalı dosyası üzerinde çalışırken kullanıcıların sayfadan çıkışını userformdan yapmaları için gerekli olan kodlardır. Yani KAPALI.xlsm dosyasındaki kodlar silinmeyecek veya AÇIK.xlsm dosyasından veri aktarıp kapatılabilecek şekilde aynı mantık doğrultusunda yeniden düzenlenebilir.

Özetle;
KAPALI.xlsm dosyasında çalışırken sayfadan çıkış engellenecek ve çıkış için userform gelecek çıkış userformdaki çarpıdan gerçekleşecek.

AÇIK.xlsm dosyasından Kapalı olan KAPALI.xlsm dosyasına veri aktarırken KAPALI.xlsm dosyasındaki sayfa çıkışı engeli ile ilgili mesaj görüntülenmeden doğrudan kapalı dosyanın kapatma işlemi gerçekleşecek.

Umarım doğru anlatabilmişimdir. Saygılar

 

[halit3]

Kapalı dosyaya ait BuÇalışmaKitabı sayfası kodu

Option Explicit
Dim deger3

Private Sub Workbook_BeforeClose(Cancel As Boolean)
deger3 = GetSetting("deger1", "deger2", "deger3", 0)
If Val(deger3) = 1 Then
If KONTROL = False Then
Cancel = True
MsgBox "LÜTFEN FORM ÜZERİNDEN KAPATIN", vbExclamation, "HATALI İŞLEM"
UserForm1.Show
End If
End If
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
SaveSetting "deger1", "deger2", "deger3", 1
End Sub

açık dosyaya ait kod

Sub KAPALI_DOSYAYA_AKTAR()
Application.ScreenUpdating = False
'KAPALI DOSYAYA VERİ AKTARIYORUM
yol = ThisWorkbook.Path & "\KAPALI.xls"
Workbooks.Open (yol)
Workbooks("KAPALI.xls").Sheets("Sayfa1").Range("A1").Value = "ÖRNEK 1234"
SaveSetting "deger1", "deger2", "deger3", 0

ActiveWorkbook.Save
ActiveWorkbook.Close

DeleteSetting ("deger1")
'ANCAK KAPALI EXCELİ KAPATAMIYORUM
Application.ScreenUpdating = True
End Sub

Not kod xp sp3 işletim sisteminde ofis 2003 de çalışıyor.

xls uzantılarını siz kendi dosyanız xlsm olarak değiştirin.

 

[meslek5]

Teşekkür

Sayın Halit3 Hocam zaman ayırdığınız için çok çok teşekkür ederim eksik olmayın. Kodlarınız benim tam olarak yapmak istediğim şeyi gerçekleştiriyor.
Örnek teşkil edecek bir kod düzenlemiş siniz. Bu siteyi ve siz değerli üstadlarımı çok seviyorum her sorunun hakkını veriyorsunuz. Çalışmalarınızda başarılar dilerim.