kopyalamayı ve çıkış tuşunu kullanmayı engelleme

K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Merhaba,
Bir excel çalışma kitabında kopyalamayı ve yedek almayı mecbur kılmak için kapat tuşunu kullanmayı engellemeye ihtiyacım var.
Her iki isteği farklı konularda buldum. 2 kodu birleştirdim.
dosya ilk açıldığında kopyalama özelliği pasif oluyor
fakat kapatma tuşunu kullanıp kapatmayı iptal ettiğimde
kopyalama özelliği aktif oluyor.
Bu nasıl düzeltebiliriz. Teşekkür ederim.
Kod: 
Option Explicit


Private Sub Workbook_Open()
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = False
''''''''''''KAPATMAYI ENGELLEME KODU ''''''''''''''''''''''''''''
If KONTROL = False Then
    Cancel = True
    MsgBox "X (Çıkış) düğmesi pasif durumdadır. Lütfen sayfa üzerindeki çıkış düğmesini kullanın.", vbExclamation, "Dikkat !"
    End If
End Sub



Private Sub Workbook_SheetActivate(ByVal Sh As Object)
EnableControl 21, False ' cut
EnableControl 19, False ' copy
EnableControl 22, False ' paste
EnableControl 755, False ' pastespecial
Application.OnKey "^c", ""
Application.OnKey "^v", ""
Application.OnKey "+{DEL}", ""
Application.OnKey "+{INSERT}", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
EnableControl 21, True ' cut
EnableControl 19, True ' copy
EnableControl 22, True ' paste
EnableControl 755, True ' pastespecial
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
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
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
724
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Option Explicit

Private KONTROL As Boolean

Private Sub Workbook_Open()
    EnableControl 21, False ' cut
    EnableControl 19, False ' copy
    EnableControl 22, False ' paste
    EnableControl 755, False ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
    KONTROL = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If KONTROL = False Then
        Cancel = True
        MsgBox "X (Çıkış) düğmesi pasif durumdadır. Lütfen sayfa üzerindeki çıkış düğmesini kullanın.", vbExclamation, "Dikkat !"
    Else
        EnableControl 21, True ' cut
        EnableControl 19, True ' copy
        EnableControl 22, True ' paste
        EnableControl 755, True ' pastespecial
        Application.OnKey "^c"
        Application.OnKey "^v"
        Application.OnKey "+{DEL}"
        Application.OnKey "+{INSERT}"
        Application.CellDragAndDrop = True
    End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    EnableControl 21, False ' cut
    EnableControl 19, False ' copy
    EnableControl 22, False ' paste
    EnableControl 755, False ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    EnableControl 21, True ' cut
    EnableControl 19, True ' copy
    EnableControl 22, True ' paste
    EnableControl 755, True ' pastespecial
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.OnKey "+{DEL}"
    Application.OnKey "+{INSERT}"
    Application.CellDragAndDrop = True
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 ExitButton_Click()
    KONTROL = True
    ThisWorkbook.Close
End Sub

Yukarıdaki kodda yapılan düzenlemeler:
  1. Workbook_Open olayında KONTROL değişkenini False olarak ayarlanmıştır
  2. Workbook_BeforeClose olayında, KONTROL değişkeni False ise kapatma işlemini iptal edilmiş ve kullanıcıya bir uyarı mesajı gösterilmiştir. KONTROL değişkeni True ise, kopyalama ve yapıştırma işlemlerini tekrar etkinleştirildi.
  3. ExitButton_Click adında bir alt prosedür eklendi. Bu prosedür, kullanıcı tarafından tıklanacak çıkış düğmesine atanmalıdır. Bu prosedür, KONTROL değişkenini True olarak ayarlayarak kitabın kapanmasına izin verir.
Çıkış düğmesini eklemek ve ExitButton_Click prosedürüne bağlamak için şu adımları izleyin:
  1. Excel'de geliştirici sekmesini açın.
  2. Bir düğme ekleyin (Form Kontrolleri veya ActiveX Kontrolleri kullanabilirsiniz).
  3. Düğmeye sağ tıklayın ve "Makro Ata" veya "Kod Görüntüle" seçeneğini seçin.
  4. Düğmeyi ExitButton_Click prosedürüne bağlayın.
Bu şekilde, kullanıcı kapatma tuşunu kullandığında kopyalama özellikleri aktif olmayacak ve yalnızca çıkış düğmesini kullanarak dosyayı kapatabilecekler.

Lütfen deneyiniz
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Çok teşekkür ederim.
Bilgi ve emeğinize sağlık.
Selametle
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Merhaba,
Çalıştığım dosyayı düğmeden kapattığımda yedek alması için aşağıdaki kodu Kullanıyorum.
Option Explicit aktif olduğunda
If ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") = False Then satırı hata veriyor.
Option Explicit pasif olduğunda yedeği alıyor, sanki çalışma sayfasından çıkış yapılıyormuş gibi mesaj verip dosyayı kapatmıyor.
Yani yukardaki KONTROL olayı devreye giriyor.
Kodun başına KONTROL=True yaptım olmadı.
Yani düğmeyi açıkladığınız 4. maddeye nasıl bağlarım.
Veya 2 nci koda dosya yedekleme kodunu nasıl ekleriz.
Kod: 
'Option Explicit
 
Public KONTROL As Boolean

Sub YEDEKLE()
KONTROL = True
Set ds = CreateObject("Scripting.FileSystemObject")

ThisWorkbook.Save
If ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") = False Then
ds.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI"
End If
If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI" Then Exit Sub
If MsgBox("DOSYAYI KAPATMAK İSTİYORMUSUNUZ?....", vbInformation + vbYesNo, "DURUM") = vbYes Then
yol = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
ds.CopyFile ThisWorkbook.FullName, yol
End If
ThisWorkbook.Close
End Sub
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
724
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Görünüşe göre, Option Explicit aktif olduğunda ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") satırı hata veriyor. Bu, ds nesnesinin tanımlanmadığı anlamına geliyor.

Çözüm olarak, Option Explicit kullanmaya devam edebilir ve ds nesnesini doğru şekilde tanımlayabilirsiniz. Aşağıdaki kodu deneyin:

Kod: 
Option Explicit

Public KONTROL As Boolean

Sub YEDEKLE()
    KONTROL = True
    Dim ds As Object
    Set ds = CreateObject("Scripting.FileSystemObject")

    ThisWorkbook.Save
    If Not ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") Then
        ds.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI"
    End If
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI" Then
        Exit Sub
    End If
    If MsgBox("DOSYAYI KAPATMAK İSTİYORMUSUNUZ?....", vbInformation + vbYesNo, "DURUM") = vbYes Then
        Dim yol As String
        yol = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
        ds.CopyFile ThisWorkbook.FullName, yol
    End If
    ThisWorkbook.Close
End Sub
Dosya kapatma işlemini, yedekleme işlemine entegre etmek istiyorsunuz. Bunu aşağıdaki şekilde yapabilirsiniz:

Kod: 
Option Explicit

Public KONTROL As Boolean

Sub YEDEKLE()
    KONTROL = True
    Dim ds As Object
    Set ds = CreateObject("Scripting.FileSystemObject")

    ThisWorkbook.Save
    If Not ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") Then
        ds.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI"
    End If
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI" Then
        Exit Sub
    End If
    Dim yol As String
    yol = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
    ds.CopyFile ThisWorkbook.FullName, yol
    ThisWorkbook.Close
End Sub
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Çok teşekkür ederim
2 nci kod işimi gördü
muhasebeciyiz' Alıntı:
Görünüşe göre, Option Explicit aktif olduğunda ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") satırı hata veriyor. Bu, ds nesnesinin tanımlanmadığı anlamına geliyor.

Çözüm olarak, Option Explicit kullanmaya devam edebilir ve ds nesnesini doğru şekilde tanımlayabilirsiniz. Aşağıdaki kodu deneyin:

Kod: 
Option Explicit

Public KONTROL As Boolean

Sub YEDEKLE()
    KONTROL = True
    Dim ds As Object
    Set ds = CreateObject("Scripting.FileSystemObject")

    ThisWorkbook.Save
    If Not ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") Then
        ds.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI"
    End If
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI" Then
        Exit Sub
    End If
    If MsgBox("DOSYAYI KAPATMAK İSTİYORMUSUNUZ?....", vbInformation + vbYesNo, "DURUM") = vbYes Then
        Dim yol As String
        yol = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
        ds.CopyFile ThisWorkbook.FullName, yol
    End If
    ThisWorkbook.Close
End Sub
Dosya kapatma işlemini, yedekleme işlemine entegre etmek istiyorsunuz. Bunu aşağıdaki şekilde yapabilirsiniz:

Kod: 
Option Explicit

Public KONTROL As Boolean

Sub YEDEKLE()
    KONTROL = True
    Dim ds As Object
    Set ds = CreateObject("Scripting.FileSystemObject")

    ThisWorkbook.Save
    If Not ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") Then
        ds.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI"
    End If
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI" Then
        Exit Sub
    End If
    Dim yol As String
    yol = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
    ds.CopyFile ThisWorkbook.FullName, yol
    ThisWorkbook.Close
End Sub
Genişletmek için tıkla ...
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Hocam merhaba
her iki kodda buton ile kapatırken x kapatma yönlendirme pasif oluyor.
nasıl yaparız
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Hocam merhaba,
açıklamanızda ds nesnesini doğru şekilde tanımlayabilirsiniz.. demişsiniz
tanımlamayı nasıl yaparız.
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Merhaba,
Kod üzerinde aşağıdaki şekilde değişiklik yaparak ve açılışta k1 hücresine "x" yazdırıp yedek alırken de "x" kaldırıp sorunu çözdüm.
teşekkür ederim
Kod: 
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets("sayfa1").Range("k1").Value = "x" Then
MsgBox "kapat butonunu kullanınız."
Cancel = True
Else
End If
End Sub

Private Sub Workbook_Open()
Sheets("sayfa1").Range("k1").Value = "x"
    EnableControl 21, False ' cut
    EnableControl 19, False ' copy
    EnableControl 22, False ' paste
    EnableControl 755, False ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
 
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    EnableControl 21, False ' cut
    EnableControl 19, False ' copy
    EnableControl 22, False ' paste
    EnableControl 755, False ' pastespecial
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    Application.OnKey "+{DEL}", ""
    Application.OnKey "+{INSERT}", ""
    Application.CellDragAndDrop = False
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
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
merhaba,
Yukarıdaki kopyalamayı engelleyen kodun bulunduğu çalışma sayfasını açtık tan sonra açılan başka excel çalışma kitaplarında da kopyalamayı engelliyor.
İsteğim sadece kodun bulunduğu çalışma kitabını etkilemesi.
EnableControl 19, False satırını Thisworkbook.EnableControl 19, False diye değiştirdim. hata verdi
bunu nasıl yapabiliriz.
Teşekkür ederim
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,730
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Bu iki kod bloğunu (ThisWorkbook bölümüne) ekleyip deneyiniz.

C++: 
Private Sub Workbook_Activate()
    EnableControl 19, False
End Sub

Private Sub Workbook_Deactivate()
    EnableControl 19, True
End Sub
 
K

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,672
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Çok teşekkür ederim Korhan Hocam
Selametle kalınız
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst