Reputation:
I send a spreadsheet to have information updated and then sent back to me.
I put validation and lock the cells to force users to input accurate information. I use VBA to disable the workaround of cut copy and paste functions. Additionally I inserted a VBA function to force users to open the Excel file in Macros.
I'm trying to track the changes so I know what was updated when I recieve the sheet back. I get an error when someone saves the document and randomly it will lock me out of the document completely.
How can I highlight changes through VBA instead of through Excel's share/track changes option?
ThisWorkbook:
Option Explicit
Const WelcomePage = "Macros"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleCutCopyAndPaste(True)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If
'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True
'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub
Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False
'Record active worksheet
Set aWs = ActiveSheet
'Hide all sheets
Call HideAllSheets
'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If
'Restore file to where user was
Call ShowAllSheets
aWs.Activate
'Restore screen updates
Application.ScreenUpdating = True
End Sub
Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet
Worksheets(WelcomePage).Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws
Worksheets(WelcomePage).Activate
End Sub
Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws
Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
Private Sub Workbook_Activate()
Call ToggleCutCopyAndPaste(False)
End Sub
Private Sub Workbook_Deactivate()
Call ToggleCutCopyAndPaste(True)
End Sub
In a Module:
Option Explicit
Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
Call EnableMenuItem(21, Allow) ' cut
Call EnableMenuItem(19, Allow) ' copy
Call EnableMenuItem(22, Allow) ' paste
Call EnableMenuItem(755, Allow) ' pastespecial
'Activate/deactivate drag and drop ability
Application.CellDragAndDrop = Allow
'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case Is = False
.OnKey "^c", "CutCopyPasteDisabled"
.OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
.OnKey "+{DEL}", "CutCopyPasteDisabled"
.OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case Is = True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
End Select
End With
End Sub
Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
End If
Next
End Sub
Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
MsgBox " Cutting, copying and pasting have been disabled in this workbook. Please hard key in data. "
End Sub
Upvotes: 1
Views: 6958
Reputation: 31
When you need to track and compare changes, there is an easy way without macros at all: try the Version Control add-in for Excel.
You can compare your original spreadsheet with the versions received from other users. Ideally they should also have the add-in installed, but not necessarily.
If you want to keep track of changes in your macro modules, then this Version Control for VBA macros is a lifesaver.
Upvotes: 0
Reputation:
Why don't you check up Ozgrid.com:
http://www.ozgrid.com/VBA/track-changes.htm
You can directly implement the code easily and also add several features like highlighting the changed cells, etc. in color.
Upvotes: 0
Reputation:
I modified your module slightly as shown below and called the function in 'Workbook_Open' and 'Workbook_Beforeclose' sections of 'This Workbook'. In the former the function argument was False, while in the latter the argument was True. It works well. You would also do well to refer to Yogesh's code, which is more comprehensive. The URL for that is: http://ygblogs.blogspot.com/2009/04/macros-in-excel-disable-cut-copy-paste.html
Insert the following into a module:
Option Explicit
Dim Allow As Boolean, ctlId As Integer, Enabled As Boolean
Function ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
With Application
Select Case Allow
Case False
.OnKey "^c", "CutCopyPasteDisabled"
.OnKey "^v", "CutCopyPasteDisabled"
.OnKey "^x", "CutCopyPasteDisabled"
.OnKey "+{DEL}", "CutCopyPasteDisabled"
.OnKey "^{INSERT}", "CutCopyPasteDisabled"
Case True
.OnKey "^c"
.OnKey "^v"
.OnKey "^x"
.OnKey "+{DEL}"
.OnKey "^{INSERT}"
End Select
.CutCopyMode = Allow
.CellDragAndDrop = Allow
End With
'Activate/Deactivate specific menu item
Dim cBar As CommandBar
Dim cBarCtrl As CommandBarControl, i As Integer
For i = 1 To 4
If i = 1 Then ctlId = 21
If i = 2 Then ctlId = 19
If i = 3 Then ctlId = 22
If i = 4 Then ctlId = 755
For Each cBar In Application.CommandBars
If cBar.Name <> "Clipboard" Then
Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Allow
End If
Next
Next i
End Function
Insert the following in the ThisWorkbook section of the VBA editor:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToggleCutCopyAndPaste (True)
End Sub
Private Sub Workbook_Open()
ToggleCutCopyAndPaste (False)
End Sub
Upvotes: 1