Grafik drucken / Code änderen
06.03.2006 14:08:44
niko
Ich habe folgendes problem. ich erstelle eine grafik (code siehe unten) ich will die grafik nach einem click auf einen cmdbutton ausdrucken.
Das problem ist aber das beim erstellen der grafik immer ein neuer name verwendet wird.
Da ich aber immer nur eine grafik pro arbeitsmappe habe will ich einen fixen namen haben zb: Diagramm1. damit ich es mit den VBa befehlen:
ActiveSheet.ChartObjects("Diagramm1").Activate
ActiveChart.ChartArea.Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Aus drucken kann.
Hier der COde:
Public
Sub CreateChartObjectRange()
Dim onstock1() As String
Dim sitenr1 As String
Dim wksData As Worksheet
Dim rngData As Range
Dim nRowsCnt As Long
Dim nColsCnt As Integer
Dim nameueber As String
Dim objChart As Chart
Dim objChartObj As ChartObject
onstock1 = Split(UserFormVariableneingabe.ComboBoxAuswahl.Value, ";")
sitenr1 = (onstock1(0))
'Fehlerbehandlung aktivieren
On Error GoTo err_CreateChart
'Verweis auf Worksheet mit Daten setzen
Set wksData = ThisWorkbook.Worksheets(sitenr1)
'Verweis auf Datenbereich setzen
With wksData
'Anzahl der Spalten/Zeilen ermitteln
nRowsCnt = .Cells(.Rows.Count, 1).End(xlUp).Row
nColsCnt = .Cells(1, .Columns.Count).End(xlToLeft).Column
'Objektverweis auf Bereich setzen
Set rngData = .Range(.Cells(1, 1), .Cells(nRowsCnt, nColsCnt))
'In diesem Beispiel entspricht das:
'Set rngData = wksData.Range("A1:E6")
End With
'--- Diagramm erstellen ---
'Bildschirmaktualisierung deaktivieren
Application.ScreenUpdating = False
'Diagramm hinzufügen und Objektverweis setzen
Set objChart = Application.Charts.Add
With objChart
'Diagramm-Typ und -Quelldatenbereich festlegen
.ChartType = xlLineMarkers
.SetSourceData Source:=rngData, PlotBy:=xlColumns
'hard-coded:
' .SetSourceData Source:=Sheets("Diagramm-Daten").Range("A1:E6"), _
' PlotBy:=xlColumns
'Titel zuweisen
.HasTitle = True
.ChartTitle.Text = "On Stock Level plotted on Date from" & _
vbLf & "Site ID: " & sitenr1
'Diagramm auf Tabellenblatt einbetten
.Location Where:=xlLocationAsObject, name:=wksData.name
End With
'Objektverweis auf das eingebettete Diagramm setzen
Set objChartObj = wksData.ChartObjects(wksData.ChartObjects.Count)
'Position und Größe zuweisen
With objChartObj
.Left = 10
.Top = 50
.Width = 600
.Height = 400
End With
'Zelle A1 selektieren
wksData.Range("A1").Select
'Application.WindowState = xlMaximized
exit_sub:
On Error Resume Next
'Bildschirmaktualisierung aktivieren:
Application.ScreenUpdating = True
'Verweise (Speicher) freigeben
Set objChartObj = Nothing
Set objChart = Nothing
Set rngData = Nothing
Set wksData = Nothing
On Error GoTo 0
Exit Sub
err_CreateChart:
MsgBox "Fehler " & Err.Number & vbCrLf & Err.Description, _
vbOKOnly + vbCritical
Resume exit_sub
End Sub
Wie ändere ich den VBA Code, damit ich einen fixen namen erhalte?
grüß niko