Kaydet, farklı kaydet, taşı veya kopyala pasif

[tahsinanarat]

Arkadaşlar excel sayfası açtığımda kaydet, farklı kaydet ve sayfanın kod bölümüne geçmek için bastığımızda taşı veya kopyala kısımları pasif durumda, bir türlü aktif yapamadım. Bilen arkadaşlarım yardımcı olursa sevinirim.

 

[tahsinanarat]

YABANCI BİR SİTEDE BULDUM, HALLETTİM. KODLAR AŞAĞIDA
Private Sub Worksheet_WindowActivate(ByVal Wn As Window)
Dim oCtrl As Office.CommandBarControl
'Cut
For Each oCtrl In Application.CommandBars.FindControls (ID:=21)
oCtrl.Enabled = False
'Copy
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
'Save
For Each oCtrl In Application.CommandBars.FindControls(ID:=3)
oCtrl.Enabled = False
'Save As
For Each oCtrl In Application.CommandBars.FindControls(ID:=748)
oCtrl.Enabled = False
'Save as Web Page
For Each oCtrl In Application.CommandBars.FindControls(ID:=3823)
oCtrl.Enabled = False
'Save as Workspace
For Each oCtrl In Application.CommandBars.FindControls(ID:=846)
oCtrl.Enabled = False
'Move or Copy Sheet
For Each oCtrl In Application.CommandBars.FindControls(ID:=848)
oCtrl.Enabled = False
'Ctrl C
Application.OnKey "^c", ""
'Ctrl S
Application.OnKey "^s", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Worksheet_WindowDeactivate(ByVal Wn As Window)
Dim oCtrl As Office.CommandBarControl
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
For Each oCtrl In Application.CommandBars.FindControls(ID:=3)
oCtrl.Enabled = True
For Each oCtrl In Application.CommandBars.FindControls(ID:=748)
oCtrl.Enabled = True
For Each oCtrl In Application.CommandBars.FindControls(ID:=3823)
oCtrl.Enabled = True
For Each oCtrl In Application.CommandBars.FindControls(ID:=846)
oCtrl.Enabled = True
For Each oCtrl In Application.CommandBars.FindControls(ID:=848)
oCtrl.Enabled = True
Application.OnKey "^c", ""
Application.OnKey "^s", ""
Application.CellDragAndDrop = True
End Sub