Kopyala yapıştır engelleme

sward175 · 11 Temmuz 2014

Herkese selamlarımla,

Forumdan bulduğum kod ile bu çalışma kitabının tüm sayfalarda "kopyala yapıştır" engelleme yapmaya çalıştım, Ctrl İnsert dahil.
Fakat uyguladığım kod bilgisayarımdaki tüm excel dosyalarına hükmediyor.
sadece bu çalışma kitabının tüm sayfalarına uygulamak için yardımlarınızı rica ederim.
Saygılarımla,
sward175

hamitcan · 11 Temmuz 2014

Autpen isimli kodu kapatıp, aşağıdaki kodu ThisWorkBook kısmına ekleyin.

Kod:

Private Sub Workbook_Deactivate()
    Application.OnKey "^c"
    Application.OnKey "^v"
    For Each Copy In Application.CommandBars.FindControls(Id:=19)
    Copy.Enabled = Evn
    Next Copy
End Sub

Private Sub Workbook_activate()
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    For Each Copy In Application.CommandBars.FindControls(Id:=19)
    Copy.Enabled = Evn
    Next Copy
End Sub

sward175 · 11 Temmuz 2014

Sayın, hamitcan,

Vermiş olduğunuz kod ile istediğimi yaptım ve hiç bir problem yok gayet iyi çalışıyor, ne var ki benim daha önce kullandığım kod nedeni ile olacak galiba başka excel dosyalarında da kopyalama yapamıyorum. Bu sorunu nasıl çözebilirim.
Yardımlarınızı rica ederim.
saygılarımla,
sward175

hamitcan · 11 Temmuz 2014

Excel'i kapatıp açtığınızda düzelmiyor mu ?

sward175 · 11 Temmuz 2014

Sayın, hamitcan hocam,
Affımı bağışlayın önce dediğiniz gibi exceli kapatıp tekrar denedim olmadı bunun üzerine bilgisayarı yeniden başlattım gene aynı hiç bir excel dosyasında kopyalama yapamıyorum,
saygılarımla,
sward175

halit3 · 11 Temmuz 2014

Dosyanızı ekliyorum
bu dosyayı açın ve kapatın sonra diğer dosyalarınızı açın ve gözlemleyin.

Dosyanızdaki kodları sildim ve aşağıdaki kodları ekledim.

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 = True
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

sward175 · 11 Temmuz 2014

Sayın: halit Hocam,
Ellerinize sağlık eski dosyayı silip sizin dosyanızı bilgisayara yükledim ve bilgisayarı kapatıp tekrar açtım her şey yerli yerinde çalışıyor problem de ortadan kalktı. Teşekkürler ediyorum.
saygılarımla,
sward175

sward175 · 15 Temmuz 2014

Sayın: Halit Hocam,

Tekrar bir destek daha istiyorum. 6. mesajınızdaki kodu sadece " İKMALLER" sayfasına uyarlamamız için kodu nasıl değiştirmem gerekir.
Yardımınız için teşekkürler ederim.
Saygılarımla,
sward175

halit3 · 15 Temmuz 2014

sward175' Alıntı:
Sayın: Halit Hocam,

Tekrar bir destek daha istiyorum. 6. mesajınızdaki kodu sadece " İKMALLER" sayfasına uyarlamamız için kodu nasıl değiştirmem gerekir.
Yardımınız için teşekkürler ederim.
Saygılarımla,
sward175

İKMALLER Sayfasının kod bölümüne aşağıdaki kodu ekleyin ve diğer kodları silin

KOD:

Kod:

Private Sub Worksheet_Activate()
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 Worksheet_Deactivate()
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

sward175 · 15 Temmuz 2014

Sayın: Halit Hocam teşekkürlerimi bir borç biliyorum. Sağlık ve sıhhatli bir hayat diliyorum,
Saygılarımla,
sward175

Erdem Akdemir · 15 Temmuz 2014

Hocam elinize sağlık.

ERMAN SAYINALP · 24 Kasım 2017

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 = True
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

[/QUOTE]
Üstadım,

Hazırladığınız bu KOD'lama ziyadesiyle faydalı oldu, ekstra bir isteğim olacak, lütfederseniz ;

Çalışma Kitabımı paylaştığım kişiler KOPYALA-YAPIŞTIR yapamıyorlar bu olumlu tarafı, olumsuz olan ise, ben de KOPYALA-YAPIŞTIR yapamıyorum. Oysa gizli bir KISAYOL TUŞU ile kendim kullanırken açabilme imkanım olabilir mi ? (Örnekliyorum, CTRL+SHIFT+J gibi)

Değerli yardımlarınıza şimdiden teşekkürler.

celerimbor · 28 Kasım 2017

slm dün bu kodları denerken pcdeki tüm excel dosyalarımda kopyala yapıştırı kapatmışım geri nasıl açabilirim.

halit3 · 28 Kasım 2017

Eklediğim kodu kırmızı ile belirttim siz sayfada bir düğme ekleyin ve kırmızı kodu o düğmeye bağlayın
kod:

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 = True
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

[COLOR="Red"]Sub engellemeyi_aç()
Dim sifre, parametre
sifre = "1234"
parametre = InputBox("Lütfen hücreye giriş şifresini giriniz şifre  1234 ", "uyarı!")
If parametre <> sifre Then
MsgBox "Yanlış şifre girdiniz"
Exit Sub
End If

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[/COLOR]

celerimbor · 28 Kasım 2017

Eyvallah üstat teşekkür ettim. kod ayrıca çok işime yaradı. Yardımcı olan herkese çok teşekkürler.

Bakigemlik · 8 Mart 2019

halit3' Alıntı:

İKMALLER Sayfasının kod bölümüne aşağıdaki kodu ekleyin ve diğer kodları silin

KOD:

Kod:

Private Sub Worksheet_Activate()
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 Worksheet_Deactivate()
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

Merhaba,

bu kodları excelimde "Araç Data" sayfamdaki sadece "E" sütunu için çalışmasını sağlamak mümkün mü ?

Teşekkürler,

sedmul · 28 Ocak 2020

halit3' Alıntı:

Eklediğim kodu kırmızı ile belirttim siz sayfada bir düğme ekleyin ve kırmızı kodu o düğmeye bağlayın
kod:

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 = True
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

[COLOR="Red"]Sub engellemeyi_aç()
Dim sifre, parametre
sifre = "1234"
parametre = InputBox("Lütfen hücreye giriş şifresini giriniz şifre  1234 ", "uyarı!")
If parametre <> sifre Then
MsgBox "Yanlış şifre girdiniz"
Exit Sub
End If

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[/COLOR]

merhaba,

bir düğme ekleyin ve kodu buna bağlayın ne demek, nasıl yapabilirim?

Korhan Ayhan · 28 Ocak 2020

Linkleri inceleyiniz.

https://www.excel.web.tr/threads/sayfada-buton-duegme-olusturmak-ve-makro-atamak-1-resimli-anlatim.59436/

https://www.excel.web.tr/threads/sayfada-buton-duegme-olusturmak-ve-makro-atamak-2-resimli-anlatim.136979/

sedmul · 28 Ocak 2020

Korhan Ayhan' Alıntı:
Linkleri inceleyiniz.

https://www.excel.web.tr/threads/sayfada-buton-duegme-olusturmak-ve-makro-atamak-1-resimli-anlatim.59436/

https://www.excel.web.tr/threads/sayfada-buton-duegme-olusturmak-ve-makro-atamak-2-resimli-anlatim.136979/

teşekkür ederim.
ancak tam anlayamadım ve yapamadım.
istediğim zaman kopyala yapıştırı tekrar kullanılır hale getirebilmek için aşağıdaki kodun tamamını mı bu düğmeye makro olarak yazmalıyım.

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 = True
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 engellemeyi_aç()
Dim sifre, parametre
sifre = "1234"
parametre = InputBox("Lütfen hücreye giriş şifresini giriniz şifre 1234 ", "uyarı!")
If parametre <> sifre Then
MsgBox "Yanlış şifre girdiniz"
Exit Sub
End If

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

klop01 · 28 Ocak 2020

Sayın halit3,
Yukarıda verdiğiniz koda aşağıdaki gibi bir ekleme yaptım.
Amacım CTRL tuşunun basılı tutularak fare ile sayfanın büyütülüp küçültülmesinin engellenmesi.
Başarılı olamadım. Sayfa değiştirdiğimde de hata veriyor.
Bu şekilde CTRL tuşu yasaklanabilir mi?

Kod:

Private Sub Worksheet_Activate()
Application.OnKey "+{CTRL}", ""

Private Sub Worksheet_Deactivate()
Application.OnKey "+{CTRL}"

Kopyala yapıştır engelleme

sward175

Özel Üye

Ekli dosyalar

hamitcan

Uzman

sward175

Özel Üye

hamitcan

Uzman

sward175

Özel Üye

halit3

Uzman

Ekli dosyalar

sward175

Özel Üye

sward175

Özel Üye

halit3

Uzman

sward175

Özel Üye

Erdem Akdemir

Destek Ekibi

ERMAN SAYINALP

celerimbor

halit3

Uzman

celerimbor

Bakigemlik

sedmul

Korhan Ayhan

Administrator

sedmul

klop01

Ekli dosyalar