Delete seria wykres ale zachować ich formatowanie

Question

Jest to kod używam do dynamicznego tworzenia wykresów w Virtual Basic:

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 

Jak mogę zachować formatowanie serii, która jest stosowana w If bIssetSourceChart części podczas usuwania tych serii dane?

Answer 1

Rozwiązałem ten problem wcześniej. Mam wykresy, które zostały utworzone przez makro, ale dotyczyły tylko daty ich utworzenia. Tak więc zrobiłem makro odświeżania, które uruchamia się po otwarciu każdego Podręcznika. Użyłem źródła wcześniej i stwierdziłem, że usuwa wszystko. następnie przeniesiono tylko do serii. Wkleję tutaj moją pracę i spróbuję wyjaśnić. Do szybkiej nawigacji druga część kodu tam nazywa sub aktualizacegrafu() może pomóc w przypadku zgubienia się znaleźć odniesienie w górnej części kodu zaczynając generacegrafu sub()

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 

wynikiem znalazłem jest że nie można zachować formatowanie całkowicie po zamknięciu wykres ponieważ źródłem wykresu robi praca bardzo dobrze, a kiedy go usunąć niektóre Format zostaną utracone będę pisać moją aktualizację wykresu oraz

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 

tu wchodzi łańcuch zawiera adres żądanej komórki, którą zawsze wprowadzam jako ciąg, co ułatwia jej podgląd za pomocą debugowania. wydrukować, co jest wpisane

wynik wygląda niniejszym wykazie oznacza arkusz w języku czeskim activechart.seriescollection (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 

tak Wynikiem tego jest, kiedy rzeczywiście mają wykresu już jednak chcesz dokonać niewielkich zmian w obszarze dotyczy ona wtedy zachowuje formatowanie nadzieję, że to pomogło trochę, jeśli nie jestem przepraszam, jeśli to było zachować revard. To mnie zainteresowało, ponieważ ostatnio rozwiązałem ten sam problem, , jeśli potrzebujesz dalszych wyjaśnień, skomentuj to i postaram się wyjaśnić: