图表对象格式错误

时间:2015-09-27 02:59:39

标签: excel-vba charts vba excel

我无法弄清楚如何正确格式化日期(Xaxis),否则,下面的代码可行。 MyArY()包含日期,但由于某种原因,日期显示在图表9/1/00上的00年?我已经尝试过我在网上找到的例子,但它们对我不起作用 以下是工作表上的日期: 7/21/15 8:00:00 AM 8/25/15 9/1/15 12:00:00 AM 9/10/15 7/21/15 8/25/15 图表无法识别日期,它们看起来像这样: enter image description here

感谢您的帮助。

Sub Build_Chart()
'builds a chart on active sheet

Set objChart = ActiveSheet.ChartObjects.Add _
(Left:=30, Width:=775, Top:=15, Height:=345)
objChart.Chart.ChartType = xlXYScatterLines

End Sub

Sub Add_ChartSeries()

Dim i As Long, l As Long
Dim yAddress_ListItem As String, yAddress_ValuesRange As String
Dim xAddress_ValuesRange As String, xAddress_ListItem As String
Dim cht As Chart
Dim rng As Range, aCell As Range
Dim MyArY() As Variant, MyArX() As Variant
Dim LastRow As Long, iVal As Long
'Dim chSeries As Series

Dim objChartSeriesColl As SeriesCollection

With ActiveSheet '
LastRow = .Cells(.Rows.count, "B").End(xlUp).Row
Set rng = .Range("B27:B" & LastRow) 'non-contiguous range
End With

Set objChartSeriesColl = objChart.Chart.SeriesCollection


If frmGeneList.lstMain.ListIndex <> -1 Then 'if listbox is NOT empty
For l = 0 To frmGeneList.lstMain.ListCount - 1
If frmGeneList.lstMain.Selected(l) Then 'identify selected items
' count of cells in that range meeting criteria
iVal = Application.WorksheetFunction.CountIf(rng, frmGeneList.lstMain.List(l))

' Resize arrays to hold filtered data
ReDim MyArY(1 To iVal)
ReDim MyArX(1 To iVal)

iVal = 1

' Store filtered values from that range into array
For Each aCell In rng.Cells
If aCell.Value = frmGeneList.lstMain.List(l) Then
MyArY(iVal) = aCell.Offset(0, 1).Value'dates
MyArX(iVal) = aCell.Offset(0, 2).Value'numbers
iVal = iVal + 1
End If
Next aCell


xAddress_ListItem = frmGeneList.lstMain.List(l) '.Value
'defines series name

With objChartSeriesColl.NewSeries 'adds each? Series
.Name = xAddress_ListItem
.Values = MyArY
.XValues = MyArX
'.ApplyDataLabels
'.DataLabels.Position = xlLabelPositionAbove
'.DataLabels.NumberFormat = "0"
End With
        End If
    Next
End If

'objChart.HasTitle = True

With objChart.Chart
    '.Axes(xlCategory).TickLabels.NumberFormat = "m/d/yy;@" 'changes
'Xaxis text format
    .Axes(xlValue).TickLabels.NumberFormat = "General" 'changes Yaxis
'Text Format
    '.SetElement (msoElementChartTitleAboveChart) 'adds chart title above chart
    .SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
'adds Xaxis title
    .SetElement (msoElementPrimaryValueAxisTitleRotated) 'adds rotated
'Yaxis Title
    .SetElement (msoElementLegendBottom) 'adds legend @ bottom
    '.ChartTitle.Text = "IonTorrent Inter-Run Viriability"  'adds chart
'title above chart
    .Axes(xlCategory, xlPrimary).AxisTitle.Text = "Run Dates"
'renames Xaxis title to "X Title"
    '.Axes(xlValue, xlPrimary).AxisTitle.Text = "Sample Dates"
'renames Xaxis title to "X Title"
    .Axes(xlValue, xlPrimary).AxisTitle.Text = "%Alt" 'renames Yaxis
'title to "Y Title"
End With

With objChart.Chart.PlotArea.Format.Line 'adds black border around plot
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorText1
End With

With objChart.Chart.Legend.Format.Line 'adds black border around legend
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorText1
End With

End Sub

1 个答案:

答案 0 :(得分:0)

'将日期转换为值/双倍然后转换为整数以截断时间 MyArX(iVal)= Int(CDbl(aCell.Offset(0,2).Value))

这对我有用。