VBA - 在X轴上显示时间

时间:2012-09-23 15:14:17

标签: excel vba excel-vba charts

我需要创建一个图表xlXYScatter。 我知道Excel在Seconds Column中将此数字视为日期。 如何将这个秒在X轴上以时间格式mm:ss:00:00 00:10 00:20等等。 我试过这个:.Axes(xlCategory,xlPrimary).TickLabels.NumberFormat =“[m]:mm:ss”。 但是Excel会看到这些数字是以秒为单位的数字,X轴上显示的值是有缺陷的。

这是我的样本数据:

Seconds    DEV1    DEV2    DEV3
  0           0      0       0
 10        6162    769     753
 20        6160    771     753
 30        6162    766     748
 40        6139    765     740
 50        6141    762     740
 60        6126    761     742
 70        6119    764     745
 80        6114    766     740
 90        6103    763     745
100        6098    768     745
110        6095    767     748
120        6095    768     737
130        6093    763     732
140        6093    764     729
150        6082    765     726
160        6078    764     729
170        6072    762     729
180        6074    760     726
190        6067    766     721
200        6067    762     724
210        6072    760     724
220        6070    756     729
230        6069    757     732
240        6063    757     734
250        6067    749     750
260        6063    751     753
270        6056    756     753
280        6057    758     753
290        6059    760     750
300        6064    761     753
310        6087    765     734

这是我的VBA代码:

Sub NewChart()

Sheets(1).Select 'Select the active Sheet

ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter

LastLine = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row

Dim MaxScale As Integer
Dim MTotal As Integer
Dim Aprox As Integer
Dim vName As String
vName = Sheets(2).Range("B3")

Dim Qx As Integer
Qx = LastLine - 1
Dim Rangg As Integer
Rangg = (LastLine * 10) - 60
MTotal = Rangg
MaxScale = Rangg + 20

    With ActiveChart
    .ChartType = xlXYScatter
    'Set data source range.
    .SetSourceData Source:=Sheets(2).Range("A5:A" & Qx & ",B5:B" & Qx & ",E5:E" & Qx & ",H5:H" & Qx & ", K5:K" & Qx & ", N5:N" & Qx & ", Q5:Q" & Qx) ', 'PlotBy:=xlRows
    .HasTitle = True
    .ChartTitle.Text = vName '"2-7µm"

    'The Parent property is used to set properties of the Chart.
    With .Parent
      .Top = 2
      .Left = 2
      .Width = 540
      .Height = 252
      .Name = "2micron"
    End With

ActiveChart.Legend.Select
        With Selection.Format.TextFrame2.TextRange.Font
            .NameComplexScript = "Tahoma"
            .NameFarEast = "Tahoma"
            .Name = "Tahoma"
        End With

    .Axes(xlCategory).MajorTickMark = xlInside
    .Axes(xlCategory).MinorTickMark = xlInside
    .Axes(xlCategory, xlPrimary).Select
    .Axes(xlCategory, xlPrimary).TickLabels.Font.Size = 5
    .Axes(xlCategory, xlPrimary).TickLabels.Font.Name = "Tahoma"
    .Axes(xlCategory, xlPrimary).TickLabels.Font.Bold = msoTrue
    .Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "[m]:mm:ss"
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (seconds)"
    .Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 11
    .Axes(xlCategory, xlPrimary).AxisTitle.Font.Bold = msoTrue
    .Axes(xlCategory, xlPrimary).AxisTitle.Font.Name = "Tahoma"
    .Axes(xlCategory, xlPrimary).MinorUnitIsAuto = False
    .Axes(xlCategory, xlPrimary).MajorUnit = 300
    .Axes(xlCategory, xlPrimary).MinorUnit = 60
    .Axes(xlCategory, xlPrimary).MaximumScale = MaxScale
    .Axes(xlCategory, xlPrimary).MinimumScale = 0
    .Axes(xlCategory, xlPrimary).HasMajorGridlines = False
    .Axes(xlCategory, xlPrimary).HasMinorGridlines = False
    .Axes(xlCategory).Format.Line.ForeColor.RGB = RGB(0, 0, 0)

    .Axes(xlValue).MajorTickMark = xlInside
    .Axes(xlValue).MinorTickMark = xlInside
    .Axes(xlValue, xlPrimary).Select
    .Axes(xlValue, xlPrimary).HasMajorGridlines = True
    .Axes(xlValue, xlPrimary).HasMinorGridlines = True
    .Axes(xlValue, xlPrimary).TickLabels.Font.Size = 11
    .Axes(xlValue, xlPrimary).TickLabels.Font.Name = "Tahoma"
    .Axes(xlValue, xlPrimary).TickLabels.Font.Bold = msoTrue
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Y axis Legend"
    .Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 11
    .Axes(xlValue, xlPrimary).AxisTitle.Font.Name = "Tahoma"
    .Axes(xlValue, xlPrimary).AxisTitle.Font.Bold = msoTrue
    .Axes(xlValue).Format.Line.ForeColor.RGB = RGB(0, 0, 0)

    .Legend.IncludeInLayout = False
    .Legend.Select
    Selection.Position = xlTop
    Selection.Font.Size = 11
    Selection.Font.Name = "Tahoma"
    Selection.Font.Bold = msoTrue

    ActiveSheet.Shapes("2micron").ScaleWidth 1, msoFalse, _
        msoScaleFromTopLeft

    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Select
    Selection.Left = 2
    Selection.Top = 2
    Selection.Format.TextFrame2.TextRange.Font.Size = 13.2
    Selection.Format.TextFrame2.TextRange.Font.Name = "Tahoma"
    Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
    ActiveChart.Legend.Select
    Selection.Left = 180
    Selection.Top = 2
        With Selection.Format.Line
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorAccent1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0
        End With
    ActiveChart.PlotArea.Select
    Selection.Top = 22
    Selection.Left = 20
    Selection.Height = 207
    Selection.Width = 540
    Selection.Border.LineStyle = xlSolid
    Selection.Border.Color = vbBlack
    Selection.Interior.Color = vbWhite
    End With

Call f_l2m1(1, 8, RGB(0, 176, 240))
Call f_l2m1(2, 3, RGB(255, 0, 0))
Call f_l2m1(3, 1, RGB(255, 0, 255))
Call f_l2m1(4, 2, RGB(153, 0, 255))
Call f_l2m1(5, 4, RGB(153, 0, 255))
Call f_l2m1(6, 9, RGB(146, 208, 80))

Range("a22").Select
End Sub

Sub f_l2m1(LineNo, MStyle, vRGB)

With ActiveSheet.ChartObjects("2micron").Chart

                ActiveChart.SeriesCollection(LineNo).Select
                With Selection
                    .MarkerStyle = MStyle
                    .MarkerSize = 7
                    .MarkerForegroundColor = vRGB
                End With
                Selection.Format.Fill.Visible = msoFalse
                Selection.Format.Line.Visible = msoFalse
                Selection.Format.Line.ForeColor.RGB = vRGB
End With
End Sub

1 个答案:

答案 0 :(得分:1)

Excel和VBA将日期和时间值作为包含整个部分和小数部分的数字处理 - 例如41176.0828。整个部分 - 41176 - 代表日期(2012年9月24日)和小数部分 - .0828 - 代表时间(01:59:12)

“秒”列中的值看起来像Excel的日期值,因为它们具有整数部分。通过除以86400(24 * 60 * 60)将它们转换为秒,您的图形轴标签应正确显示。如果需要,分割值可以在隐藏列中,以免弄乱您的值表的显示


编辑:以下更改使图表在Excel 2003中适用于我。我无法测试很多格式化命令,因为它们是在Excel 2007中引入的,但实际数据正在绘制中确定:

取消注释PlotBy参数并将其设置为xlColumns

旧:

.SetSourceData Source:=Sheets(2).Range("A5:A" & Qx & ",B5:B" & Qx & ",E5:E" & Qx & ",H5:H" & Qx & ", K5:K" & Qx & ", N5:N" & Qx & ", Q5:Q" & Qx) ', 'PlotBy:=xlRows

新:

.SetSourceData Source:=Sheets(2).Range("A5:A" & Qx & ",B5:B" & Qx & ",E5:E" & Qx & ",H5:H" & Qx & ", K5:K" & Qx & ", N5:N" & Qx & ", Q5:Q" & Qx), PlotBy:=xlColumns

通过将当前值除以86400来创建一个包含以秒为单位的值的列,确保这是图表数据源中的第一列,注释掉NumberFormat行,设置{{ 1}}属性NumberFormatLinked

旧:

True

新:

.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "[m]:mm:ss"

注释掉设置'.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "[m]:mm:ss" .Axes(xlCategory, xlPrimary).TickLabels.NumberFormatLinked = True MinorUnitIsAutoMinorUnit值的行

旧:

MajorUnit

新:

.Axes(xlCategory, xlPrimary).MinorUnitIsAuto = False
.Axes(xlCategory, xlPrimary).MajorUnit = 300
.Axes(xlCategory, xlPrimary).MinorUnit = 60

'.Axes(xlCategory, xlPrimary).MinorUnitIsAuto = False '.Axes(xlCategory, xlPrimary).MajorUnit = 300 '.Axes(xlCategory, xlPrimary).MinorUnit = 60 值除以86400,以便以秒为单位表示值:

旧:

MaximumScale

新:

.Axes(xlCategory, xlPrimary).MaximumScale = MaxScale