魔龙骑士玩具枪:关于条件格式下的vba获取单元格的背景色

来源:百度文库 编辑:中财网 时间:2024/04/29 06:12:00
关于条件格式下的vba获取单元格的背景色


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