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

kemal turan · Cuma saat 14:45'de

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

muhasebeciyiz · Cuma saat 15:06'de

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:

Workbook_Open olayında KONTROL değişkenini False olarak ayarlanmıştır
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.
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:

Excel'de geliştirici sekmesini açın.
Bir düğme ekleyin (Form Kontrolleri veya ActiveX Kontrolleri kullanabilirsiniz).
Düğmeye sağ tıklayın ve "Makro Ata" veya "Kod Görüntüle" seçeneğini seçin.
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

kemal turan · Cuma saat 15:39'de

Çok teşekkür ederim.
Bilgi ve emeğinize sağlık.
Selametle

kemal turan · Cuma saat 16:46'de

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

muhasebeciyiz · Cuma saat 16:54'de

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

kemal turan · Cuma saat 16:59'de

Ç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

kemal turan · Cuma saat 17:27'de

Hocam merhaba
her iki kodda buton ile kapatırken x kapatma yönlendirme pasif oluyor.
nasıl yaparız

kemal turan · Cuma saat 17:57'de

Hocam merhaba,
açıklamanızda ds nesnesini doğru şekilde tanımlayabilirsiniz.. demişsiniz
tanımlamayı nasıl yaparız.

kemal turan · Cumartesi saat 07:38'de

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