Question

我已经创建了温度计图表，这些温度计图表根据我的工作表中的单元格（红色 - 差，黄色 - 平均，绿色 - 良好）进行着色。也就是说，图表引用单元格的颜色来确定填充颜色。但是，当以黑白打印时，红色和绿色难以区分。我不想放弃红绿灯着色，因为它对我的观众来说很直观。

我试图弄清楚如何获取图表填充以反映细胞中的图案以及颜色。我目前的语法（用于颜色填充）如下。

Sub ColorByValueSMICAUpdate()
  Dim rPatterns As Range
  Dim iPattern As Long
  Dim vPatterns As Variant
  Dim iPoint As Long
  Dim vValues As Variant
  Dim rValue As Range

  Set rPatterns = ActiveSheet.Range("P5:P11")
  vPatterns = rPatterns.Value
  With ActiveChart.SeriesCollection(1)
    vValues = .Values
    For iPoint = 1 To UBound(vValues)
      For iPattern = 1 To UBound(vPatterns)
        If vValues(iPoint) <= vPatterns(iPattern, 1) Then
          .Points(iPoint).Format.Fill.ForeColor.RGB = _
              rPatterns.Cells(iPattern, 1).Interior.Color
          Exit For
        End If
      Next
    Next
  End With
End Sub

谢谢！

Answer 1

此问题的关键是单元格上的填充是interior.pattern对象，图表上的填充是format.fill.patterned对象。唯一的方法是将模式转换为David Zemens上面描述的图案。

下面的代码可以使用，但您可能想要使用哪种模式转换为哪种模式。

已经过测试

Sub ColorByValueSMICAUpdate()
  Dim rPatterns As Range
  Dim iPattern As Long
  Dim vPatterns As Variant
  Dim iPoint As Long
  Dim vValues As Variant
  Dim rValue As Range

  Set rPatterns = ActiveSheet.Range("P5:P11")
  vPatterns = rPatterns.Value
  With ActiveChart.SeriesCollection(1)
    vValues = .Values
    For iPoint = 1 To UBound(vValues)
      For iPattern = 1 To UBound(vPatterns)
        If vValues(iPoint) <= vPatterns(iPattern, 1) Then
          .Points(iPoint).Format.Fill.ForeColor.RGB = _
              rPatterns.Cells(iPattern, 1).Interior.Color
          .Points(iPoint).Format.Fill.Patterned _
              ConvertPatternToPattened(rPatterns.Cells(iPattern, 1).Interior.pattern)
          Exit For
        End If
      Next
    Next
  End With
End Sub

Private Function ConvertPatternToPattened(pattern As Integer) As Integer

' To change the converted patterns please refer to the two references below
'
' Patterned List - http://msdn.microsoft.com/en-us/library/office/aa195819(v=office.11).aspx
' Pattern List - http://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.interior.pattern(v=office.15).aspx


Dim Result As Integer

Result = msoPattern90Percent

Select Case pattern
    Case xlPatternChecker
        Result = msoPatternLargeCheckerBoard
    Case xlPatternCrissCross
        Result = msoPattern90Percent
    Case xlPatternDown
        Result = msoPatternNarrowVertical
    Case xlPatternGray16
        Result = msoPattern20Percent
    Case xlPatternGray25
        Result = msoPattern25Percent
    Case xlPatternGray50
        Result = msoPattern50Percent
    Case xlPatternGray75
        Result = msoPattern75Percent
    Case xlPatternGray8
        Result = msoPattern10Percent
    Case xlPatternGrid
        Result = msoPatternSmallGrid
    Case xlPatternHorizontal
        Result = msoPatternLightHorizontal
    Case xlPatternLightDown
        Result = msoPatternLightVertical
    Case xlPatternLightHorizontal
        Result = msoPatternNarrowHorizontal
    Case xlPatternLightUp
        Result = msoPatternLightVertical
    Case xlPatternLightVertical
        Result = msoPattern90Percent
    Case xlPatternSemiGray75
        Result = msoPattern80Percent
    Case xlPatternSolid
        Result = msoPattern90Percent
    Case xlPatternUp
        Result = msoPatternDarkVertical
    Case xlPatternVertical
        Result = msoPatternDashedVertical
    Case Else
        Result = msoPattern90Percent
End Select

ConvertPatternToPattened = Result

End Function

如何使图表填充参考单元格颜色和图案？

1 个答案: