将条件格式转换为静态格式

Question

我浏览了Make conditional formatting static，发现该代码似乎不再适用于Office 19。

在代码行

Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)

显示

运行时错误13-类型不匹配

Option Explicit

Sub FreezeConditionalFormattingOnSelection()
Call FreezeConditionalFormatting(Selection)
Selection.FormatConditions.Delete
End Sub

Public Function FreezeConditionalFormatting(rng As Range)
Rem Originally posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
Rem Modified 2012-04-20 by gcl to:
Rem   (a) be a function taking target range as an argument, and
Rem   (b) to cancel any multiple selection before processing in order to work around a bug
Rem         in Excel 2003 wherein querying the formula on any cell in a multiple/extended selection
Rem         returns the conditional formatting on the first cell in that selection!
Rem   (c) return number of cells that it modified.

Dim iconditionno As Integer
Dim rgeCell As Range
Dim nCFCells As Integer
Dim rgeOldSelection As Range

Set rgeOldSelection = Selection 'new

nCFCells = 0
For Each rgeCell In rng
rgeCell.Select  'new

If rgeCell.FormatConditions.Count <> 0 Then
iconditionno = ConditionNo(rgeCell)
If iconditionno <> 0 Then
rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex
rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
nCFCells = nCFCells + 1
End If
End If
Next rgeCell

rgeOldSelection.Select 'new

FreezeConditionalFormatting = nCFCells
End Function

Private Function ConditionNo(ByVal rgeCell As Range) As Integer
Rem posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static

Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition

For iconditionscount = 1 To rgeCell.FormatConditions.Count
Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
Select Case objFormatCondition.Type
Case xlCellValue
Select Case objFormatCondition.Operator
Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
ConditionNo = iconditionscount

Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
ConditionNo = iconditionscount

Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount

Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount

Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount

Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount

Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount

Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
ConditionNo = iconditionscount

If ConditionNo > 0 Then Exit Function
End Select

Case xlExpression
If Application.Evaluate(objFormatCondition.Formula1) Then
ConditionNo = iconditionscount
Exit Function
End If
End Select

Next iconditionscount
End Function

Private Function Compare(ByVal vValue1 As Variant, _
ByVal sOperator As String, _
ByVal vValue2 As Variant) As Boolean

If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)

If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)

Select Case sOperator
Case "=": Compare = (vValue1 = vValue2)
Case "<": Compare = (vValue1 < vValue2)
Case "<=": Compare = (vValue1 <= vValue2)
Case ">": Compare = (vValue1 > vValue2)
Case ">=": Compare = (vValue1 >= vValue2)
Case "<>": Compare = (vValue1 <> vValue2)
End Select
End Function

Answer 1

请尝试下一种更简单的方法。选择一个条件格式的单元格并运行下一个代码：

Sub testStaticCelFormatFromCondForm()
With ActiveCell
.Interior.Color = .DisplayFormat.Interior.Color
.Font.Color = .DisplayFormat.Font.Color
.Font.Bold = .DisplayFormat.Font.Bold
.Font.Italic = .DisplayFormat.Font.Italic
.Borders(xlEdgeLeft).Weight = .DisplayFormat.Borders(xlEdgeLeft).Weight
.FormatConditions.Delete
End With
End Sub

或者将其用于选定范围内的所有单元格：

Sub RangeStaticCelFormatFromCondForm()
Dim rng As Range, cel As Range
Set rng = Selection
For Each cel In rng
With cel
.Interior.Color = .DisplayFormat.Interior.Color
.Font.Color = .DisplayFormat.Font.Color
.Font.Bold = .DisplayFormat.Font.Bold
.Font.Italic = .DisplayFormat.Font.Italic
.Borders(xlEdgeLeft).Weight = .DisplayFormat.Borders(xlEdgeLeft).Weight
End With
Next
rng.FormatConditions.Delete
End Sub

最后一种情况适用于单个单元格条件，但条件格式将在最后删除，适用于所有范围，因此不会遗漏任何内容。。。

Answer 2

感谢您对代码的帮助。

利用我所掌握的基本知识和@faneduru等用户的帮助，我能够更快地调整代码。谢谢大家的帮助。如果有任何反馈，请告诉我

请找到以下代码-

Sub FreezeConditionalFormattingOnSelection()
Dim Rng As Range, cel As Range, rng2 As Range


On Error GoTo Step102

Step101:
Set Rng = Application.Selection
Set Rng = Application.InputBox(Prompt:="Select range to check for conditional formatting", Title:="Select range", Default:=Rng.Address, Type:=8)
If Rng.Rows.Count < 2 Or Rng.Columns.Count < 2 Then
MsgBox "Please select a range containing more than 2 cells. Reselect range!!", vbCritical, "Range selection error"
GoTo Step101
End If


Set rng2 = Rng.Cells.SpecialCells(xlCellTypeAllFormatConditions)

For Each cel In rng2
With cel
.Interior.Color = .DisplayFormat.Interior.Color
.Font.Color = .DisplayFormat.Font.Color
.Font.Bold = .DisplayFormat.Font.Bold
.Font.Italic = .DisplayFormat.Font.Italic
End With
Next
Rng.FormatConditions.Delete
Exit Sub
Step102:
MsgBox "No conditional formatting cells found in selected range.", vbInformation, "No conditional formats found"
End Sub