How can I use VBA to format Symbols / Icons into cells without using conditional formatting

问题

I am using VBA code to place conditional formatting to cover values in a large table, I use 2 formulae per cell to determine which of the 3 symbols to use. I need to check the value of each cell with a different cell depending on the column and therefore as far as I understamd, I have to place my conditional formatting rule on each cell individually to ensure the formula is correct in each. This is because conditional formatting cannot take relative addresses, you have to give it the exact address of each cell ... correct?

The large number of conditional formatting instances is slowing my computer to a huge extent.

Is it possible to place symbols used by conditional formatting, into a cell, without using conditional formatting?

Perhaps somewhat like an image, but whilst retaining the cell value underneath, as can be done using conditional formatting.

Below I have given the code I use to put the conditional formatting in place. Any help is very much appreciated!!

    Dim AIs As Range
    Dim rng As Range
    Dim cl As Range

    Set AIs = ActiveSheet.Range("Table")
    For Each cl In AIs.Columns
        For Each rng In cl.Cells

        rng.FormatConditions.AddIconSetCondition
        rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With rng.FormatConditions(1)
            .ReverseOrder = False
            .ShowIconOnly = True
            .IconSet = ActiveWorkbook.IconSets(xl3Symbols2)
        End With

         With rng.FormatConditions(1).IconCriteria(1)
            .Icon = xlIconYellowExclamationSymbol
        End With
        With rng.FormatConditions(1).IconCriteria(2)
            .Icon = xlIconRedCross

            .Type = xlConditionValueFormula
            .Value = "=IF(VALUE(LEFT(" & rng.Parent.Cells(5, rng.Column).Address & _
                  ";1)=0;1;6)"

            .Operator = 7
        End With
        With rng.FormatConditions(1).IconCriteria(3)
            .Icon = xlIconGreenCheck

            .Type = xlConditionValueFormula
            .Value = "=IF(VALUE(LEFT(" & rng.Address & ";1))<=VALUE(LEFT(" & _
                  rng.Parent.Cells(5, rng.Column).Address & ";1));1;6)"

            .Operator = 7
        End With
        Next rng
    Next cl

回答1:

Adding a shape directly to a cell:

Dim cLeft As Single
Dim cTop As Single

cLeft = rng.Left
cTop = rng.Top

with AIs.Shapes.AddShape(msoShapeOval, cLeft, cTop, 12, 12)
    .ForeColor.RGB = RGB(255, 0, 0)
    'Other properties can be found at
    'http://msdn.microsoft.com/en-us/library/office/bb251480%28v=office.12%29.aspx
end with

you may want to adjust cTop and cLeft, and the width/height to position the circle as you wish

回答2:

Final code:

     Set AIs = ActiveSheet.Range("Table")
     For Each cl In AIs.Columns
        For Each rng In cl.Cells

            'Shapes  - GRADE MASK


            cLeft = rng.Left + 5 - (rng.ColumnWidth / 2)
            cTop = rng.Top + (rng.RowHeight / 2 - 5)

            If Not rng = "" And rng.ColumnWidth = 3 And rng.RowHeight > 12 Then

            If rng.Parent.Cells(5, rng.Column) = 0 Then
                With wks.Shapes.AddShape(msoShapeOval, cLeft, cTop, 10, 10)
                    .Fill.ForeColor.RGB = RGB(255, 0, 0)
                End With
            End If
            If CInt(Left(rng, 1)) >= CInt(Left(rng.Parent.Cells(5, rng.Column), 1)) And _
             Not rng.Parent.Cells(5, rng.Column) = 0 Then
                With wks.Shapes.AddShape(msoShapeOval, cLeft, cTop, 10, 10)
                    .Fill.ForeColor.RGB = RGB(0, 255, 0)
                End With
            End If
            If CInt(Left(rng, 1)) < CInt(Left(rng.Parent.Cells(5, rng.Column), 1)) Then
                With wks.Shapes.AddShape(msoShapeOval, cLeft, cTop, 10, 10)
                    .Fill.ForeColor.RGB = RGB(255, 204, 0)
                End With
            End If
            End If
        Next rng
    Next cl

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
       userinterfaceonly:=True

Then every time I call a macro, I remove all the shapes on the worksheet, perform my macro and then call this again, in the if statements above there are checks to see how big the column width and row height are and a shape is only inserted if the cell is "visible"

In my program, for other reasons outside this subroutine I cannot hide my rows or columns but instead reduce their height or width to be just big enough to display the cell borders.

来源：https://stackoverflow.com/questions/18232480/how-can-i-use-vba-to-format-symbols-icons-into-cells-without-using-conditional

标签

excel

vba

symbols

conditional-formatting

performance