excel - Excel散点图背景颜色可以根据数据值自定义吗？

Question

我有一个 5 行 x 2 列的表格。有 5 个数据点，每个数据点都有相应的 X 和 Y 值。 X、Y 值用于绘制散点图。

我想自定义散点图的背景作为数据点本身的函数，即彩色矩形的 X 和 Y 范围应在我的控制。理想情况下，我希望数据中的 X 和 Y 中值分别构成 X 和 Y“轴”，它们是不同颜色矩形的边界。

目前，我在格式化图表区域时选择了“形状填充”->“图片”选项。该图片目前是在 MS Powerpoint 中手动创建的，其宽高比与图表区域相同。

VBA 代码示例。它从“Sheet1”中 A2:B6 范围内的 5x2 表中获取数据。

Sub scatter_plot_simple()
    Dim Chart1 As Chart
    Set Chart1 = Charts.Add
    With Chart1
        .ChartType = xlXYScatter
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "=""Values"""
        .SeriesCollection(1).XValues = "=Sheet1!$B$2:$B$6"
        .SeriesCollection(1).Values = "=Sheet1!C$2:$C$6"
    End With
End Sub

Answer 1

请尝试下一段代码。它将创建矩形、为其着色、分组、导出组图片并将其添加为绘图仪区域用户图片。没时间评论代码。如果不清楚，我会在几个小时后(当我在家时)发表评论:

Sub scatter_plot_simple()
    Dim sC As Chart, sh As Worksheet, Chart1 As Chart, sGr As Shape, s As Shape, s1 As Shape, s2 As Shape
    Dim pltH As Double, pltW As Double, pltAH As Double, pltAW As Double, i As Long, j As Long, k As Long
    Dim maxX As Long, maxY As Long, majUnitY As Long, topS As Double, leftS As Double
    
    majUnitY = 20 'major unity for X axes
    'delete the previous chart (used for testing)
    For Each sC In Charts
        Application.DisplayAlerts = False
            If sC.Name = "MyChart" Then sC.Delete: Exit For
        Application.DisplayAlerts = True
    Next
    Set sh = Sheets("Sheet1")
    Set Chart1 = Charts.Add
    With Chart1
        .Name = "MyChart"
        .ChartType = xlXYScatter
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "=""Values"""
        .SeriesCollection(1).XValues = "=" & sh.Name & "!B2:B6"
        .SeriesCollection(1).Values = "=" & sh.Name & "!C2:C6"
        .Axes(xlCategory).MajorUnit = majUnitY
        maxX = .Axes(xlCategory).MaximumScale             'maximum scale of X axes
        pltAH = .PlotArea.height: pltAW = .PlotArea.width 'plot area height
        maxY = .Axes(xlValue).MaximumScale                'maximum scale of X axes
        'extract dimensions of the future rectangles to be created:
        pltH = .PlotArea.height / maxY: pltW = .PlotArea.width / (maxX / majUnitY)
    End With
    'create the rectangle equal to chart Plot area:
    Set s = sh.Shapes.AddShape(msoShapeRectangle, 0, 0, pltAW, pltAH)
    s.Fill.ForeColor.RGB = RGB(255, 255, 255) 'white color
    topS = 0: leftS = 0
    Dim maxGreen As Long  ' variable to be used to change the rectangle colors
    maxGreen = 2
    'create the necessary colored rectangles to reflect the maximum X and maximum Y
    For j = 1 To maxX / majUnitY
        For i = 1 To 6
            Set s1 = sh.Shapes.AddShape(msoShapeRectangle, leftS, topS, pltW, pltH)
            With s1
                .Select
                'color rectangles according to their position:
                .Fill.ForeColor.RGB = IIf(6 - i >= maxGreen, IIf(j = 1, RGB(201, 163, 102), RGB(138, 197, 139)), IIf(j = 1, RGB(231, 157, 126), RGB(145, 208, 215)))
                .line.Weight = 2
                .line.ForeColor.RGB = RGB(255, 255, 255)
            End With
            If i = 1 And j = 1 Then  'group the big rectangle (plot area dimensions) with the first rectangle
                Set sGr = sh.Shapes.Range(Array(s.Name, s1.Name)).Group
            Else
                'group the previous group with the created rectangle
                Set sGr = sh.Shapes.Range(Array(sGr.Name, s1.Name)).Group
            End If
            topS = topS + pltH  'increment Top position for the future rectangle
        Next i
        'adding the rectangles slices over the existing rectangles in second column:
        If j = 2 Then
            topS = 0
            For k = 1 To 6
                Set s2 = sh.Shapes.AddShape(msoShapeRectangle, leftS + 2, topS + 2, pltW / 3, pltH - 4)
                With s2
                    .Select
                    If 6 - k >= maxGreen Then
                        .Fill.ForeColor.RGB = RGB(201, 163, 102)
                        .line.ForeColor.RGB = RGB(201, 163, 102)
                    Else
                        .Fill.ForeColor.RGB = RGB(231, 157, 126)
                        .line.ForeColor.RGB = RGB(231, 157, 126)
                    End If
                End With
                Set sGr = sh.Shapes.Range(Array(sGr.Name, s2.Name)).Group
                topS = topS + pltH
            Next k
            
        End If
        leftS = leftS + pltW: topS = 0 'increment the left possition and reset the Top poz to zero
    Next j
    'Part of exporting the created group as picture:
    Dim pictPath As String
    pictPath = ThisWorkbook.path & "\chartPict.jpg" 'the path where to be saved
    ExportShPict sGr, sh, pictPath                          'export function
    Chart1.PlotArea.Format.Fill.UserPicture pictPath   'place the exported picture to the chart plot area
    sGr.Delete                                                   'delete the helper group
    Chart1.Activate                                            'activate the chart sheet
    MsgBox "Ready..."
End Sub

Private Sub ExportShPict(s As Shape, sh As Worksheet, pictPath As String)
   Dim ch As ChartObject
   'create a new chart using the shape (group) dimensions
   Set ch = sh.ChartObjects.Add(left:=1, top:=1, width:=100, height:=100)
   ch.width = s.width: ch.height = s.height
   'copy the group picture on the newly created chart
   s.CopyPicture: ch.Activate: ActiveChart.Paste
   'export the chart which practically means only the picture
   ch.Chart.Export FileName:=pictPath, FilterName:="JPG"
   ch.Delete 'delete the helper chart
End Sub

我推导出了改变垂直轴颜色的逻辑，但是你没有说任何关于X轴上要改变向下颜色的位置。如果这方面清楚的话，可以在第二个矩形列上放置一些较小的矩形。