Preserving Undo History Solution

[willjohnson33]

I am running some basic format macros that I have attached to shortcut
keys and I have been searching for a way to preserve Undo history.

I found the post at the bottom of this from back in 1999 that seems as
though it is supposed to work but I can't get it to.

However, I cannot figure out how to integrate this so that it will
work. Here is one of the format macros I would like to add it too.

Sub fmtComma()
' Keyboard Shortcut: Ctrl + Shift + 1
'Dim UnDo As New clsUndo
'Set UnDo = New clsUndo
' UnDo.SetUndo
Selection.NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* --_);_(*
@_)"
' Application.OnUndo "", "Undo.GetUndo"
End Sub

I have put a ' in front of the lines that I have tried to use to
activate the code but I have had no luck.

Thanks
Will


Link -
http://groups.google.com/group/micr...nDo(undo+Level)&rnum=5&hl=en#c5e0c1f38a5e7a94


*****************************************************************
Hi,
Early in the morning I needed help in inplementing Undo command in VBA
macros. I posted a message named 'Undo ?' and soon after that Chip
Pearson
respoded. T H A N K S!
With his idea I wrote simple class module with multilevel undu command.
I
just discovered that Jennifer A. Campion also helped me and her code is

similar to mine.
etc, etc........
############# HERE IS THE MODUL #################
############# START OF VBA CLASS MODUL ##########
Option Explicit
' ***** Public functions
' SetUndo(ByVal obj As Object, ByVal rng As Range)
' GetUndo()
''' ******************************************************
'''
''' Modul's private declarations
'''
''' ******************************************************
Private Type typUndo ' new undo type - OLD CELL
address As String ' address of the cell
value As Variant ' value of the cell
End Type
Private Type typUndoLevel
size As Integer ' size of undo level
data() As typUndo ' undo data
End Type
Dim undoLevel As Integer ' level of undo information
Dim UnDo() As typUndoLevel ' whole undo information
''' ******************************************************
'''
''' P U B L I C F U N C T I O N S / P R E C E D U R E S
'''
''' ******************************************************
'''
'''
''' Procedure : SetUndo
''' Description : Copy range data to undoData (old values)
''' Return value: None
''' Arguments : rng : range with data
''' reset : if true than undolevel is reset to 1
''' Created : Matjaz Prtenjak, 11/10/1999
'''
Public Sub SetUndo(ByVal rng As Range, Optional reset As Boolean =
False)
Dim cell
Dim counter As Long
' set level
If reset Then
undoLevel = 1
ReDim UnDo(undoLevel)
Else
undoLevel = undoLevel + 1
End If
' set tables
ReDim Preserve UnDo(undoLevel)
With UnDo(undoLevel)
.size = rng.Cells.Count
ReDim Preserve .data(.size)
counter = 1
For Each cell In rng.Cells
With .data(counter)
.address = cell.address(External:=True)
.value = cell.Formula
End With
counter = counter + 1
Next
End With
End Sub
'''
'''
''' Procedure : GetUndo
''' Description : Put the old values, previous saved by SetUndo in
place
''' Return value: None
''' Arguments : None
''' Created : Matjaz Prtenjak, 11/10/1999
'''
Public Sub GetUndo()
On Error GoTo quit
Dim i As Long
If undoLevel = 0 Then Exit Sub
Application.ScreenUpdating = False
With UnDo(undoLevel)
For i = 1 To .size
Range(.data(i).address).Formula = .data(i).value
If i Mod 1000 = 0 Then DoEvents
Next
End With
' reset level
If undoLevel > 1 Then
undoLevel = undoLevel - 1
ReDim Preserve UnDo(undoLevel)
End If
quit:
Application.ScreenUpdating = True
End Sub
Private Sub Class_Initialize()
undoLevel = 0
End Sub
Private Sub Class_Terminate()
ReDim UnDo(1)
End Sub
############# START OF VBA CLASS MODUL ##########
############# USE ##########
Dim UnDo As New clsUndo
..........
Set UnDo = New clsUndo
..........
UnDo.SetUndo myRange
UnDo.SetUndo selection
UnDo.SetUndo .....
UnDo.GetUndo
UnDo.GetUndo
.....
I know that there are some thinks that can be inpruved but that is all
i
need in my macros and I will not work on it any more.
Have a nice day and thanks for all the help.
Matjaz Prtenjak
(e-mail address removed)
Slovenija

 

[willjohnson33]

Anyone?