我在 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] 删除。
我来说两句