Achsenskal. auf mehreren Blättern VBA

Forumthread: Achsenskal. auf mehreren Blättern VBA

14.06.2022 18:45:58

Grand

Hallo Freunde,
ich habe mir gestern und heute an folgendem Sachverhalt die Zähne ausgebissen und konnte nur einen Teilerfolg erzielen. Es wäre super, wenn mir jemand beim Rest helfen könnte. Ich erkläre kurz vereinfacht die Sachlage:
Das Ziel ist eine Vorlage zu erstellen, die je nach konkretem Einsatzzweck unterschiedlich "reagieren" soll.
Auf dem Tabellenblatt namens INFO sollen in einem Zellbereich Tabellenblattnamen eingetragen werden. Zum Beispiel im Zellbereich F2:F31. Dieser Zellbereich wird aber nicht immer komplett ausgefüllt. Mal stehen dort 5 Namen drin, mal 7, mal 14, usw. Die Namen sehen von der Struktur aus immer so aus "Tag 1, Tag 2, Tag 3, usw. bis Tag 30". Im Zellbereich F2:F31 könnte jetzt also von F2:F7 stehen: Tag 1, Tag 2, Tag 8, Tag 11, Tag 14, Tag 27.
Anhand dieser Namen sollen jetzt xy-Diagramme erstellt werden. Dafür habe ich einen "Template"-Reiter erstellt, auf dem ich mein xy-Diagramm so formatiert habe, wie ich es brauche und dieses wird per Makro dann so oft kopiert, so viele Einträge ich im Zellbereich F2:F31 ich auf dem Blatt Info habe. Auch die automatische Zuweisung der oben genannten Blattnamen zu den neukopierten Blättern habe ich hinbekommen (also mit den Code zusammengesucht).
An folgendem Punkt hänge ich jetzt aber und habe mir da heute 5-6 Stunden die Zähne ausgebissen:
Ich möchte in Spalten G und H auf dem Blatt INFO das Minimum und Maximum der x-Achse eintragen, die für das neuerstellte Blatt aus Spalte F angewendet werden soll. Kann mir da jemand helfen? Ich schaffe es einfach nicht.
Mein bisheriger Code sieht so aus:


Sub Diagramme_erstellen()
Dim i As Long
On Error GoTo Errorhandler
Anzahl = WorksheetFunction.CountA(Sheets("INFO").Range("F2:F31" & Range("F" & Rows.Count).End(xlUp).Row))
For i = 1 To Anzahl
Titel = Sheets("INFO").Cells(i + 1, 6).Value
ActiveWorkbook.Sheets("Template").Copy before:=ActiveWorkbook.Sheets("Grenzen_Labels")
ActiveSheet.Name = Titel
Next
Exit Sub
Errorhandler:
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Achsenskal. auf mehreren Blättern VBA

14.06.2022 19:47:11

Grand

Ich habe es hinbekommen :)))) Nachdem ich heute auf der Arbeit fast verzweifelt wäre.
Mein Code:


Sub Diagramme_erstellen()
Dim i As Long
On Error GoTo Errorhandler
Anzahl = WorksheetFunction.CountA(Sheets("INFO").Range("F2:F31" & Range("F" & Rows.Count).End(xlUp).Row))
For i = 1 To Anzahl
Min = Sheets("INFO").Cells(i + 1, 7).Value
Max = Sheets("INFO").Cells(i + 1, 8).Value
Titel = Sheets("INFO").Cells(i + 1, 6).Value
ActiveWorkbook.Sheets("Template").Copy before:=ActiveWorkbook.Sheets("Grenzen_Labels")
ActiveSheet.Name = Titel
ActiveChart.ChartArea.Select
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScale = Min
ActiveChart.Axes(xlCategory).MaximumScale = Max
Next
Exit Sub
Errorhandler:
End Sub

AW: Achsenskal. auf mehreren Blättern VBA

15.06.2022 09:43:35

snb

Oder


Sub M_snb()
sn = Sheets("INFO").Range("F2:F31").SpecialCells(2).Resize(, 3)
For j = 1 To UBound(sn)
Sheets("template").Copy Sheets("Grenzen_Labels")
With ActiveSheet
.Name = sn(j, 1)
With .ChartObjects(1).Chart.Axes(1)
.MinimumScale = sn(j, 2)
.MaximumScale = sn(j, 3)
End With
End With
Next
End Sub

AW: Achsenskal. auf mehreren Blättern VBA

15.06.2022 12:50:09

Grand

Vielen Dank für deinen Vorschlag!
Ich habe ihn aus Neugier mal ausprobiert, da er so schön kurz aussieht.
Bei With .ChartObjects(1).Chart.Axes(1) bricht es mir mit einem Laufzeitfehler '1004' ab.

AW: Achsenskal. auf mehreren Blättern VBA

15.06.2022 15:27:18

Beverly

Hi,
aus deinem im vorigen Beitrag gepostetn Code würde ich entnehmen, du verwendest ein Diagrammblatt und kein eingebettetes Diagramm? Deshalb der Fehler - im Diagrammblatt gibt es kein Diagrammobjekt, auf das man referenzieren muss.
Hier ein Code, der vorher noch prüft, ob ein zu erstellendes Diagrammblatt bereits existiert:


Sub Diagramme_erstellen()
Dim Anzahl As Long
Dim i As Long
Dim Titel As String
Dim Min As Double
Dim Max As Double
Dim chrDia As Chart
Dim blnVorhanden As Boolean
Anzahl = WorksheetFunction.CountA(Sheets("INFO").Range("F2:F31"))
For i = 2 To Anzahl
Titel = Sheets("INFO").Cells(i, 6).Value
For Each chrDia In ActiveWorkbook.Charts
If chrDia.Name = Titel Then
MsgBox "Diagramm " & Titel & " bereits vorhanden"
blnVorhanden = True
Exit For
End If
Next chrDia
If blnVorhanden = False Then
Min = Sheets("INFO").Cells(i, 7).Value
Max = Sheets("INFO").Cells(i, 8).Value
ActiveWorkbook.Sheets("Template").Copy before:=ActiveWorkbook.Sheets("Grenzen_Labels")
ActiveWorkbook.Charts( ActiveWorkbook.Charts.Count).Name = Titel
With ActiveWorkbook.Charts(Titel).Axes(xlCategory)
.MinimumScale = Min
.MaximumScale = Max
End With
End If
blnVorhanden = False
Next
End Sub

Bis später
Karin

Beliebteste Forumthreads (12 Monate)

Achsenskal. auf mehreren Blättern VBA

Forumthread: Achsenskal. auf mehreren Blättern VBA

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread