Hallo Zusammen
Ich möchte ein Diagramm per Makro erstellen, alles kein Problem. Nur verändern sich bei mir der Range (z.B. B13:C33 zu B13:C53).
Kann man das auch automatisch erkennen lassen, wie weit die Einträge
in der Tabelle nach unten gehen.
Die Einträge sind immer schön untereinander, also kein leere Feld.
Hat jemand eine Idee.
Flexo
Hi Flexo,
Ich möchte ein Diagramm per Makro erstellen, alles kein
Problem.
Nö, da ist schon ein Problem.
Wo ist der Makrocode?
Wenn du das Diagramm per Makro erstellest ist es kein Problem dort einzubauen dass das makro gleich prüft wie „tief“ die daten nach unten reichen, also bis Zeile 33 oder 53.
Nur verändern sich bei mir der Range (z.B. B13:C33 zu
B13:C53).
Kann man das auch automatisch erkennen lassen, wie weit die
Einträge
in der Tabelle nach unten gehen.
Ja.
Poste mal dein Makro.
Gruß
Reinhard
Hi Reinhard,
so sieht das auggezeichnete makro aus.
Private Sub Graph_Click()
On Error GoTo Fehler
Range(„B13:C33“).Select
If Application.WorksheetFunction.CountBlank(Range(„B13:C33“)) = _
Range(„B13:c33“).Cells.Count Then Exit Sub
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets(„Tabelle1“).Range(„B13:C33“), _
PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Name = „=“„Volt“""
ActiveChart.SeriesCollection(1).Name = „=Tabelle1!R4C4“
ActiveChart.Location Where:=xlLocationAsObject, Name:=„Tabelle1“
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = „Volt“
.Axes(xlValue, xlPrimary).HasTitle = False
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
ActiveChart.Legend.Select
Selection.Delete
Set Diagramm = Sheets(„Tabelle1“).ChartObjects(1).Chart
Diagramm.Parent.Width = Image1.Width
Diagramm.Parent.Height = Image1.Height
Diagramm.Export Filename:=„C:\Diagramm.gif“, FilterName:=„GIF“
Image1.Picture = LoadPicture(„c:\diagramm.gif“)
On Error GoTo 0
Fehler: Exit Sub
End Sub
Gruss & Thx