删除图表系列，但保持其格式
这是我用来在Virtual Basicdynamic创build图表的代码：
Dim Chart As Object Set Chart = Charts.Add With Chart If bIssetSourceChart Then CopySourceChart .Paste Type:=xlFormats End If For Each s In .SeriesCollection s.Delete Next s .ChartType = xlColumnClustered .Location Where:=xlLocationAsNewSheet, Name:=chartTitle Sheets(chartTitle).Move After:=Sheets(Sheets.count) With .SeriesCollection.NewSeries If Val(Application.Version) >= 12 Then .values = values .XValues = columns .Name = chartTitle Else .Select Names.Add "_", columns ExecuteExcel4Macro "series.columns(!_)" Names.Add "_", values ExecuteExcel4Macro "series.values(,!_)" Names("_").Delete End If End With End With #The CopySourceChart Sub: Sub CopySourceChart() If Not CheckSheet("Source chart") Then Exit Sub ElseIf TypeName(Sheets("Grafiek")) = "Chart" Then Sheets("Grafiek").ChartArea.Copy Else Dim Chart As ChartObject For Each Chart In Sheets("Grafiek").ChartObjects Chart.Chart.ChartArea.Copy Exit Sub Next Chart End If End Sub
如何在保留If bIssetSourceChart部分中应用的系列格式的同时删除这些系列的数据？
我以前解决过这个问题。 我有由macros创build的图表，但它只适用于我做它们的date。 因此，在每个Workbook打开后，都会创build一个刷新macros。 我之前使用过源代码，发现它删除了一切。 然后转移到系列只。 我会在这里粘贴我的作品并尝试解释。 为了快速导航，下面的代码的第二部分称为sub aktualizacegrafu（）可能会帮助你，如果你迷路在代码的上半部分中find一个引用subgenracegragra（）
Sub generacegrafu() ThisWorkbook.Sheets("List1").CommandButton6.BackColor = &H0& ThisWorkbook.Sheets("List1").CommandButton6.ForeColor = &HFFFFFF Dim najdiposlradek As Object Dim graf As Object Dim vkladacistring As String Dim vykreslenysloupec As Integer Dim hledejsloupec As Object Dim hledejsloupec2 As Object Dim kvantifikator As Integer Dim grafx As ChartObject Dim shoda As Boolean Dim jmenografu As String Dim rngOrigSelection As Range Cells(1, 1).Select If refreshcharts = True Then Set hledejsloupec = Range("11:11").Find(What:=prvnislovo, LookIn:=xlValues) 'dynamicaly generated, prvnislovo is for first word in graph and the macro looks for match in row 11 if it doesnt find any then Else 'then it looks for match in option box Set hledejsloupec = Range("11:11").Find(What:=ThisWorkbook.Sheets("List1").ComboBox1.Value, LookIn:=xlValues) End If If hledejsloupec Is Nothing Then MsgBox "Zadaný sloupec v první nabídce nebyl nalezen." Else If refreshcharts = True Then Set hledejsloupec2 = Range("11:11").Find(What:=druheslovo, LookIn:=xlValues) Else Set hledejsloupec2 = Range("11:11").Find(What:=ThisWorkbook.Sheets("List1").ComboBox2.Value, LookIn:=xlValues) End If If hledejsloupec2 Is Nothing Then MsgBox "Zadaný sloupec v druhé nabídce nebyl nalezen." Else jmenografu = Cells(11, hledejsloupec.Column).Value & "_" & Cells(11, hledejsloupec2.Column).Value Set najdiposlradek = Range("A:A").Find(What:=Date, LookIn:=xlValues) Application.ScreenUpdating = False Set rngOrigSelection = Selection 'This one selects series for new graph to be created Cells(1048576, 16384).Select Set graf = ThisWorkbook.Sheets("List1").Shapes.AddChart rngOrigSelection.Parent.Parent.Activate rngOrigSelection.Parent.Select rngOrigSelection.Select 'trouble with annoing excel feature to unselect graphs Application.ScreenUpdating = True graf.Select kvantifikator = 1 Do shoda = False For Each grafx In ThisWorkbook.Sheets("List1").ChartObjects If grafx.Name = jmenografu Then shoda = True jmenografu = jmenografu & "(" & kvantifikator & ")" kvantifikator = kvantifikator + 1 End If Next grafx 'this checks if graph has younger brother in sheet 'but no we get to the part that matter do not bother playing with source of the graph because I have found it is quite hard to make it work properly Loop Until shoda = False 'here it starts ActiveChart.Parent.Name = jmenografu ActiveChart.SeriesCollection.NewSeries 'add only series! vkladacistring = "=List1!R12C" & hledejsloupec.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec.Column 'insert this into series ActiveChart.SeriesCollection(1).Values = vkladacistring vkladacistring = "=List1!R11C" & hledejsloupec.Column ActiveChart.SeriesCollection(1).Name = vkladacistring vkladacistring = "=List1!R12C" & hledejsloupec2.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec2.Column ActiveChart.SeriesCollection(1).XValues = vkladacistring 'here it ends and onward comes formating ActiveChart.Legend.Delete ActiveChart.ChartType = xlConeColClustered ActiveChart.ClearToMatchStyle ActiveChart.ChartStyle = 41 ActiveChart.ClearToMatchStyle ActiveSheet.Shapes(jmenografu).Chart.ChartArea.Format.ThreeD.RotationY = 90 ActiveSheet.Shapes(jmenografu).Chart.ChartArea.Format.ThreeD.RotationX = 0 ActiveChart.Axes(xlValue).MajorUnit = 8.33333333333333E-02 ActiveChart.Axes(xlValue).MinimumScale = 0.25 ActiveChart.Walls.Format.Fill.Visible = msoFalse ActiveChart.Axes(xlCategory).MajorUnitScale = xlMonths ActiveChart.Axes(xlCategory).MajorUnit = 1 ActiveChart.Axes(xlCategory).BaseUnit = xlDays End If End If Call aktualizacelistboxu ThisWorkbook.Sheets("List1").CommandButton6.BackColor = &H8000000D ThisWorkbook.Sheets("List1").CommandButton6.ForeColor = &H0& End Sub
我发现的结果是，当你closures图表时，你不能完全保持格式化，因为图表的源代码工作得不好，当你删除它时，一些格式将会丢失我会发布我的图表实现
Sub aktualizacegrafu() Dim grafx As ChartObject Dim hledejsloupec As Object Dim hledejsloupec2 As Object Dim vkladacistring As String Dim najdiposlradek As Object For Each grafx In ThisWorkbook.Sheets("List1").ChartObjects prvnislovo = Left(grafx.Name, InStr(1, grafx.Name, "_") - 1) druheslovo = Right(grafx.Name, Len(grafx.Name) - InStr(1, grafx.Name, "_")) 'now it checks the names of charts .. the data loads from respective columns that are named the same way so I ussualy choose what statistic I want by choosing the columns needed 'for example I want to reflect my arrivals to work according to the hours I worked or to the date so I set 1st option to arrival and 2nd to date grafx.Activate Set najdiposlradek = Range("A:A").Find(What:=Date, LookIn:=xlValues) Set hledejsloupec = Range("11:11").Find(What:=prvnislovo, LookIn:=xlValues) If hledejsloupec Is Nothing Then MsgBox "Hodnota v grafu již není mezi sloupci v tabulce. Aktualizace grafu " & grafx.Name & " bude ukončena." Else Set hledejsloupec2 = Range("11:11").Find(What:=druheslovo, LookIn:=xlValues) If hledejsloupec2 Is Nothing Then MsgBox "Hodnota v grafu již není mezi sloupci v tabulce. Aktualizace grafu " & grafx.Name & " bude ukončena." Else
在这里它input包含所需单元格地址的string，我总是将它作为stringinput，使得它更容易看到与debug.print什么是input
（1）.values = List1！R12C1：R13C16 activechart.seriescollection（1）.name = List1！R1C1：R1C15
vkladacistring = "=List1!R12C" & hledejsloupec.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec.Column ActiveChart.SeriesCollection(1).Values = vkladacistring vkladacistring = "=List1!R11C" & hledejsloupec.Column ActiveChart.SeriesCollection(1).Name = vkladacistring vkladacistring = "=List1!R12C" & hledejsloupec2.Column & ":R" & najdiposlradek.Row & "C" & hledejsloupec2.Column ActiveChart.SeriesCollection(1).XValues = vkladacistring End If End If Next grafx Call aktualizacelistboxu End Sub
所以这个结果是你已经有一个图表了，但是想对它所适用的区域做一些细微的改动，那么这个格式化的希望对我来说有一点帮助，如果没有的话， 这只是让我好奇，因为我最近解决同样的问题，如果你需要任何进一步的解释评论这个，我会尝试解释