如何使用VBA将符号/图标格式化为单元格而不使用条件格式

我使用VBA代码来放置条件格式来覆盖大表中的值，我使用每个单元2个公式来确定要使用的3个符号中的哪一个。 我需要检查每个单元格的值与不同的单元格取决于列，因此，据我所知，我必须将我的条件格式规则分别在每个单元格，以确保公式是正确的每个。 这是因为条件格式不能使用相对地址，所以你必须给它每个单元格的确切地址…是正确的？

大量的条件格式化实例在很大程度上减慢了我的计算机。

是否可以将条件格式使用的符号放入单元格中而不使用条件格式？

也许有点像一个图像，但同时保留下面的单元格值，可以使用条件格式。

下面我给出了我用来把条件格式化的代码。 很感谢任何forms的帮助！！

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 

Answer 1

直接添加一个形状到一个单元格：

 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 

您可能需要调整cTop和cLeft，并根据需要调整宽度/高度来定位圆

Answer 2

最终代码：

  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 

然后每次我调用一个macros，我删除工作表上的所有形状，执行我的macros，然后再次调用这个if语句上面有检查，看看有多大的列宽度和行高度，只有一个形状插入如果单元格是“可见的”

在我的程序中，除了这个子程序之外的其他原因，我不能隐藏我的行或列，而是将它们的高度或宽度减小到足以显示单元格边界。