vba 突出显示 Excel 中的更改
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/1347876/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Highlight changes in Excel
提问by
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.
我进行验证并锁定单元格以强制用户输入准确的信息。我使用 VBA 来禁用剪切复制和粘贴功能的解决方法。此外,我插入了一个 VBA 函数来强制用户在宏中打开 Excel 文件。
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?
如何通过 VBA 而不是通过 Excel 的共享/跟踪更改选项突出显示更改?
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
回答by
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
我稍微修改了您的模块,如下所示,并在“本工作簿”的“Workbook_Open”和“Workbook_Beforeclose”部分调用了该函数。在前者中,函数参数为 False,而在后者中,参数为 True。它运作良好。你也可以参考 Yogesh 的代码,它更全面。其 URL 是: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:
在 VBA 编辑器的 ThisWorkbook 部分插入以下内容:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ToggleCutCopyAndPaste (True)
End Sub
Private Sub Workbook_Open()
ToggleCutCopyAndPaste (False)
End Sub
回答by eriklind
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.
当您需要跟踪和比较更改时,有一种完全没有宏的简单方法:尝试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 macrosis a lifesaver.
如果您想跟踪宏模块中的更改,那么此VBA 宏版本控制是一个救星。
回答by eriklind
Why don't you check up Ozgrid.com:
你为什么不检查 Ozgrid.com:
http://www.ozgrid.com/VBA/track-changes.htm
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.
您可以轻松地直接实现代码,还可以添加一些功能,例如以颜色突出显示更改的单元格等。