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

问题描述 投票:0回答:2

[我在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
excel vba charts
2个回答
0
投票

如果图表不太复杂(您的图表也不太复杂),则可以手动进行制作,将其另存为模板(在本示例中名为“ MyChartTemplate”),然后将模板应用于图表。您基本上将替换为此

ObjXlChrt.ChartType = xlLineMarkers

与此

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

然后剪切所有格式。


0
投票

感谢乔恩·佩尔帖!

您的方法效果很好。我将完成的图表之一的格式保存为模板,然后将该.crtx文件复制到网络位置。然后,我只需在代码中插入ObjXlChrt.ApplyChartTemplate "\\Network\location\MyChHartTemplate.crtx即可替换所有格式。也使将来的更改变得更加容易,因为我需要做的就是创建一个新的模板文件。

不是我认为我需要走的路线,这就是为什么我在这里发布以获得其他意见。

再次感谢乔恩

© www.soinside.com 2019 - 2024. All rights reserved.