魔龙骑士玩具枪:关于条件格式下的vba获取单元格的背景色
来源:百度文库 编辑:中财网 时间:2024/04/29 06:12:00
home中解决的方案:
Function ConditionalColor(rg As Range, FormatType As String) As Long
Dim cel As Range
Dim tmp As Variant
Dim boo As Boolean
Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
Dim i As Long
Set cel = rg.Cells(1, 1)
Select Case Left(LCase(FormatType), 1)
Case "f"
ConditionalColor = cel.Font.ColorIndex
Case Else
ConditionalColor = cel.Interior.ColorIndex
End Select
If cel.FormatConditions.Count > 0 Then
With cel.FormatConditions
For i = 1 To .Count
frmla = .Item(i).Formula1
If Left(frmla, 1) = "=" Then
frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
boo = Application.Evaluate(frmlaA1)
Else
Select Case .Item(i).Operator
Case xlEqual
frmla = cel & "=" & .Item(i).Formula1
Case xlNotEqual
frmla = cel & "<>" & .Item(i).Formula1
Case xlBetween
frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween
frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess
frmla = cel & "<" & .Item(i).Formula1
Case xlLessEqual
frmla = cel & "<=" & .Item(i).Formula1
Case xlGreater
frmla = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual
frmla = cel & ">=" & .Item(i).Formula1
End Select
boo = Application.Evaluate(frmla)
End If
If boo Then
On Error Resume Next
Select Case Left(LCase(FormatType), 1)
Case "f"
tmp = .Item(i).Font.ColorIndex
Case Else
tmp = .Item(i).Interior.ColorIndex
End Select
If Err = 0 Then ConditionalColor = tmp
Err.Clear
On Error GoTo 0
Exit For
End If
Next i
End With
End If
End Function
以下方法却不能获得
'Private Sub Worksheet_Change(ByVal Target As Range)
'If Target.Address = "$A$1" Then
'MsgBox Range("A1").Interior.ColorIndex
'End If
'End Sub