在 Excel/VBA 中设置默认图表参数

斯科特·奈策尔

我在 MSAccess 中有一个过程,它剔除数据,然后创建一个新的 excel 工作簿,将数据推送到它,然后在 excel 中创建一个图表。

创建后,图表将格式化为我们喜欢的外观。
这就是事情放缓的地方。我们正在绘制每个单独的图表后设置它,总共有 150 个左右的图表,这需要一段时间。

我想知道的是,我们想要的所有图表参数都可以以编程方式设置为默认值吗?这样,我们设置一次,所有绘制的图表从一开始就采用该格式。

用于生成和格式化附加图表的代码。

谢谢

Sub CreateChart(ObjXlWs As Worksheet, K As Integer)
Dim ObjXlChrt As Chart
Dim FixChart As ChartObject
Dim Cntr, J As Integer
Dim ChartNm
Dim xRg As Range

Cntr = K
Set xRg = Range(Split(Cells(1, (((Cntr - 1) * 12 + 1) + 1)).Address, "$")(1) & "4:" & (Split(Cells(1, (((Cntr - 1) * 12 + 10) + 1)).Address, "$")(1) & "26"))

    Set ObjXlChrt = ObjXlWs.ChartObjects.Add(50, 40, 600, 400).Chart
    ObjXlChrt.ChartType = xlLineMarkers
    ObjXlChrt.SetSourceData Source:=Sheets(ObjXlWs.Name).Range(Split(Cells(1, (((Cntr - 1) * 12 + 2) + 1)).Address, "$")(1) & "66:" & _
        Split(Cells(1, (((Cntr - 1) * 12 + 7) + 1)).Address, "$")(1) & 65 + ObjXlWs.Range(Split(Cells(1, (((Cntr - 1) * 12 + 5) + 1)).Address, "$")(1) & "62").Value), PlotBy:=xlColumns
    ObjXlChrt.Location Where:=xlLocationAsObject, Name:=ObjXlWs.Name
    Set FixChart = ActiveSheet.ChartObjects(K)
    With FixChart
        .Top = xRg(1).Top
        .Left = xRg(1).Left
        .Width = xRg.Width
        .Height = xRg.Height
    End With

    With ObjXlChrt
        .HasAxis(xlCategory, xlPrimary) = True
        .HasAxis(xlValue, xlPrimary) = True
        .HasTitle = False
        .Axes(xlCategory).CategoryType = xlCategoryScale
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date:"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Sheets(ObjXlWs.Name).Range(Split(Cells(1, (((Cntr - 1) * 12 + 1) + 1)).Address, "$")(1) & "60").Value
        .Axes(xlCategory).HasMajorGridlines = False
        .Axes(xlCategory).HasMinorGridlines = False
        .Axes(xlValue).HasMajorGridlines = False
        .Axes(xlValue).HasMinorGridlines = False
        .HasLegend = False
    End With

   With ObjXlChrt.Axes(xlCategory).TickLabels
        .Orientation = xlUpward
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    With ObjXlChrt.Axes(xlCategory).AxisTitle
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    With ObjXlChrt.Axes(xlValue).TickLabels
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    With ObjXlChrt.Axes(xlValue).AxisTitle
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    ObjXlChrt.PlotArea.ClearFormats

    ObjXlChrt.Axes(xlCategory).AxisTitle.Left = 16
    ObjXlChrt.Axes(xlCategory).AxisTitle.Top = 300

    ObjXlChrt.PlotArea.Left = 45
    ObjXlChrt.PlotArea.Width = 425
    ObjXlChrt.PlotArea.Top = 21
    ObjXlChrt.PlotArea.Height = 310

    On Error Resume Next

    With ObjXlChrt.SeriesCollection(5)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlDot
        .MarkerStyle = xlNone
    End With

    With ObjXlChrt.SeriesCollection(4)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlDot
        .MarkerStyle = xlNone
    End With

    With ObjXlChrt.SeriesCollection(3)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlDashDot
        .MarkerStyle = xlNone
    End With

    With ObjXlChrt.SeriesCollection(2)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlContinuous
        .MarkerStyle = xlSquare
        .MarkerBackgroundColorIndex = 2
        .MarkerForegroundColorIndex = 1
        .MarkerSize = 3
    End With

    With ObjXlChrt.SeriesCollection(1)
        .Border.ColorIndex = 1
        .Border.Weight = xlHairline
        .Border.LineStyle = xlContinuous
        .MarkerStyle = xlAutomatic
        .MarkerBackgroundColorIndex = xlAutomatic
        .MarkerForegroundColorIndex = xlAutomatic
        .MarkerSize = 3
    End With

    On Error GoTo 0

End Sub
乔恩·珀尔帖

如果图表不太复杂(而你的不是),您可以手动制作,将其保存为模板(在本例中名为“MyChartTemplate”),然后将模板应用于图表。你基本上会替换这个

ObjXlChrt.ChartType = xlLineMarkers

有了这个

ObjXlChrt.ApplyChartTemplate Environ("appdata") & _
    "\Microsoft\Templates\Charts\MyChartTemplate.crtx"

然后剪掉所有的格式。

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章