[我在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"
然后剪切所有格式。
感谢乔恩·佩尔帖!
您的方法效果很好。我将完成的图表之一的格式保存为模板,然后将该.crtx文件复制到网络位置。然后,我只需在代码中插入ObjXlChrt.ApplyChartTemplate "\\Network\location\MyChHartTemplate.crtx
即可替换所有格式。也使将来的更改变得更加容易,因为我需要做的就是创建一个新的模板文件。
不是我认为我需要走的路线,这就是为什么我在这里发布以获得其他意见。
再次感谢乔恩