2015-10-30 13 views
6

Bu Dinamik Virtual Basic grafikleri oluşturmak için kullanabileceğiniz koddur veri?Sil grafik serisi ama tutmak onların biçimlendirme

+0

açıklamaya çalışacağız Bu prosedürün bazı önemli bir kısmı eksik görünüyor gibi görünüyor. Kodun şimdiki şekli "CopySource_Chart" prosedürü hiçbir zaman idam edilmeyecek. Çalışma kitabınızı yayınlamayı düşünür müsünüz, böylece tutmaya çalıştığınız ayarlar hakkında daha iyi bir fikre sahip olabiliriz, ayrıca bunları nasıl saklamak istiyorsunuz ?, bunları nasıl kullanmayı planlıyorsunuz? – EEM

+0

Bir sorum var, neden grafikteki diziyi silmeniz ve sonra '.SeriesCollection.NewSeries' ile yeni bir tane oluşturmanız gerekiyor? İlk dizileri silmek için bir seçenek mi, daha sonra verileri değiştirip eski formatı koruyacak bir seçenek mi? –

+0

Teklif ettiğim seçeneği kabul ederseniz, sadece bir seri için değil, seriyi gerektiği kadar saklamak için ayarlanabilir. İstediğimiz dizi sayısını kullanıyoruz (örneğin kodunuzda sadece bir tane var, ancak daha fazlasına ihtiyacınız olabilir), onların biçimlendirmelerini koruyabilmelerini ve sadece değerlerini değiştirmelerini sağlarız, sonra kalan serileri siliyoruz. Lütfen bu geçici çözümün sizin için bir seçenek olup olmadığını söyleyin, çünkü Silinen bir dizinin Biçimi tasarrufu çok sıkıcı görünmektedir: Bir dizinin Biçim nesnesi çok fazla özelliğe sahiptir ve 'derin referanslar ', kaydedilmesi için kolayca klonlanamaz. . –

cevap

6

Bu sorunu daha önce çözdüm. Makro tarafından oluşturulan grafiklerim var, ancak sadece bunları yaptığım tarihe uygulanmış. Böylece, her Çalışma Kitabı açıldıktan sonra çalışan bir yenileme makrosu hazırlandı. Daha önce kaynak kullandım ve her şeyi sildim. daha sonra sadece diziye taşındı. Çalışmamı buraya yapıştırıp açıklamaya çalışacağım. hızlı navigasyon için kod ikinci bölümü orada alt aktualizacegrafu denilen (eğer

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 

buldum sonucudur alt generacegrafu() ile başlayan kod üst kısmında bir başvuru bulmak kayıp alırsanız) size yardımcı olabilir o çok iyi grafik doesnt iş kaynağı ve bunu silmek bazı biçim benim grafiğin gerçekleştirme yanı

burada
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 

yayınlayacağız kaybolacaktır o dizeyi girer yakın grafik çünkü ne zaman tamamen biçimlendirme devam edemez istediği hücrenin adresini her zaman girerim, çünkü hata ayıklaması ile daha kolay görülebilir. ! R13C16 ActiveChart.SeriesCollection (1) .name = Liste1 R1C1:! R1C15

çek ActiveChart.SeriesCollection (1) Değerler, = Liste1 R12C1 içinde Sheet anlamına sonucu bu List benziyor

girilen ediliyor ne yazdırmak aslında zaten bir grafik var ama uygular bölgeye hafif değişiklikler yapmak istediğinizde bu yüzden

 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 

bunun sonucu ise daha sonra bunun tutmak eğer üzgünüm değilse bu biraz yardımcı biçimlendirme umut tutar Revard. Sadece bana meraklı var çünkü ben daha fazla açıklama için bu son aynı sorunu çözüyordu ve ben