Makro çalıştıktan sonra kayıt yapmıyor.

[mbasarmutcu]

Arkadaşlar elimde makro kullanan bir excel dosyası var.makro çalıştıktan sonra kayıt yapmasını istiyorum dosya kilitleniyor.Forumda aradım bununla ilgili bir konu bulamadım.Yardımcı olursanız çok sevinirim.

 

[MOONROSE]

Merhaba,
Makronun içinde save özelliğini engelleyen satır olabilir kontrol ettiniz mi? Bence kullandığınız makronun kodlarını eklerseniz yardımcı olunabilir.

 

[nziya]

bu kodu kaydetmeyen dosyanızın modulüne yapıştırn ve çalıştırın
Sub AC()
EnableControl 3, True 'kaydet
Application.OnKey "^c"
Application.OnKey "^v"
Application.OnKey "+{DEL}"
Application.OnKey "+{INSERT}"
Application.CellDragAndDrop = True
Application.OnKey "{Del}"
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

 

[mbasarmutcu]

Ben yine forumda benim gibi bir sorunu olan arkadaşa yazılan cevaptan almıştım kodları, aslında sorun şu dosya içinde 250-300 civarında sayfa var ben her defasında bir sayfada kayıtlı bulunan tablolara ulaşmak istiyorum köprü kurmak uzun zaman alıyor ve hata olasılığı çok fazla aşağıdaki kodları yazdım kendi bilgisayarımda çalıştı ve işimi gördü arkadaşın bilgisayarında doyayı açtım makroyu çalıştırdım kayıt yapıp çıkmak istedim.dosya kilitlendi.

Sub BuildTOC()

Application.Goto Reference:="R1C1"
Dim sSheetName As String, sActiveCell As String
Dim cRow As Long, cCol As Long, cSht As Integer
Dim lastcell
Dim qSht As String
Dim mg As String
Dim rg As Range
Dim CRLF As String
Dim Reply As Variant
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
cRow = ActiveCell.Row
cCol = ActiveCell.Column
sSheetName = UCase(ActiveSheet.Name)
sActiveCell = UCase(ActiveCell.Value)

CRLF = Chr(10)
Set rg = Range(Cells(cRow, cCol), Cells(cRow - 1 + ActiveWorkbook.Sheets.Count, cCol + 7))
rg.Select
If sSheetName <> "$$TOC" Then mg = mg & "Sheetname is not $$TOC" & CRLF
If sActiveCell <> "$$TOC" Then mg = mg & "Selected cell value is not $$TOC" & CRLF

rg.Clear
For cSht = 1 To ActiveWorkbook.Sheets.Count
Cells(cRow - 1 + cSht, cCol) = "'" & Sheets(cSht).Name
If TypeName(Sheets(cSht)) = "Worksheet" Then

qSht = Application.Substitute(Sheets(cSht).Name, """", """""")
If CDbl(Application.Version) < 8# Then

Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name
Else
ActiveSheet.Cells(cRow - 1 + cSht, cCol).Formula = _
"=hyperlink(""[" & ActiveWorkbook.Name _
& "]'" & qSht & "'!A1"",""" & qSht & """)"
End If

İlginize çok teşekkür ederim.

 

[nziya]

kodların başına ekkleyip bir deneyin
On Error Resume Next