Question

请善待，因为我是这个论坛的新手，但我需要你的帮助..

我正在尝试创建一个散点图，其中每个系列连接两个点 - 这我工作得很好。我的问题是，当我添加系列时，我想在相应的单元格中为每个点添加一个标签。

或者在单独的阶段添加标签会更容易吗？

谢谢你，任何帮助都会很受欢迎

Sub add_DEP_asking_OK() 

'On Error Resume Next
Application.ScreenUpdating = False

'Define Chart elements
Dim objChrt As ChartObject
Set objChrt = Sheets("REPORT").ChartObjects("Chart 5")
Dim x As Integer
Dim y As Long
Dim RAP As Worksheet ' Report sheet
Set RAP = Sheets("REPORT")

' Define Source Data
Dim PREP As Worksheet ' Source sheet
Dim nRows As Long
Set PREP = Sheets("PreparedData")
nRows = PREP.Range("B:B").Find(what:="*", LookIn:=xlValues, 
searchdirection:=xlPrevious).Row


' union
Dim AUnion As Excel.Range
Dim BUnion As Excel.Range
Dim CUnion As Excel.Range
Dim s1, s2, s3, s4 As Range
Dim S5 As Range
Dim S6 As Range



For x = 5 To nRows
y = RAP.ChartObjects("Chart 5").Chart.SeriesCollection.Count + 1

If Left(PREP.Cells(x, 12).Value, 5) = ("AskOK") Then


Set s1 = PREP.Cells(x, 4) ' dates for point a
Set s2 = PREP.Cells(x, 9) ' dates for point b
Set s3 = PREP.Cells(x, 5) ' y-location for point a
Set s4 = PREP.Cells(x, 10) ' y-location for point b
Set S5 = PREP.Cells(x, 3) ' label for point a
Set S6 = PREP.Cells(x, 8) ' label for point b
Set AUnion = Application.Union(s1, s2)
Set BUnion = Application.Union(s3, s4)
Set CUnion = Application.Union(S5, S6)


' create chart series
 With objChrt.Chart
.SeriesCollection.NewSeries
.SeriesCollection(y).Name = PREP.Cells(x, 12)
.SeriesCollection(y).XValues = AUnion
.SeriesCollection(y).Values = BUnion
.SeriesCollection(y).Border.Color = RGB(0, 255, 0)
.SeriesCollection(y).MarkerBackgroundColor = RGB(0, 255, 0)
.SeriesCollection(y).MarkerForegroundColor = RGB(0, 255, 0)

'labels
.SeriesCollection(y).HasDataLabels = True
  .SeriesCollection(y).DataLabels.ShowValue = False

'this don't work
.SeriesCollection(y).DataLabels.Format.TextFrame2.TextRange.InsertChartField msoChartFieldRange, "=" & CUnion, 0

.SeriesCollection(y).DataLabels.ShowRange = True


End With
End If
Next x

End Sub

Answer 1

我找到了答案： - ）

我使用这些点为每个点单独添加标签。

我已经发布了以下解决方案，希望有人可以使用它。

此致基督教

Sub add_DEP_Supplying_OK()

On Error Resume Next
Application.ScreenUpdating = False

'Define Chart elements
Dim objChrt As ChartObject
Set objChrt = Sheets("REPORT").ChartObjects("Chart 5")
Dim x As Integer
Dim y As Long
Dim RAP As Worksheet ' Report sheet
Set RAP = Sheets("REPORT")

' Define Source Data
Dim PREP As Worksheet ' Source sheet
Dim nRows As Long
Set PREP = Sheets("SupplyingToThisProject")
nRows = PREP.Range("L:L").Find(what:="S", LookIn:=xlValues, 
searchdirection:=xlPrevious).Row


' union
Dim AUnion As Excel.Range
Dim BUnion As Excel.Range
Dim s1, s2, s3, s4 As Range
For x = 5 To nRows
y = RAP.ChartObjects("Chart 5").Chart.SeriesCollection.Count + 1

If Left(PREP.Cells(x, 12).Value, 5) = ("SUPok") Then


Set s1 = PREP.Cells(x, 4) ' dates for point a
Set s2 = PREP.Cells(x, 9) ' dates for point b
Set s3 = PREP.Cells(x, 5) ' y-location for point a
Set s4 = PREP.Cells(x, 10) ' y-location for point b

Set AUnion = Application.Union(s1, s2)
Set BUnion = Application.Union(s3, s4)



' create chart series
With objChrt.Chart
.SeriesCollection.NewSeries
.SeriesCollection(y).Name = PREP.Cells(x, 12)
.SeriesCollection(y).XValues = AUnion
.SeriesCollection(y).Values = BUnion
.SeriesCollection(y).Border.Color = RGB(0, 255, 0)
.SeriesCollection(y).MarkerBackgroundColor = RGB(0, 255, 0)
.SeriesCollection(y).MarkerForegroundColor = RGB(0, 255, 0)

'labels
.SeriesCollection(y).HasDataLabels = True

.SeriesCollection(y).Points(1).DataLabel.ShowValue = True
.SeriesCollection(y).Points(1).DataLabel.ShowRange = True
.SeriesCollection(y).Points(1).DataLabel.Text = "=" & PREP.Cells(x, 3).Address(External:=True) ' Point a

.SeriesCollection(y).Points(2).DataLabel.ShowValue = True
.SeriesCollection(y).Points(2).DataLabel.ShowRange = True
.SeriesCollection(y).Points(2).DataLabel.Text = "=" & PREP.Cells(x, 8).Address(External:=True) ' Point B

.SeriesCollection(y).DataLabels.Format.TextFrame2.TextRange.Font.Fill.Visible = msoTrue
.SeriesCollection(y).DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1

End With

End If
Next x

Application.ScreenUpdating = True
End Sub

连接散点图，为点添加标签

1 个答案: