Auto_Open ve Auto_Close kodlarının neresi yalnış

[CRAYZLOVEIS]

Öncelikle hepinize kolay gelsin. Direkt konuya girmek istiyorum. Ekteki dosya ile bir kaç sorum olacak. Yardımlarınız için çok tşk. ederim.

1. Ekteki dosyada kalatılırlen "Yaptığınız değişiklikler Kaydedilsin mi" diye bir soru çıkıyor. Fakat dosya da değişiklik olsada olmasada bu mesaj çıkıyor. Acaba şöyle bir değişiklik yapmak mümkün mü.. Dosyada gerçekten bir değişiklik yapılmışsa bu soruyu sorsun. Fakat değişiklik yapılmamışsa direkt kapansın. yani Excelin orjinalinde olduğu gibi...

2. İkinci sorum ise şu.. Yaptığım ekteki dosya açıkken başka bir excel dosyası açılmasın. Yani "Bu dosya açıkken başka bir excel dosyası açamazsınız" gibi uyarı gibi bir şey versin.

3. Üçüncü ve son sorum ise örnek dosyadaki auto_close ve auto_open kodlarında kopyala yapıştır vs.. özellikleri iptal edip dosyayı kapatırkende tekrar açıyorum. Yada en azından öyle yaptığımı sanıyorum. Çünkü bu dosyayı açıp işim bittiten sonra kapatıyorum. Ama bu dosyadan sonra hiç bir excel sayfasında kes kopyala yapıştır özelliği aktif olmuyor. Lütfen kodlamanın neresinde yalnış olduğunu söyleyebilirmisiniz.

Bu üç soruyu teker teker yanıtlarsanız çooook çooook memnun olurum. Yardımlarınız için şimdiden tşk...

Not: Dosya 3.mesajda

 

[Levent Menteşoğlu]

1. sorunuz için auto_close prosedürünüzü aşağıdaki ile değiştirin.

Sub AUTO_CLOSE()
If ActiveWorkbook.Saved = True Then GoTo 10
Sor = MsgBox("Yaptığınız Değişiklikler Kaydedilsin mi?", 4, "dikkat")
If Sor = vbYes Then
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close
End If
'kopyala kes yapıştır kapanırken aktifleştirir
10  EnableControl 21, True 'Kes
    EnableControl 19, True ' Kopyala
    EnableControl 22, True ' Yapıştır
    EnableControl 755, True ' özelyapıştır
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.CellDragAndDrop = True
    CommandBars("ToolBar List").Enabled = True
End Sub

2. sorunuz için belki mevcut açık excelden açılacak dosyalar engellenebilir, ancak ikinci kez açılan excel üzerinden açılacak dosyaları engellemek zor gibi geldi bana.

3. sorunuz için sanıyorum 1 nolu çözümde önerdiğim değişiklik sorunu çözecektir.

 

[CRAYZLOVEIS]

Üstad verdiğin kodu denedim. Dediğim değişiklik varsa kaydetme ile ilgili sorunumu çözdü. Fakat Thisworkbook'a aşağıdaki kodu eklediğim zaman maalesef sorun devam ediyor. Acaba Thisworkbook a eklediğim kodlarıda dikkate alarak soruma cevap verebilirmisiniz.

Private Sub Workbook_Open()
Dim CB As CommandBar
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
Application.Caption = "excel.web.tr"
For Each CB In Application.CommandBars
CB.Enabled = False
Next CB
With ActiveWindow
.DisplayHeadings = False
.DisplayOutline = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
End Sub
-----------------------------------------
Private Sub Workbook_Beforeclose(Cancel As Boolean)
Dim CB As CommandBar
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
For Each CB In Application.CommandBars
CB.Enabled = True
Next CB
With ActiveWindow
.DisplayOutline = True
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
End Sub
-----------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
Cancel = True 'False farklı kaydede izin verir.
End If
End Sub

2. sorunuz için belki mevcut açık excelden açılacak dosyalar engellenebilir

Acaba dosya açıkken diğerinin engellenmesi içinde bir örnek dosya verebilirmisiniz.

Şimdiden tşk. NOT: Dosya yenilenmiştir.

 

[Levent Menteşoğlu]

Son verdiğiniz kodlarla, ilk verdiklerinizi birarada kullanacakmısınız?

 

[CRAYZLOVEIS]

Evet iki kodu da aynı anda kullanacağım. Hatta yaptığım bütün dosyalarda bu şekilde kullanıyorum. Ama kullanım için bir sakınca varsa yada aynı işlevi gören başka bir kod varsa oda olur...

Yukarıdaki kodlar bu forumda öğrendiğim kodlardır. Benim gibi acemiler anca bu kadar yapıyor..

 

[CRAYZLOVEIS]

Üstadlardan ses yok En iyisi biraz daha uğraşıyım....

 

[CRAYZLOVEIS]

İsteyince Oluyormuş

Üstadlar sanırım kendi sorumun cevabını buldum.. Thisworkbook taki kodları iptal ettim ve aşağıdaki kodları ekledim. Allah'a emanet olun

Sub AUTO_OPEN()
Dim CB As CommandBar
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
Application.Caption = "Excel.web.tr"
For Each CB In Application.CommandBars
CB.Enabled = False
Next CB
With ActiveWindow
.DisplayHeadings = False
.DisplayOutline = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
Run ("DisableCutAndPaste") 'AŞAĞIDAKİ MAKROYU ÇALIŞTIRIR VE KOPYALA YAPIŞTIR VS PASİF YAPAR
End Sub
Sub AUTO_CLOSE()
Run ("KORU")
Run ("EnableCutAndPaste") 'AŞAĞIDAKİ MAKROYU ÇALIŞTIRIR VE KOPYALA YAPIŞTIR VS AKTİF YAPAR
Sor = MsgBox("Yaptığınız Değişiklikler Kaydedilsin mi?", 4, "dikkat")
If Sor = vbYes Then
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close
End If
End Sub
Sub DisableCutAndPaste() ' 'kopyala kes yapıştırı açılışta pasif yapar
EnableControl 21, False ' kes
EnableControl 19, False ' kopyala
EnableControl 22, False ' yapıştır
EnableControl 755, False ' özel yapıştır
Application.CellDragAndDrop = False 'hücreyi çoğaltma ve taşıma
CommandBars("ToolBar List").Enabled = False 'düzen menüsündeki ilgili menüleri gizle
Application.OnKey "^c", "YASAKLA"
Application.OnKey "^v", "YASAKLA"
Application.OnKey "+{DEL}", "YASAKLA"
Application.OnKey "+{INSERT}", "YASAKLA"
End Sub
Sub EnableCutAndPaste() ' 'kopyala kes yapıştırı kapanışta aktif yapar
EnableControl 21, True ' kes
EnableControl 19, True ' kopyala
EnableControl 22, True ' yapıştır
EnableControl 755, True ' özel yapıştır
Application.CellDragAndDrop = True 'hücreyi çoğaltma ve taşıma
CommandBars("ToolBar List").Enabled = True 'düzen menüsündeki ilgili menüleri göster
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Dim CB As CommandBar
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
For Each CB In Application.CommandBars
CB.Enabled = True
Next CB
With ActiveWindow
.DisplayOutline = True
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = True
End With
End Sub
Sub EnableControl(Id As Integer, Enabled As Boolean)
Dim CB As CommandBar
Dim C As CommandBarControl
For Each CB In Application.CommandBars
Set C = CB.FindControl(Id:=Id, recursive:=True)
If Not C Is Nothing Then C.Enabled = Enabled
Next
End Sub
Sub YASAKLA()
MsgBox "Programda Bu Özellik Güvenlik İçin Yasaklanmıştır" & vbCrLf & "" & vbCrLf & "Tşk", , "dikkat"
End Sub