自定义 excel 2010 突出显示修订

自定义 excel 2010 突出显示修订

有没有办法自定义 Excel 在“修订”中突出显示单元格的方式?我的客户要求我们“通过将文本颜色更改为红色来突出显示您所做的任何更改”,我想实现这一点。我目前正在寻找一种使用 VBA 来实现它的方法,我的想法是:

if (current cell has changed) and (changed has NOT been approved) then
    set color of current cell = red
else 
    remove color of current cell. 
end if  

任何建议都值得赞赏!

答案1

您可以使用 VBA 中的“工作表更改”事件来执行此操作。我开始为您构建一个简单的示例,但我意识到您的客户可能希望在检查完您的更改后能够回滚任何突出显示。因此,我决定制作一个可以完成所有工作的完整工作模型。以下是您需要遵循的步骤:

Alt+F11在 Excel 中打开 VBA 编辑器。在对象浏览器(在 VBA 窗口左侧)中,双击要编辑的工作表。将以下代码粘贴到打开的文本字段中。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet, ws2 As Worksheet
Dim i As Boolean
Application.ScreenUpdating = False

'Create Change Log if one does not exist.
i = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Change Log" Then
        i = True
        Exit For
    End If
Next ws
If Not i Then
   Set ws2 = ThisWorkbook.Worksheets.Add
   ws2.Visible = xlSheetHidden
   ws2.Name = "Change Log"
   ws2.Range("A1") = "Sheet"
   ws2.Range("B1") = "Range"
   ws2.Range("C1") = "Old Text Color"
Else
   Set ws2 = Sheets("Change Log")
End If

'Store previous color data in change log for rollback.
ws2.Range("A1").Offset(ws2.UsedRange.Rows.Count, 0) = Target.Worksheet.Name
ws2.Range("B1").Offset(ws2.UsedRange.Rows.Count - 1, 0) = Target.Address
ws2.Range("C1").Offset(ws2.UsedRange.Rows.Count - 1, 0) = Target.Font.Color

'Change font color to red.
Target.Font.Color = 255

Application.ScreenUpdating = True
End Sub

此代码会将您编辑值的任何单元格的字体颜色更改为红色。如果您仅更改单元格的格式,则不会更改字体颜色。此外,它不会自动更改从属单元格的字体颜色。后者可以做到,但如果您想要这种行为,我会把它留给您。

此代码还创建一个隐藏的 Change Log 表,并记录已更改单元格的地址和原始字体颜色。

请注意,此代码仅适用于该特定工作表的更改。如果您想跟踪整个工作簿的更改,您可以将相同的代码粘贴到每个工作表的工作表模块中。

回滚任何突出显示的代码必须放在单独的模块中。在 VBA 编辑器中,转到插入 >> 模块。将以下代码粘贴到新模块中。

Sub rollbackHILITE()

Dim sht As Worksheet, cl As Worksheet
Dim j As Long, roll() As Variant
Dim del As Integer
Application.ScreenUpdating = False

'Find Change Log.  If it doesn't exist, user is prompted and exits sub.
For Each sht In ThisWorkbook.Worksheets
    If sht.Name = "Change Log" Then
        Set cl = sht
        Exit For
    End If
Next sht
If cl Is Nothing Then
    MsgBox "Change Log not found!"
    Exit Sub
End If

'Return font colors to original form by stepping backward through change log.
If cl.UsedRange.Rows.Count > 1 Then
    roll = cl.Range("A2:C2").Resize(cl.UsedRange.Rows.Count - 1, 3)
    For j = UBound(roll, 1) To 1 Step -1
        Set sht = Sheets(roll(j, 1))
        sht.Range(roll(j, 2)).Font.Color = roll(j, 3)
    Next j
End If
Application.ScreenUpdating = True

'Prompt User to keep or delete change log after rollback.
del = MsgBox("Delete Change Log?", vbOKCancel, "Finish Rollback")
If del = 1 Then
    cl.Delete
End If

End Sub

此代码可以从 Excel 中的宏菜单运行。它只是将突出显示的单元格的字体颜色恢复为原始颜色,然后在用户同意的情况下删除更改日志。

相关内容