Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1640to1644
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Diagramm erstellen geht nicht
03.09.2018 20:05:23
Fred
Hallo zusammen
Ich versuche gerade mehrere Diagramme über einen Button zu erstellen was aber irgend wie nicht klappen will. Ich habe dazu den MacroRekorder mitlaufen lassen und versucht dann den Code zu starten. Aber leider kommt beim Ausführen immer ein CodeFehler Typ 13 nicht verträglich. Weiss jemand Rat.
Anbei mal eine Beispieltabelle
https://www.herber.de/bbs/user/123723.xls
Grüße Fred

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Lösungsvorschlag
04.09.2018 09:10:53
Beverly
Hi Fred,
versuche es mal damit (ich kann es leider nicht in Excel2003 testen):
Sub DiasErstellen()
Dim intSpalte As Integer
Dim lngLetzte As Long
Dim rngBereich As Range
For intSpalte = 1 To 19 Step 9
lngLetzte = Columns(intSpalte).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:= _
xlPrevious).Row
Set rngBereich = Range(Cells(9, intSpalte + 1), Cells(lngLetzte, intSpalte + 5))
With ActiveSheet.ChartObjects.Add(0, 0, 0, 0).Chart
.ChartType = xlColumnStacked100
.SetSourceData Source:=rngBereich
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
With .Parent
.Top = 1
.Height = 150
.Width = 350
.Left = Cells(1, intSpalte).Left
End With
.SeriesCollection(1).XValues = rngBereich.Columns(1).Offset(0, -1)
End With
Next intSpalte
End Sub


Anzeige
AW: Lösungsvorschlag
04.09.2018 13:56:12
Fred
Hallo Beverly (Karin)
Vielen Dank für die Antwort.
Der Code funktioniert echt super, Leider gibt es ein kleines Manko. Und zwar werden die 3 Diagramme Richtig angezeigt und auch die Werte stimmen, nur die Formatierung ist einfach zu groß. Siehe auf dem angehangenem Bild. Ich habe versucht Deinen Code zu manipulieren um die SchriftArt und die Zeichnungsfläche zu verandern, aber leider kriege ich das nicht hin. ich verstehe Deinen Code nicht und einfache Änderungen wie z.B:

.HasLegend= True
.Legend.Font.Sitze =10

Funktionieren nicht. Könntest Du vieleicht noch mal schaun was ich ändern müsst damit die Diagramme gut zu erkennen sind?
Mit freundlichen Grüßen fred
Userbild
Anzeige
AW: Lösungsvorschlag
04.09.2018 16:36:04
Beverly
Hi Fred,
zeichne doch mal den Code mit dem Makrorekorder auf, wenn du die Schriftgröße sowohl für die Legende als auch die Achsenbeschriftung auf 10 setzt und poste den Code dann.


AW: Lösungsvorschlag
05.09.2018 11:57:27
Fred
Hey Beverly
Hir ist mal der Code vom Recorder.Ich hoffe Du kannst damit was anfangen.

Sub Makro1()
' Makro1 Makro
ActiveSheet.ChartObjects("Diagramm 218").Activate
ActiveChart.Legend.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
End Sub
Grüße Fred
Anzeige
AW: Lösungsvorschlag
05.09.2018 13:36:04
Beverly
Hi Fred,
versuche es mal so:
Sub DiasErstellen()
Dim intSpalte As Integer
Dim lngLetzte As Long
Dim rngBereich As Range
For intSpalte = 1 To 19 Step 9
lngLetzte = Columns(intSpalte).Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rngBereich = Range(Cells(9, intSpalte + 1), Cells(lngLetzte, intSpalte + 5))
With ActiveSheet.ChartObjects.Add(0, 0, 0, 0).Chart
.ChartType = xlColumnStacked100
.SetSourceData Source:=rngBereich
.SeriesCollection(1).XValues = rngBereich.Columns(1).Offset(0, -1)
.HasTitle = False
.HasLegend = True
With .Legend
.AutoScaleFont = True
.Font.Size = 10
.Font.Name = "Arial"
End With
With .Axes(xlCategory)
.HasTitle = False
With .TickLabels
.AutoScaleFont = True
.Font.Size = 10
.Font.Name = "Arial"
End With
End With
With .Axes(xlValue)
.HasTitle = False
With .TickLabels
.AutoScaleFont = True
.Font.Size = 10
.Font.Name = "Arial"
End With
End With
With .Parent
.Top = 1
.Height = 150
.Width = 350
.Left = Cells(1, intSpalte).Left
End With
End With
Next intSpalte
End Sub


Anzeige
AW: Lösungsvorschlag
05.09.2018 15:27:33
Fred
Hallo Beverly
Der veränderte Code von Dir bewirkt leider nichts . Die Diagramme sehen immer noch so aus wie vorher. Die Formatierungen werden anscheinend nicht übernommen.
Grüße Fred
AW: Lösungsvorschlag
05.09.2018 17:35:21
Beverly
Hi Fred,
gib mal anstelle .Font.Size = 10 dieses an: .Font.Size = 4


AW: Lösungsvorschlag
05.09.2018 21:09:43
Fred
Hallo Beverly
vielen Dank für Deine Geduld. mit Font.Sitz=2 funktionierts prima.
Grüße Fred
Lösungsvorschlag Variante 2
05.09.2018 22:41:18
Beverly
Hi Fred,
schön dass es so jetzt funktioniert, auch wenn mir unklar ist, weshalb die Schriftsgröße auf einen Wert gesetzt werden muss, den es gar nicht gibt.
Ich hätte noch einen anderen Vorschlag und wäre dir dankbar, wenn du den Code bei dir mal testen würdest - rein aus Interesse, ob dieser eventuell das Problem der Schriftgröße umgeht:
Sub DiasErstellen()
Dim intSpalte As Integer
Dim lngLetzte As Long
Dim rngBereich As Range
Dim chrDia As ChartObject
For intSpalte = 1 To 19 Step 9
lngLetzte = Columns(intSpalte).Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rngBereich = Range(Cells(9, intSpalte + 1), Cells(lngLetzte, intSpalte + 5))
With ActiveSheet.ChartObjects.Add(0, 0, 0, 0).Chart
.ChartType = xlColumnStacked100
.SetSourceData Source:=rngBereich
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
With .Parent
.Top = 1
.Height = 150
.Width = 350
.Left = Cells(1, intSpalte).Left
End With
.SeriesCollection(1).XValues = rngBereich.Columns(1).Offset(0, -1)
End With
Next intSpalte
For Each chrDia In ActiveSheet.ChartObjects
With chrDia.Chart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 10
End With
With chrDia.Chart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 10
End With
With chrDia.Chart.Legend.Font
.Name = "Arial"
.Size = 10
End With
Next chrDia
End Sub


Anzeige

90 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige