हटाएं चार्ट श्रृंखला लेकिन उनके स्वरूपण रखने

Question

इस कोड मैं गतिशील Virtual Basic में चार्ट बनाने के लिए उपयोग है डेटा?

Answer 1

मैंने पहले इस मुद्दे को हल किया है। मेरे पास चार्ट हैं जो मैक्रो द्वारा बनाए गए थे, लेकिन यह केवल उन तारीखों पर लागू होता है जिन्हें मैंने बनाया था। तो एक ताज़ा मैक्रो बनाया जो प्रत्येक कार्यपुस्तिका के बाद चलता है। मैंने पहले स्रोत का इस्तेमाल किया और पाया कि यह सब कुछ हटा देता है। फिर केवल श्रृंखला में चले गए। मैं अपना काम यहां पेस्ट कर दूंगा और समझाने की कोशिश करूंगा। त्वरित नेविगेशन के लिए कोड के दूसरे भाग नीचे वहाँ उप aktualizacegrafu कहा जाता है (यदि आप उप generacegrafu()

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 

परिणाम मैंने पाया है के साथ शुरू कोड के ऊपरी भाग में एक संदर्भ को खोजने दफा हो जाओ) आप मदद कर सकता है कि आप पूरी तरह formating नहीं रख सकते हैं जब आप करीब चार्ट क्योंकि चार्ट does not काम के स्रोत बहुत अच्छी तरह से और जब आप इसे हटा कुछ प्रारूप मैं चार्ट की मेरी दिलचस्पी के साथ-साथ

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 

यहाँ

पोस्ट करेंगे खो जाएगा यह स्ट्रिंग में प्रवेश करती है कि वांछित सेल के एड्रेस में मैं हमेशा इसे स्ट्रिंग के रूप में दर्ज करता हूं क्योंकि डीबग के साथ देखना आसान होता है। प्रिंट द्वारा दर्ज की जा रही है

परिणाम इस सूची की तरह लग रहा चेक 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 

तो इसी का परिणाम है जब आप वास्तव में एक चार्ट में पहले से ही है, लेकिन क्षेत्र में यह लागू होता है मामूली परिवर्तन करना चाहते हैं तो यह formating आशा है कि यह एक बिट में मदद की नहीं तो मैं माफी चाहता हूँ अगर यह रखना था रखता है revard। यह मुझे उत्सुकता से मिला क्योंकि मैं हाल ही में एक ही समस्या को हल कर रहा था यदि आपको कोई और स्पष्टीकरण टिप्पणी की आवश्यकता है और मैं