Kes,Kopyala,Yapıştır ve Özel Yapıştır Çalışmıyor!!!

[ocamsul]

Arkadaşlar merhabalar. Herkese iyi çalışmalar. Benim Office 2003 de bir sorun var zannedersem, çözemedim. Kes,Kopyala,Yapıştır ve Özel Yapıştır ne yaparsam yapayım bir türlü çalışmıyor. Bunun olası nedenlere ve çözüm yolları hakkında bana bilgi verirseniz sevinirim.

 

[Ayhan Ercan]

Merhaba
Sayfanız "Korumalı" olabilir.. !!

 

[ocamsul]

Merhaba
Sayfanız "Korumalı" olabilir.. !!

SN: Ayhan Ercan, üsdat dediğiniz gibi bir sorun yok. Herhangi bir excel sayfasını sil baştan açtığım da bile aynı sırun söz konusu!

 

[Haluk]

Daha önceden kodla, bu menüleri devre dışı bırakmışınızdır.

Yeni bir dosyada bunları etkinleştiren bir kod yazıp, çalıştırın. Sorununuz biter...

.

 

[ocamsul]

Daha önceden kodla, bu menüleri devre dışı bırakmışınızdır.

Yeni bir dosyada bunları etkinleştiren bir kod yazıp, çalıştırın. Sorununuz biter...

.

SN: Haluk, Üsdat; dediğiniz üzre benzer özellikler gösteren, aşağıdaki 2 kodu kullandım ama yinede olmadı!

.Select Application.CutCopyMode = False
ActiveSheet.Shapes("Button 1").Delete
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=SAYFA_ADI & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close True
End Sub

Sub BUL_AKTAR()
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")
S3.Cells.ClearContents
SATIR = 1
For X = 3 To S1.[D65536].End(3).Row
If S1.Cells(X, 1) <> "" Then
Set BUL = S2.[A:A].Find(S1.Cells(X, "D"), LookAt:=xlWhole)
If Not BUL Is Nothing Then
S3.Rows(SATIR).Value = S2.Rows(BUL.Row).Value
SATIR = SATIR + 1
End If
End If
Next
Set BUL = Nothing
Set S1 = Nothing
Set S2 = Nothing
Set S3 = Nothing
MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

 

[Leoncio]

Boş bir excel dosyası açınız ve aşağıdaki kodları çalıştırınız.

Sub ResetMenus()
CommandBars("Cell").Reset
CommandBars(1).Reset
End Sub

 

[ocamsul]

SN: leventer, yardımınız için teşekkür ederim. Tamamdır oldu İyi çalışmalar.

 

[hamitcan]

Galiba geçen sitede konu edilmiş bir örneği çalıştırmışsınız. Ben de aynı sorunu yaşadım. Size kodun bir parçasını gönderiyorum. Çalıştırıp dener misiniz?

Sub nn()
    EnableControl 21, True 'Kes
    EnableControl 19, True ' Kopyala
    EnableControl 22, True ' Yapıştır
    EnableControl 755, True ' özelyapıştır
    Application.OnKey "^c"
    Application.OnKey "^v"
    Application.CellDragAndDrop = True
    CommandBars("ToolBar List").Enabled = 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

 

[CRAYZLOVEIS]

Üstadlar aynı sorun bendede vardı. Bu forumdan bulduğum bir kodu kullandım bazı özellikler kapandı Daha sonra forumdan bulduğum ve aşağıya yazdığım başka bir kodla bu sorunu çözdüm. Size sorum şu. Her ne kadar aşağıdaki kodlarla sorun çözülsede excelde şöyle bir şey yapmak mümkünmü. Öyle bir kod kullanalim ki exceli kapatırken bütün ayarları ilk kurulumdaki ayarlara dönsün. Yani Formul çubuğundan durum çubuğuna kadar herşey...Yani excel fabrika ayarlarına dönsün

Sub AUTO_OPEN()
Dim CB As CommandBar
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
For Each CB In Application.CommandBars
CB.Enabled = False
Next CB
With ActiveWindow
.DisplayHeadings = False
.DisplayOutline = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
Run ("DisableCutAndPaste")
End Sub
--------------------------------------------------------
Sub AUTO_CLOSE()
Run ("EnableCutAndPaste")
Sor = MsgBox("Yaptığınız Değişiklikler Kaydedilsin mi?", 4, "Dikkat")
If Sor = vbYes Then
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close
End If
End Sub
Sub DisableCutAndPaste() ' 'kopyala kes yapıştırı açılışta pasif yapar
EnableControl 21, False ' kes
EnableControl 19, False ' kopyala
EnableControl 22, False ' yapıştır
EnableControl 755, False ' özel yapıştır
Application.CellDragAndDrop = False 'hücreyi çoğaltma ve taşıma
CommandBars("ToolBar List").Enabled = False 'düzen menüsündeki ilgili menüleri gizle
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
End Sub
Sub EnableCutAndPaste() ' 'kopyala kes yapıştırı kapanışta aktif yapar
EnableControl 21, True ' kes
EnableControl 19, True ' kopyala
EnableControl 22, True ' yapıştır
EnableControl 755, True ' özel yapıştır
Application.CellDragAndDrop = True 'hücreyi çoğaltma ve taşıma
CommandBars("ToolBar List").Enabled = True 'düzen menüsündeki ilgili menüleri göster
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Dim CB As CommandBar
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
For Each CB In Application.CommandBars
CB.Enabled = True
Next CB
With ActiveWindow
.DisplayOutline = True
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = True
End With
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