poniedziałek, 16 lipca 2007

Tworzenie i usuwanie wykresu

O ile mamy w obiekcie dane zaznaczone wszystkie dane z jakich trzeba stworzyć wykres, to samo kodowanie (skrypt) wyglądał by w sposób następujący.
Sub wykres(dane As Range, nazwa As String)

 'Application.DisplayAlerts = True
 'On Error Resume Next

 If (SheetExists(nazwa) = True) Then
     GoTo jest
 End If

 Dim suche_dane As Range
  
 dane.Select
 dane.Offset(0, 1).Resize(dane.Rows.Count, dane.Columns.Count - 1). _
     Select
 Set suche_dane = Selection
  
 Dim mini As Double
 Dim maxi As Double
  
 mini = WorksheetFunction.min(suche_dane)
 maxi = WorksheetFunction.max(suche_dane)

 Charts.Add after:=ActiveSheet
 ActiveChart.Name = nazwa
 ActiveChart.ChartType = xlLineMarkers
  
 ActiveChart.SetSourceData _
     Source:=dane, _
     PlotBy:=xlColumns
 
 ActiveChart.Location Where:=xlLocationAsNewSheet
 With ActiveChart
     .HasTitle = True
     .ChartTitle.Characters.Text = "Metoda naiwna 1.1"
      
         '.Axes(xlCategory, xlPrimary).HasTitle = True
         '.Axes(xlValue, xlPrimary).HasTitle = False
 End With
  
  
     With ActiveChart.Axes(xlValue)
         .MaximumScale = maxi + (maxi - mini) * 0.025
         .MinimumScale = mini - (maxi - mini) * 0.025
         .HasMajorGridlines = True
         .HasMinorGridlines = True
     End With
  
     With ActiveChart.Axes(xlValue).MinorGridlines.Border
         .ColorIndex = 15
         .Weight = xlHairline
         .LineStyle = xlDash
     End With
  
     With ActiveChart.Axes(xlValue).MajorGridlines.Border
         .ColorIndex = 48
         .Weight = xlHairline
         .LineStyle = xlContinuous
     End With
  
     With ActiveChart.SeriesCollection(1).Border
         .ColorIndex = 50
         .Weight = xlThin
         .LineStyle = xlContinuous
     End With
  
     With ActiveChart.SeriesCollection(1)
         .MarkerBackgroundColorIndex = 50
         .MarkerForegroundColorIndex = 50
         .MarkerStyle = xlTriangle
         .MarkerSize = 5
         .Smooth = False
     End With
  
  
     With ActiveChart.SeriesCollection(2).Border
         .ColorIndex = 3
         .Weight = xlMedium
         .LineStyle = xlContinuous
     End With
  
     With ActiveChart.SeriesCollection(2)
         .MarkerBackgroundColorIndex = 3
         .MarkerForegroundColorIndex = 3
         .MarkerStyle = xlSquare
         .MarkerSize = 5
         .Smooth = False
     End With
  
     ActiveChart.ChartArea.Interior.Color = RGB(255, 255, 255)
     ActiveChart.PlotArea.Interior.Color = RGB(255, 255, 255)
     ActiveChart.Refresh
     ActiveChart.Deselect

 GoTo koniec

jest:
 MsgBox "Wykres już jest."
koniec:
End Sub
Usunięcie takiego wykresu to w zasadzie usuwanie arkusza, ale nie do końca :P Kod:
Worksheets("Wykres_1_1").Delete
Nie przejdzie, ponieważ wykres stanowi nową zakładkę - i wcale nie jest jej elementem. (udało by się gdybyśmy tworząc wykres wstawili go na arkusz jako obiekt)

W omawianym przypadku (wykres jako zakładka) zadziała dopiero
Application.DisplayAlerts = False
Charts("nazwa").Delete
Application.DisplayAlerts = True
Kompletne marko usuwające wykres mogłoby wyglądać w sposób następujący:
Sub usun_wykres(nazwa As String)

 If (SheetExists(nazwa) = True) Then
     GoTo jest
 Else
     GoTo niema
 End If

jest:
 Application.DisplayAlerts = False
 Charts(nazwa).Delete
 Application.DisplayAlerts = True
 GoTo koniec:

niema:
 MsgBox "Wykresu nie ma"

koniec:

End Sub

Brak komentarzy:

Prześlij komentarz