Grafiklerin kopyalanmasını engellemek..

[akinkaraman]

Excel dosyamdaki grafiklerin kopyalanıp ya da kesilip başka sayfaya ya da başka dosyalara yapıştırılmasını önleyebilir miyim? Bir de grafiğin cizgilerinin üzerine gelince bazı formüller gözüküyor bunları saklamak istiyorum.

 

[akinkaraman]

Cevabı buldum.

Önce tüm sayfada cut-copy-paste olaylarını engellemek icin aşağıdaki kodları ekliyoruz.

Sonra Gözden Gecir Bölümünün altında Sayfayı Koru derken Nesne Düzenle (Edit Objects) ve Senaryoları Düzenle (Edit Scenarios) düzenle'lerin kliklerini kaldırıyoruz, diğerleri klikli.

Artık grafikler dahil herşey kopyalamaya ve yapıştırılmaya engellenmiş oluyor.

=>

Modül Kodu :

Option Explicit
Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
Call EnableMenuItem(19, Allow) ' copy
Call EnableMenuItem(22, Allow) ' paste
Call EnableMenuItem(755, Allow) ' pastespecial
'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow
'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
.OnKey "^c", "CutCopyPasteDisabled"
.OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
.OnKey "+{DEL}", "CutCopyPasteDisabled"
.OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case Is = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
End Select
End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub

Sub CutCopyPasteDisabled()
MsgBox "Sorry! Cutting, copying and pasting have been disabled in this workbook!"
End Sub

Calışma kitabı Kodu :

Option Explicit
Private Sub Workbook_Activate()
Call ToggleCutCopyAndPaste(False)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Deactivate()
Call ToggleCutCopyAndPaste(True)
End Sub
Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
End Sub

 

[halit3]

Bu sitede bir çok konuda var bu
Aşağıdaki linkleri irdeleyiniz.

http://www.excel.web.tr/f48/kopyala-yapy-tyr-engelleme-t142029.html

http://www.excel.web.tr/f48/auto-open-ve-auto-close-kodlarynyn-neresi-yalny-t53057.html

http://www.excel.web.tr/search.php?searchid=2770793