VBA/Excel/Access/Word/Excel/FormatConditions

Материал из VB Эксперт
Перейти к: навигация, поиск

Add Crazy Icons

 
Sub AddCrazyIcons()
    With Range("A1:C10")
        .Select " The .Formula lines below require .Select here
        .FormatConditions.Delete
        " First icon set
        .FormatConditions.AddIconSetCondition
        .FormatConditions(1).IconSet = ActiveWorkbook.IconSets(xl3Flags)
        .FormatConditions(1).Formula = "=IF(A1<5,TRUE,FALSE)"
        " Next icon set
        .FormatConditions.AddIconSetCondition
        .FormatConditions(2).IconSet = ActiveWorkbook.IconSets(xl3ArrowsGray)
        .FormatConditions(2).Formula = "=IF(A1<12,TRUE,FALSE)"
        " Next icon set
        .FormatConditions.AddIconSetCondition
        .FormatConditions(3).IconSet = ActiveWorkbook.IconSets(xl3Symbols2)
        .FormatConditions(3).Formula = "=IF(A1<22,TRUE,FALSE)"
        " Next icon set
        .FormatConditions.AddIconSetCondition
        .FormatConditions(4).IconSet = ActiveWorkbook.IconSets(xl4CRV)
        .FormatConditions(4).Formula = "=IF(A1<27,TRUE,FALSE)"
        " Next icon set
        .FormatConditions.AddIconSetCondition
        .FormatConditions(5).IconSet = ActiveWorkbook.IconSets(xl5CRV)
    End With
End Sub



all the ranges that have conditional formatting set up

 
Sub all()
    Set rngCond = ActiveSheet.cells.SpecialCells(xlCellTypeAllFormatConditions)
    If Not rngCond Is Nothing Then
        rngCond.BorderAround xlContinuous
    End If
End Sub



creates the formatting shown in column A

 
Sub HighlightFirstUnique()
    With Range("A1:A15")
        .Select
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(A$1:A1,A1)=1"
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Formatting Cells in the Bottom 5

 
Sub FormatBottom5Items()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.AddTop10
        .FormatConditions(1).TopBottom = xlTop10Bottom
        .FormatConditions(1).Value = 5
        .FormatConditions(1).Percent = False
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Formatting Cells in the Top 10

 
Sub FormatTop10Items()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.AddTop10
        .FormatConditions(1).TopBottom = xlTop10Top
        .FormatConditions(1).Value = 10
        .FormatConditions(1).Percent = False
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Formatting Cells in the Top 2 percent

 
Sub FormatTop12Percent()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.AddTop10
        .FormatConditions(1).TopBottom = xlTop10Top
        .FormatConditions(1).Value = 12
        .FormatConditions(1).Percent = True
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Formatting Cells whose value between 10 and 20

 
Sub FormatBetween10And20()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
            Formula1:="=10", Formula2:="=20"
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub
"Format cells whose value less than 15
Sub FormatLessThan15()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
            Formula1:="=15"
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Formatting Duplicate Cells

 
Sub FormatDuplicate()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlDuplicate
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Formatting Unique Cells

 
Sub FormatUnique()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlUnique
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



generates a three-color color scale in range A1:A10:

 
Sub Add3ColorScale()
    With Range("A1:A10")
        .FormatConditions.Delete
        " Add the Color Scale as a 3-color scale
        .FormatConditions.AddColorScale ColorScaleType:=3
        " Format the first color as light red
        .FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValuePercent
        .FormatConditions(1).ColorScaleCriteria(1).Value = 3
        .FormatConditions(1).ColorScaleCriteria(1).FormatColor.Color = RGB(255, 0, 0)
        .FormatConditions(1).ColorScaleCriteria(1).FormatColor.TintAndShade = 0.25
        " Format the second color as green at 50%
        .FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercent
        .FormatConditions(1).ColorScaleCriteria(2).Value = 5
        .FormatConditions(1).ColorScaleCriteria(2).FormatColor.Color = RGB(0, 255, 0)
        .FormatConditions(1).ColorScaleCriteria(2).FormatColor.TintAndShade = 0
        " Format the third color as dark blue
        .FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValuePercent
        .FormatConditions(1).ColorScaleCriteria(3).Value = 8
        .FormatConditions(1).ColorScaleCriteria(3).FormatColor.Color = RGB(0, 0, 255)
        .FormatConditions(1).ColorScaleCriteria(3).FormatColor.TintAndShade = -0.25
    End With
End Sub



highlight cells above average:

 
Sub FormatAboveAverage()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.AddAboveAverage
        .FormatConditions(1).AboveBelow = xlAboveAverage
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



highlight cells below average:

 
Sub FormatBelowAverage()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.AddAboveAverage
        .FormatConditions(1).AboveBelow = xlBelowAverage
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



highlights all cells that contain a capital letter A

 
Sub FormatContainsA()
    With Selection
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlTextString, String:="A", _
            TextOperator:=xlContains
        " other choices: xlBeginsWith, xlDoesNotContain, xlEndsWith
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



highlights all dates in the past week:

 
Sub FormatDatesLastWeek()
    With Selection
        .FormatConditions.Delete
        " DateOperator choices include xlYesterday, xlToday, xlTomorrow,
        " xlLastWeek, xlThisWeek, xlNextWeek, xlLast7Days
        " xlLastMonth, xlThisMonth, xlNextMonth,
        .FormatConditions.Add Type:=xlTimePeriod, DateOperator:=xlLastWeek
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Highlight the Entire Row for the Largest Sales Value

 
Sub HighlightWholeRow()
    With Range("D2:F15")
        .Select
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression,Formula1:="=$F2=MAX($F$2:$F$15)"
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
End Sub



Identifying Row with Largest Value in G

 
Sub FindMinMax()
    FinalRow = cells(Application.Rows.count, 1).End(xlUp).row
    With range("A2:I" & FinalRow)
        .FormatConditions.delete
        .FormatConditions.add Type:=xlExpression, Formula1:="=RC7=MAX(C7)"
        .FormatConditions(1).Interior.ColorIndex = 4
        .FormatConditions.add Type:=xlExpression, Formula1:="=RC7=MIN(C7)"
        .FormatConditions(2).Interior.ColorIndex = 6
    End With
End Sub



Setting Up Conditional Formats in VBA

 
Sub ApplySpecialFormattingAll()
    For Each ws In ThisWorkbook.Worksheets
        ws.UsedRange.FormatConditions.Delete
        For Each cell In ws.UsedRange.Cells
            If Not IsEmpty(cell) Then
                cell.FormatConditions.Add Type:=xlExpression, _
                    Formula1:="=or(ISERR(RC),isna(RC))"
                cell.FormatConditions(1).Font.Color = cell.Interior.Color
                cell.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
                    Formula1:="0"
                cell.FormatConditions(2).Font.ColorIndex = 3
            End If
        Next cell
    Next ws
End Sub



Specifying an Icon Set

 
Sub Main()
    With Range("A1:C10")
        .FormatConditions.Delete
        .FormatConditions.AddIconSetCondition
        " Global settings for the icon set
         With .FormatConditions(1)
            .ReverseOrder = False
            .ShowIconOnly = False
            .IconSet = ActiveWorkbook.IconSets(xl5CRV)
        End With
    End With
End Sub



Specifying Ranges for Each Icon

 
Sub Main()
    With Range("A1:C10")
            With .FormatConditions(1).IconCriteria(2)
                .Type = xlConditionValuePercent
                .Value = 50
                .Operator = xlGreaterEqual
            End With
            With .FormatConditions(1).IconCriteria(3)
                .Type = xlConditionValuePercent
                .Value = 60
                .Operator = xlGreaterEqual
            End With
            With .FormatConditions(1).IconCriteria(4)
                .Type = xlConditionValuePercent
                .Value = 80
                .Operator = xlGreaterEqual
            End With
            With .FormatConditions(1).IconCriteria(5)
                .Type = xlConditionValuePercent
                .Value = 90
                .Operator = xlGreaterEqual
            End With
        End With
End Sub



Using the New NumberFormat Property

 
Sub NumberFormat()
    With Range("E1:G26")
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater,Formula1:="=9999999"
        .FormatConditions(1).NumberFormat = "$#,##0,""M"""
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=999999"
        .FormatConditions(2).NumberFormat = "$#,##0.0,""M"""
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater,Formula1:="=999"
        .FormatConditions(3).NumberFormat = "$#,##0,K"
    End With
End Sub



Using Two Colors of Data Bars in a Range

 
Sub AddTwoDataBars()
    With Range("A1:D10")
        .Select " The .Formula below requires .Select here
        .FormatConditions.Delete
        .FormatConditions.AddDataBar
        .FormatConditions(1).BarColor.Color = RGB(0, 255, 0)
        .FormatConditions(1).BarColor.TintAndShade = 0.25
        .FormatConditions.AddDataBar
        .FormatConditions(2).BarColor.Color = RGB(255, 0, 0)
        .FormatConditions(1).Formula = "=IF(A1>9,True,False)"
    End With
End Sub