Undo approach

F

filo666

Hello, I created a very nice visualisation function in excel that creates
shapes in a structure "SheetSelectionChange", the problem is that when I run
the program all the undos are deleted, I know how to create the program for 1
undo, however I need to have the possibility of 30 or 50 undos, could someone
can give me a general idea of how to create a program that replaces the undo
program of excel but that will work even after any macro is run.

TIA
 
J

Jim Thomlinson

That is the problem with macros. When they are run they clear out all of the
undo levels. When I say clear out I mean gone forever. The only way around it
is to store the changes that they user is making in a worksheet somewhere or
such. Then via your own undo routine you can reverse the changes. That is
possibly a whole pile of code to write. I have done it once before but it was
only capturing the values changed when the change event fired. I then copied
the values onto a hidden worksheet essentailly as a stack. When they hit the
undo button it removed values from the stack and put them back into the
original sheet.

P.S. Nice to see you back. It's been a while since you posted around here...
 
F

filo666

It is nice to be here again, do you think is posible to save 30 or 40 public
variables (as ranges) and then call them back with the undo button?

How do I set the undo button for more than one event?

I paste my code so that you can see what I did:

Public ct As Object
Public shp1, shp2 As Shape
Private WithEvents XLApp As Excel.Application

Private Sub Workbook_Open()
Set XLApp = Excel.Application
End Sub

Private Sub XLApp_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As
Range, Cancel As Boolean)
On Error GoTo eh
shp1.Delete
shp2.Delete
Cancel = True
eh:
End Sub


Private Sub XLApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As
Range)
Application.EnableEvents = False
On Error Resume Next
Set ct = ActiveWorkbook.ActiveSheet
rw = ct.Cells.Find(What:="*", After:=ct.Range("A1"), Lookat:=xlPart,
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious,
MatchCase:=False).Row
cl = ct.Cells.Find(What:="*", After:=ct.Range("A1"), Lookat:=xlPart,
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious,
MatchCase:=False).Column
'If ct.Shapes.Count > 1 Then
'For cnt1 = 0 To 30
'num1 = ct.Shapes.Count - cnt1
'shptype = ct.Shapes(num1).Height
'If Range().Height = shptype Then
'ct.Shapes(num1).Delete
'ct.Shapes(num1 - 1).Delete
'cnt1 = 30
'End If
'Next
'End If
shp1.Delete
shp2.Delete
lft = Range(Selection.Address).Left
tp = Range(Selection.Address).Top
wth = Range(Selection.Address).Width
hgt = Range(Selection.Address).Height

lastlft = Cells(rw, cl).Left
lasttp = Cells(rw, cl).Top
lastwth = Cells(rw, cl).Width
lasthgt = Cells(rw, cl).Height

If Selection.Column > cl Or Selection.Row > rw Then
lastlft = Range(Selection.Address).Left
lasttp = Range(Selection.Address).Top
lastwth = Range(Selection.Address).Width
lasthgt = Range(Selection.Address).Height
End If

Set shp1 = ct.Shapes.AddShape(msoShapeRectangle, lft, 0, wth, lasttp +
lasthgt)
shp1.Fill.Visible = msoFalse
Set shp2 = ct.Shapes.AddShape(msoShapeRectangle, 0, tp, lastlft + lastwth,
hgt)
shp2.Fill.Visible = msoFalse
Application.EnableEvents = True
End Sub
 
J

Jim Thomlinson

Range variables are just pointers to ranges so that will not work as they
will just return the current contents of the range. You could store the
values in a Multi-dim array. Essentially it would be Rows, Columns and undo
levels. The problem with this appoach is that you loose formatting changes
and also formulas if there are formulas in the range you are storing... The
long and the short is there is no easy way. That being said nice looking
code. Based on what I see you are capable of coming up with some kind of a
solution that will work in at least some limited fashion.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top