请尝试下一段代码。它将创建矩形，为它们着色，分组，导出组图片并将其添加为绘图仪区域用户图片。没时间评论代码。如果不清楚，我会在几个小时内发表评论，当我在家时：
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 轴上要更改向下颜色的位置。如果这方面清楚，可以在第二个矩形列上放置一些较小的矩形。