我正在尝试格式化图表中的x轴可勾选项。 x轴SeriesCollection数据是文本，并在电子表格中格式化为文本。当用户检查组合框时，读取x数据。然而，该图表将标签显示为数字。如何让图表将x轴刻度标签显示为链接到源的文本？
Sub CustomChartUpdate()
Application.ScreenUpdating = False
Dim x As Range, y1 As Range, y2 As Range
Dim points As Long
Dim xname As String, y1name As String, y2name As String
Dim countx As Integer, county As Long
Dim tempzoom As Single
countx = 0
county = 0
Set CustomChart = Sheets("Custom Chart")
Set EIRPSummary = Sheets("EIRP Summary")
'get last row of EIRP Summary
EIRPSummary.Select 'NOTE: the 'with-end with' statement does not work here
lastEIRPSummaryRow = EIRPSummary.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
'count the number of data points
points = lastEIRPSummaryRow - [ESDataRow1].Row + 1
With EIRPSummary
If .OLEObjects("ESCaseNumBoxx").Object.Value = True Then
countx = countx + 1
Set x = .Range(.Cells([ESDataRow1].Row, [ESCaseNum].Column), .Cells(lastEIRPSummaryRow, [ESCaseNum].Column))
xname = "Case"
End If
If .OLEObjects("ESCaseDescripBoxx").Object.Value = True Then
countx = countx + 1
Set x = .Range(.Cells([ESDataRow1].Row, [ESCaseDescrip].Column), .Cells(lastEIRPSummaryRow, [ESCaseDescrip].Column))
xname = "Case Description"
End If
If .OLEObjects("Tx_AntBoxx").Object.Value = True Then
countx = countx + 1
Set x = .Range(.Cells([ESDataRow1].Row, [Tx_Ant].Column), .Cells(lastEIRPSummaryRow, [Tx_Ant].Column))
xname = "Tx Antenna"
End If
If countx > 1 Then
MsgBox "Check only one box for x and try again"
GoTo TheEnd
End If
End With
y1name = "nada"
y2name = "ditto"
With EIRPSummary
county = 0
If .OLEObjects("ESCaseNumBoxy").Object.Value = True Then
county = county + 1
If y1name = "nada" Then
Set y1 = .Range(.Cells([ESDataRow1].Row, [ESCaseNum].Column), .Cells(lastEIRPSummaryRow, [ESCaseNum].Column))
y1name = "Case"
ElseIf y2name = "ditto" Then
Set y2 = .Range(.Cells([ESDataRow1].Row, [ESCaseNum].Column), .Cells(lastEIRPSummaryRow, [ESCaseNum].Column))
y2name = "Case"
End If
End If
If .OLEObjects("ESCaseDescripBoxy").Object.Value = True Then
county = county + 1
If y1name = "nada" Then
Set y1 = .Range(.Cells([ESDataRow1].Row, [ESCaseDescrip].Column), .Cells(lastEIRPSummaryRow, [ESCaseDescrip].Column))
y1name = "Case Description"
ElseIf y2name = "ditto" Then
Set y2 = .Range(.Cells([ESDataRow1].Row, [ESCaseDescrip].Column), .Cells(lastEIRPSummaryRow, [ESCaseDescrip].Column))
y2name = "Case Description"
End If
End If
If .OLEObjects("Tx_AntBoxy").Object.Value = True Then
county = county + 1
If y1name = "nada" Then
Set y1 = .Range(.Cells([ESDataRow1].Row, [Tx_Ant].Column), .Cells(lastEIRPSummaryRow, [Tx_Ant].Column))
y1name = "Tx Antenna"
ElseIf y2name = "ditto" Then
Set y2 = .Range(.Cells([ESDataRow1].Row, [Tx_Ant].Column), .Cells(lastEIRPSummaryRow, [Tx_Ant].Column))
y2name = "Tx Antenna"
End If
End If
If county > 2 Then
MsgBox "Check a maximum of 2 boxes for y and try again"
GoTo TheEnd
End If
End With
'clear old data series
With CustomChart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
CustomChart.Activate
'read in x and y data
With ActiveChart.SeriesCollection.NewSeries
.XValues = x
End With
With CustomChart
.SeriesCollection.Add Source:=y1
.SeriesCollection.Add Source:=y2
End With
'format series 2 (y1)
With CustomChart.SeriesCollection(1)
.name = y1name
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = 1
.MarkerStyle = 3
.MarkerSize = 4
.Format.Fill.Visible = msoTrue
.Format.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Format.Line.Visible = msoFalse
.AxisGroup = 1
End With
'format series 3 (y2)
With CustomChart.SeriesCollection(2)
.name = y2name
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = 10
.MarkerStyle = 8
.MarkerSize = 4
.Format.Fill.Visible = msoTrue
.Format.Fill.ForeColor.RGB = RGB(0, 176, 80)
.Format.Line.Visible = msoFalse
.AxisGroup = 2
End With
With ActiveChart
'format title
.HasTitle = True
.SetElement (msoElementChartTitleAboveChart)
With .ChartTitle
.Text = y1name & " & " & y2name & " vs " & xname
.Font.name = "Arial"
.Font.Size = 10
.Format.TextFrame2.TextRange.Font.Bold = msoFalse
.Left = 40
End With
'format x-axis
.HasAxis(xlCategory) = True
With .Axes(xlCategory)
.HasTitle = True
.MajorTickMark = xlNone
.HasMajorGridlines = True
.AxisBetweenCategories = False
'Ticklabels font size and orientation below
With .AxisTitle.Characters
.Text = xname
.Font.name = "Calibri"
.Font.Bold = False
End With
With .Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
.Transparency = 0
End With
With .MajorGridlines.Format.Line
.Visible = msoTrue
.DashStyle = msoLineDash
.ForeColor.RGB = RGB(79, 129, 189)
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With .TickLabels
.NumberFormat = "@"
.NumberFormatLinked = -1
.Font.name = "Calibri"
If points <= 35 Then
.Font.Size = 10
.Orientation = 0
ElseIf points <= 50 Then
.Font.Size = 9
.Orientation = 0
ElseIf points <= 60 Then
.Font.Size = 7
.Orientation = 0
ElseIf points <= 75 Then
.Font.Size = 6
.Orientation = 90
ElseIf points <= 100 Then
.Font.Size = 6
.Orientation = 90
ElseIf points <= 200 Then
.Font.Size = 6
.Orientation = 90
ElseIf points <= 300 Then
.Font.Size = 6
.Orientation = 90
End If
End With
End With
'format primary y-axis
With .Axes(xlValue)
.HasTitle = True
.AxisTitle.Characters.Text = y1name
.AxisTitle.Characters.Font.Bold = False
.AxisTitle.Orientation = xlUpward
.TickLabels.Font.name = "Calibri"
.TickLabels.Font.Size = 9
.TickLabels.NumberFormat = "0.0"
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MajorUnitIsAuto = True
.MinorUnitIsAuto = True
.MajorTickMark = xlOutside
With .MajorGridlines.Format.Line
.Visible = msoTrue
.DashStyle = msoLineDash
.ForeColor.RGB = RGB(79, 129, 189)
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With .Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
.Transparency = 0
End With
End With
'format secondary y-axis
With .Axes(xlValue, xlSecondary)
.HasTitle = True
.AxisTitle.Characters.Text = y2name
.AxisTitle.Characters.Font.Bold = False
.AxisTitle.Orientation = xlDownward
.TickLabels.Font.name = "Calibri"
.TickLabels.Font.Size = 9
.TickLabels.NumberFormat = "0.0"
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MajorUnitIsAuto = True
.MinorUnitIsAuto = True
.MajorTickMark = xlOutside
With .MajorGridlines.Format.Line
.Visible = msoTrue
.DashStyle = msoLineDash
.ForeColor.RGB = RGB(79, 129, 189)
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With .Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.5
.Transparency = 0
End With
End With
'format legend
.HasLegend = True
With .Legend
.Font.name = "Arial"
.Font.Size = 8
.Position = xlLegendPositionBottom
.Left = 30
.Top = 30
.Width = 400
.IncludeInLayout = False
End With
'set plot area size and position
With .PlotArea
.Height = 430
.Width = 625
.Top = 40
.Left = 25
End With
.ChartArea.Select
End With
tempzoom = ActiveWindow.Zoom
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = tempzoom
TheEnd:
End Sub
答案 0 :(得分：2)
编辑：您错误地添加了系列。
见下文
Sub Tester()
Dim cht As Chart
Dim xVals As Range, yVals As Range, yVals2 As Range
With ActiveSheet
Set cht = .ChartObjects(1).Chart
Set xVals = .Range("A1:A8")
Set yVals = .Range("B1:B8")
Set yVals2 = .Range("C1:C8")
End With
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
'doesn't work!
With cht.SeriesCollection.NewSeries
.XValues = xVals
End With
With cht
.SeriesCollection.Add Source:=yVals
.SeriesCollection.Add Source:=yVals2
End With
'works....
With cht.SeriesCollection.NewSeries
.XValues = xVals
.Values = yVals
End With
With cht.SeriesCollection.NewSeries
.XValues = xVals
.Values = yVals2
End With
End Sub