Konuyla ilgili bir kod buldum bu konunun üstadı Sn. Haluk uyarlayabilir.
Alıntıdır.
[vb:1:20d58de2f2]Option Explicit
'// This Sub creates a registry key for
'// HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Excel\Options
'// Creates Ref to Windows Script Host Object Model
'// C:\WINDOWS\SYSTEM\WSHOM.OCX
Const strKey As String = "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Excel\Options\UndoHistory"
Const strType As String = "REG_DWORD"
Const dVal = 16 ' Change this NB: > 100 Not recomended by Microsoft
Sub ChangeXlUndoHistory()
Dim objWSH As Object
Set objWSH = CreateObject("WScript.Shell")
objWSH.RegWrite strKey, dVal, strType
Set objWSH = Nothing
MsgBox ReadRegEdit(strKey)
End Sub
'// To Read a Key
Function ReadRegEdit(key)
Dim Ws, Tmp
Set Ws = CreateObject("WScript.Shell")
Tmp = Ws.RegRead(key)
If Tmp = "" Then
ReadRegEdit = ""
Else
ReadRegEdit = Tmp
End If
Set Ws = Nothing
End Function[/vb:1:20d58de2f2]
Alıntı olarak vermiş olduğunuz makroyu denedim.
Office 2003 kullanıyorum.
Bu makro HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Excel\Options\UndoHistory
Regedit teki DWord değerini değiştirmeye yarıyor.
uygulanan makroyu geri almıyor.
Yazılan makroyu değilde, excelde en son yaptığınız işlemi geri alabilirsiniz.
Ufak bir kod ama işinizi belki görür.
[vb:1:5295fc1ba1]Sub gerial()
Application.Undo
End Sub[/vb:1:5295fc1ba1]
Şöyle bir yol olabilirmi.
Makro çalımaya başlamadan önce çalışma kitabını kaydetsin, sonra işlem yapsın. Geri alma işlemi için kaydettiği sayfayı açsın. (Veya manuelde açılabilir.)
Makro kodlamasını bilmediğim için olabilirmi bilmiyorum.
Sn. kombo, burada asıl amaç makro kodlarını geri almak. Sizin dediğiniz bir nevi yedekleme (işi garantiye alma) , yedeğe geri dönme.
Sn. modalı, verdiği linkteki kodlar ise yapılan işlemin tersini alma.
Eğer ki o istenseydi, bir örnek daha ekleyecektim.
SAYGIDEĞER ARKADAŞLAR,
SİZCE BU KODLARI NEREYE YERLEŞTİRMEK GEREKLİ.
SAYGILARIMLA...
Option Explicit
Private mUndoObject As Object
Private msProperty As String
Private mvNewValue As Variant
Private mvOldValue As Variant
Public Property Let PropertyToChange(sProperty As String)
msProperty = sProperty
End Property
Public Property Get PropertyToChange() As String
PropertyToChange = msProperty
End Property
Public Property Set ObjectToChange(oObj As Object)
Set mUndoObject = oObj
End Property
Public Property Get ObjectToChange() As Object
Set ObjectToChange = mUndoObject
End Property
Public Property Let NewValue(vValue As Variant)
mvNewValue = vValue
End Property
Public Property Get NewValue() As Variant
NewValue = mvNewValue
End Property
Public Property Let OldValue(vValue As Variant)
mvOldValue = vValue
End Property
Public Property Get OldValue() As Variant
OldValue = mvOldValue
End Property
Public Function ExecuteCommand() As Boolean
ExecuteCommand = False
If mUndoObject Is Nothing Then
End If
If mvNewValue = "" Then
End If
If msProperty = "" Then
End If
If GetOldValue Then
SetNewValue
ExecuteCommand = True
Else
'Failed to retrieve old value!
End If
End Function
Private Function GetOldValue() As Boolean
Dim oTemp As Object
Dim lCount As Long
Dim lProps As Long
Dim vProps As Variant
vProps = Split(PropertyToChange, ".")
lProps = UBound(vProps)
Set oTemp = ObjectToChange
For lCount = 0 To lProps - 1
Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
Next
If TypeOf oTemp Is Range Then
If LCase(vProps(lProps)) = "value" Then
vProps(lProps) = "Formula"
End If
End If
OldValue = CallByName(oTemp, vProps(lProps), VbGet)
If Err.Number = 0 Then
GetOldValue = True
Else
GetOldValue = False
End If
End Function
Private Function SetNewValue() As Boolean
Dim oTemp As Object
Dim lCount As Long
Dim lProps As Long
Dim vProps As Variant
Dim vResult As Variant
Err.Clear
Set oTemp = ObjectToChange
vProps = Split(PropertyToChange, ".")
lProps = UBound(vProps)
For lCount = 0 To lProps - 1
Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
Next
If TypeOf oTemp Is Range Then
If LCase(vProps(lProps)) = "value" Then
vProps(lProps) = "Formula"
End If
End If
vResult = CallByName(oTemp, vProps(lProps), VbLet, NewValue)
If Err.Number = 0 Then
SetNewValue = True
Else
SetNewValue = False
End If
End Function
Public Function UndoChange()
Dim oTemp As Object
Dim lCount As Long
Dim lProps As Long
Dim vProps As Variant
Dim vResult As Variant
Set oTemp = ObjectToChange
vProps = Split(PropertyToChange, ".")
lProps = UBound(vProps)
For lCount = 0 To lProps - 1
Set oTemp = CallByName(oTemp, vProps(lCount), VbGet)
Next
If TypeOf oTemp Is Range Then
If LCase(vProps(lProps)) = "value" Then
vProps(lProps) = "Formula"
End If
End If
vResult = CallByName(oTemp, vProps(lProps), VbLet, OldValue)
If vResult <> "" Then
UndoChange = True
Else
UndoChange = False
End If
End Function
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.