#1
|
||||
|
||||
Enabling the undo function in a macro enabled workbook
Hey fellas,
I have a macro-enabled workbook, which means the undo button is greyed out. I need the undo button. So I figure the best solution is to copy the worksheet to a hidden one for each change made, and then make the undo button show that saved worksheet. I'm not real sure on the syntax of saving copies of worksheets to hidden ones for this purpose. Any ideas, VBA community? |
#2
|
|||
|
|||
When I look at my Macro Enabled Workbook the "Undo" is not Grayed out.
So: Is the sheet protected? If so you need to unprotect it. |
#3
|
||||
|
||||
It is protected, yes. It must, however, remain protected in order to prevent certain locked cells from being modified. It is a protected worksheet with tracked changes enabled. I've made a macro that activates whenever a change is made to the worksheet. This is why undo is greyed out. When you use the Worksheet_Change function, VBA clears the undo stack. My solution to this is to save the worksheet to a hidden one before each change is made, and then restore it if the user wishes to undo an action. I just need some help on how to do this programatically.
|
#4
|
||||
|
||||
Here is what I have so far. The undo and redo kind of work...some of the time. The real problem is when you undo a pile of actions and then try redoing them. Or if you undo something and then perform an action, it does not clear the redo.
Worksheet code: Code:
'/////////////////////////////////////////////////////////// '///////WorkSheet_Change - Highlight changed cells////////// '/////////////////////////////////////////////////////////// Private Sub Worksheet_Change(ByVal Target As Range) 'Set range Const WS_RANGE As String = "A12:AG100" 'Error handler On Error GoTo ws_exit: Application.EnableEvents = False If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then With Target With .Interior 'Set cell fill color on change .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With End With End If ws_exit: Application.EnableEvents = True 'Save worksheet for undo Call ThisWorkbook.MakeUndoLevel End Sub '//////////////////////END////////////////////////////////// '/////////////////////////////////////////////////////////// '////////Clear_Changes -> Revert cell color to none///////// '/////////////////////////////////////////////////////////// Sub Clear_Changes() 'Set range Range("A12:AG100").Select With Selection.Interior 'Set fill color to none for cell range .Pattern = xlNone End With End Sub '//////////////////////END////////////////////////////////// '/////////////////////////////////////////////////////////// '////////Clear_Changes -> Revert cell color to none///////// '/////////////////////////////////////////////////////////// Sub Clear_Selected_Cell() With Selection.Interior .Pattern = xlNone End With End Sub '//////////////////////END////////////////////////////////// Code:
Option Explicit 'Declare global variables Dim UndoLevel As Long Dim RedoLevel As Long '/////////////////////////////////////////////////////////// '//////Workbook_BeforeClose - Delete undo/redo worksheets/// '/////////////////////////////////////////////////////////// Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim Counter As Long ActiveWorkbook.Application.DisplayAlerts = False For Counter = (UndoLevel - 1) To 0 Step -1 Sheets(CStr(Counter)).Delete Next ActiveWorkbook.Application.DisplayAlerts = True End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '//////Workbook_Open - Set initial undo/redo levels and///// '////////////////save an initial undo level.//////////////// '/////////////////////////////////////////////////////////// Private Sub Workbook_Open() UndoLevel = 0 RedoLevel = 0 Call MakeUndoLevel End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '//////MakeUndoLevel - Save a copy of the worksheet and///// '/////////////////////////hide it.////////////////////////// '/////////////////////////////////////////////////////////// Public Sub MakeUndoLevel() Sheets("TBGS").Select Sheets("TBGS").Copy After:=Sheets(1) Sheets("TBGS (2)").Select Sheets("TBGS (2)").Name = CStr(UndoLevel) Sheets(CStr(UndoLevel)).Select ActiveWindow.SelectedSheets.Visible = False UndoLevel = UndoLevel + 1 End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '/////////UndoAction - undo the most recent change////////// '/////////////////////////////////////////////////////////// Public Sub UndoAction() If UndoLevel <> 1 Then Sheets(CStr(UndoLevel - 2)).Visible = True ActiveWorkbook.Application.DisplayAlerts = False Sheets("TBGS").Delete ActiveWorkbook.Application.DisplayAlerts = True Sheets(CStr(UndoLevel - 2)).Name = "TBGS" Sheets(CStr(UndoLevel - 1)).Name = CStr(UndoLevel - 2) UndoLevel = UndoLevel - 1 RedoLevel = RedoLevel + 1 Else MsgBox "There is nothing to undo!" End If End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '//////RedoAction - redo a change that has been undone////// '/////////////////////////////////////////////////////////// Public Sub RedoAction() If RedoLevel <> 0 Then Sheets(CStr(UndoLevel - 1)).Visible = True Sheets("TBGS").Name = "Temp" Sheets("Temp").Visible = False Sheets(CStr(UndoLevel - 1)).Name = "TBGS" Sheets("Temp").Name = CStr(UndoLevel - 1) Call MakeUndoLevel RedoLevel = RedoLevel - 1 Else MsgBox "There is nothing to redo!" End If End Sub '////////////////////////////END//////////////////////////// Last edited by jpb103; 06-04-2014 at 10:45 AM. Reason: Lost my mind |
#5
|
||||
|
||||
Solved. Code follows:
Worksheet code: Code:
'/////////////////////////////////////////////////////////// '///////WorkSheet_Change - Highlight changed cells////////// '/////////////////////////////////////////////////////////// Private Sub Worksheet_Change(ByVal Target As Range) 'Set range Const WS_RANGE As String = "A12:AG100" 'Error handler On Error GoTo ws_exit: Application.EnableEvents = False If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then With Target With .Interior 'Set cell fill color on change .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With End With End If ws_exit: Application.EnableEvents = True 'Save worksheet for undo Call ThisWorkbook.ClearRedoLevel Call ThisWorkbook.MakeUndoLevel End Sub '//////////////////////END////////////////////////////////// '/////////////////////////////////////////////////////////// '///////Clear_Changes -> Set sheet cell color to none/////// '/////////////////////////////////////////////////////////// Sub Clear_Changes() 'Set range Range("A12:AG100").Select With Selection.Interior 'Set fill color to none for cell range .Pattern = xlNone End With End Sub '//////////////////////END////////////////////////////////// '/////////////////////////////////////////////////////////// '////Clear_Selected_Cell -> Revert cell color to none/////// '/////////////////////////////////////////////////////////// Sub Clear_Selected_Cell() With Selection.Interior .Pattern = xlNone End With End Sub '//////////////////////END////////////////////////////////// Code:
Option Explicit 'Declare global variables Dim UndoLevel As Long Dim RedoLevel As Long '/////////////////////////////////////////////////////////// '//////Workbook_BeforeClose - Delete undo/redo worksheets/// '/////////////////////////////////////////////////////////// Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim Counter As Long 'Clean up workbook by deleting hidden worksheets before close ActiveWorkbook.Application.DisplayAlerts = False If ActiveWorkbook.Sheets.Count > 1 Then For Counter = (ActiveWorkbook.Sheets.Count - 2) To 0 Step -1 Sheets(CStr(Counter)).Delete Next End If ActiveWorkbook.Application.DisplayAlerts = True End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '//////Workbook_Open - Set initial undo/redo levels and///// '////////////////save an initial undo level.//////////////// '/////////////////////////////////////////////////////////// Private Sub Workbook_Open() 'Initialize global variables UndoLevel = 0 RedoLevel = 0 'Save a copy of initial worksheet Call MakeUndoLevel End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '//////MakeUndoLevel - Save a copy of the worksheet and///// '/////////////////////////hide it.////////////////////////// '/////////////////////////////////////////////////////////// Public Sub MakeUndoLevel() 'Copy active worksheet Sheets("TBGS").Select Sheets("TBGS").Copy After:=Sheets(1) 'Rename and hide copied worksheeet Sheets("TBGS (2)").Select Sheets("TBGS (2)").Name = CStr(UndoLevel) Sheets(CStr(UndoLevel)).Select ActiveWindow.SelectedSheets.Visible = False 'Increment undo level UndoLevel = UndoLevel + 1 End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '/////////UndoAction - undo the most recent change////////// '/////////////////////////////////////////////////////////// Public Sub UndoAction() If UndoLevel <> 1 Then 'Restore last saved undo worksheet Sheets(CStr(UndoLevel - 2)).Copy After:=Sheets(1) Sheets((CStr(UndoLevel - 2) + " (2)")).Visible = True ActiveWorkbook.Application.DisplayAlerts = False Sheets("TBGS").Delete ActiveWorkbook.Application.DisplayAlerts = True Sheets((CStr(UndoLevel - 2) + " (2)")).Name = "TBGS" 'Decrement undo level UndoLevel = UndoLevel - 1 'Increment redo level RedoLevel = RedoLevel + 1 Else MsgBox "There is nothing to undo!" End If End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '//////RedoAction - redo a change that has been undone////// '/////////////////////////////////////////////////////////// Public Sub RedoAction() If RedoLevel <> 0 Then 'Restore next saved redo worksheet Sheets(CStr(UndoLevel)).Visible = True ActiveWorkbook.Application.DisplayAlerts = False Sheets("TBGS").Delete ActiveWorkbook.Application.DisplayAlerts = True Sheets(CStr(UndoLevel)).Name = "TBGS" Call MakeUndoLevel 'Decrement redo level RedoLevel = RedoLevel - 1 Else MsgBox "There is nothing to redo!" End If End Sub '////////////////////////////END//////////////////////////// '/////////////////////////////////////////////////////////// '////////ClearRedoLevel - Sets the RedoLevel to 0/////////// '/////////////////////////////////////////////////////////// Public Sub ClearRedoLevel() Dim Counter As Long For Counter = (RedoLevel + UndoLevel - 1) To UndoLevel Step -1 ActiveWorkbook.Application.DisplayAlerts = False 'Delete saved redo worksheets Sheets(CStr(Counter)).Delete ActiveWorkbook.Application.DisplayAlerts = False Next RedoLevel = 0 End Sub '////////////////////////////END//////////////////////////// |
Tags |
hidden, undo, worksheet |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
custom icon, undo/redo for macro, permanent macro | Rapier | Excel | 0 | 08-05-2013 06:30 AM |
Saving as ( PowerPoint Macro-Enabled Slide Show )?? | delete123 | PowerPoint | 2 | 04-10-2013 05:38 AM |
Macro-enabled Template | ReviTULize | Word VBA | 4 | 02-01-2013 01:46 PM |
strangeness in undo function? | jeffk | Word | 5 | 12-11-2012 10:25 AM |
macro to transfer data from one workbook to another workbook | virsojour | Excel Programming | 5 | 02-01-2011 08:58 PM |