VBA/Excel/Access/Word/Excel/FormatConditions

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

Add Crazy Icons

   <source lang="vb">

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 

</source>


all the ranges that have conditional formatting set up

   <source lang="vb">

Sub all() 

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

End Sub 

</source>


creates the formatting shown in column A

   <source lang="vb">

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 

</source>


Formatting Cells in the Bottom 5

   <source lang="vb">

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 

</source>


Formatting Cells in the Top 10

   <source lang="vb">

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 

</source>


Formatting Cells in the Top 2 percent

   <source lang="vb">

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 

</source>


Formatting Cells whose value between 10 and 20

   <source lang="vb">

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 

</source>


Formatting Duplicate Cells

   <source lang="vb">

Sub FormatDuplicate() 

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

End Sub 

</source>


Formatting Unique Cells

   <source lang="vb">

Sub FormatUnique() 

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

End Sub 

</source>


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

   <source lang="vb">

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 

</source>


highlight cells above average:

   <source lang="vb">

Sub FormatAboveAverage() 

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

End Sub 

</source>


highlight cells below average:

   <source lang="vb">

Sub FormatBelowAverage() 

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

End Sub 

</source>


highlights all cells that contain a capital letter A

   <source lang="vb">

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 

</source>


highlights all dates in the past week:

   <source lang="vb">

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 

</source>


Highlight the Entire Row for the Largest Sales Value

   <source lang="vb">

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 

</source>


Identifying Row with Largest Value in G

   <source lang="vb">

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 

</source>


Setting Up Conditional Formats in VBA

   <source lang="vb">

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 

</source>


Specifying an Icon Set

   <source lang="vb">

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 

</source>


Specifying Ranges for Each Icon

   <source lang="vb">

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 

</source>


Using the New NumberFormat Property

   <source lang="vb">

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 

</source>


Using Two Colors of Data Bars in a Range

   <source lang="vb">

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 

</source>
Источник — «http://vbex.ru/index.php?title=VBA/Excel/Access/Word/Excel/FormatConditions&oldid=1649»