Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Automatisiertes Erstellen von Exceldiagrammen

Frage Entwicklung VB for Applications

Mitglied: ShitzOvran

ShitzOvran (Level 1) - Jetzt verbinden

13.01.2011, aktualisiert 10:17 Uhr, 4896 Aufrufe, 5 Kommentare

ein freundliches Hallo an die SpezialistenInnen hier im Forum
ich suche eine Möglichkeit Diagramme in Excel automatisiert erstellen zu lassen

Wie ihr in der angehängten Datei zu erkennen, habe ich eine Tabelle, in der die Felder "Person", "KW" und verschiedene Stati bereitgestellt werden.

9647324cbeb10ca5222ec3a62258e1fa - Klicke auf das Bild, um es zu vergrößern

Anhand dieser Tabelle, sollen Diagramme erstellt werden, die dann untereinander auf unterschiedlichen Datenblättern liegen.
1a8f9ac99029a9ccf079d294fe5977c6 - Klicke auf das Bild, um es zu vergrößern
213da83d20c690b4ba7a0258d83ac1c2 - Klicke auf das Bild, um es zu vergrößern

Auf welchen Tabellenblatt das Diagramm erstellt werden soll, wird anhand eines Indikator festgestellt ("O" für Sheet "OST", "W" für "WEST"). die anzahl der Personen kann variieren. die Anzahl der Kalenderwochen ist immer gleich (hier exemplarisch 4 Wochen).
e19b4b651537034827b44ba529674413 - Klicke auf das Bild, um es zu vergrößern

Habt ihr irgendeine Idee wie man das angehen kann? leider kenn ich mich mit VBA und Diagrammerstellung in Excel überhaupt nicht aus und wichtig ist natürlich auch noch, wie man es schafft, dass er verschieden viele Diagramme untereinander erstellt. Aufgeteilt in die einzelnen Personen...

hoffe ihr könnt mir helfen, bzw mal die Basics zum Diagramm erstellen über VBA nahebringen

roxxYOURsoxx
Mitglied: 76109
14.01.2011 um 10:05 Uhr
Hallo ShitzOvran!

Um Dich VBA etwas näher zu bringen, sind Charts als Einstieg wohl kaum zu empfehlen. Charts sind etwas eigen, sowohl in der Objekte-Zusammensetzung, als auch in der Code-Steuerung.

In Deinem Fall sollte es allerdings noch relativ einfach gehen.

Schritt 1: Erstelle eine Chart-Vorlage nach Deinen Wünschen in einer seperaten Tabelle mit dem Namen "Chart" (eventuell mit einem Dummy-Datensatz)
Schritt 2: Tabellenblatt "Chart" ausblenden (Format>Blatt>Ausblenden)
Schritt 3: Diesen Code im VB-Editor in ein Modul kopieren:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SheetChart0 = "Chart"     'Tabelle - Chart-Vorlage 
05.
Const SheetChart1 = "Ost"       'Tabelle - Chart1, Buchstabenkürzel Left(1) 
06.
Const SheetChart2 = "West"      'Tabelle - Chart2, Buchstabenkürzel Left(1) 
07.
 
08.
Const SheetDaten = "Daten"      'Tabelle - ChartX-Daten 
09.
 
10.
Const DatenStart = 2            'Daten - Ab Zeile x 
11.
Const DatenInterval = 4         'Daten - Anzahl Zeilen (KW's) 
12.
 
13.
Const ColSheet = 1              'Daten - Spalte Sheet-Kürzel ChartX 
14.
Const ColName = 2               'Daten - Spalte Person/Name 
15.
 
16.
Sub CreateCharts() 
17.
    Dim SheetChartX As String, i As Long 
18.
     
19.
    ThisWorkbook.Activate                               'Diese Arbeitsmappe aktivieren 
20.
     
21.
    Application.ScreenUpdating = False                  'Bildschirmaktualisierung Aus 
22.
     
23.
    Sheets(SheetChart1).ChartObjects.Delete             'Alle Charts entfernen in Sheet-Ost 
24.
    Sheets(SheetChart2).ChartObjects.Delete             'Alle Charts entfernen in Sheet-West 
25.
 
26.
    With Sheets(SheetDaten)                             'Datenblöcke auswerten 
27.
        For i = DatenStart To .Cells(.Rows.Count, ColName).End(xlUp).Row Step DatenInterval 
28.
            If .Cells(i, ColSheet) Like Left(SheetChart1, 1) Then 
29.
                SheetChartX = SheetChart1               'Sheet Chart-Ost 
30.
            Else 
31.
                SheetChartX = SheetChart2               'Sheet Chart-West 
32.
            End If 
33.
             
34.
            Call SetNewChart(SheetChartX, .Cells(i, ColName)) 
35.
        Next 
36.
    End With 
37.
 
38.
    Application.ScreenUpdating = True                   'Bildschirmaktualisierung Ein 
39.
End Sub 
40.
 
41.
Private Sub SetNewChart(ByRef SheetChartX, ByRef RngName) 
42.
    Dim ChartTop As Double, i As Long 
43.
     
44.
    With Sheets(SheetChartX).ChartObjects               'With Chart-Objecte 
45.
        If .Count = 0 Then                              'Wenn Zähler Chart-Objecte = 0 
46.
            ChartTop = 0                                'Dann Chart-Position = Top 0 
47.
        Else 
48.
            With .Item(.Count).BottomRightCell          'Sonst Chart-Positionen ermitteln 
49.
                ChartTop = .Top + .Height               'Sonst Chart-Position = Top X 
50.
            End With 
51.
        End If 
52.
         
53.
        Sheets(SheetChart0).ChartObjects(1).Copy:  .Parent.Paste    'Chart-Vorlage nach Ziel kopieren 
54.
         
55.
        With .Item(.Count).Chart                        'With New-Chart-Object 
56.
            .Parent.Top = ChartTop:  .Parent.Left = 0   'Chart-Position X setzen 
57.
            .ChartTitle.Characters.Text = RngName.Text  'Chart-Titel setzen 
58.
             
59.
             For i = 1 To 3                             'Chart-Datenreihen setzen 
60.
                .SeriesCollection(i).Values = RngName.Offset(0, i + 1).Resize(DatenInterval, 1) 
61.
             Next 
62.
                                                        'Chart-X-Achse (KW's) setzen 
63.
            .SeriesCollection(1).XValues = RngName.Offset(0, 1).Resize(DatenInterval, 1) 
64.
        End With 
65.
    End With 
66.
End Sub
Die Konstanten bei Bedarf entsprechend anpassen.

Vorzugsweise würde ich im Tabellenblatt "Daten" einen Button einfügen, der das Makro "CreateCharts" startet. Ansonsten über Makro/Tastenkombination oder wie auch immer.

Probiers mal aus!

Gruß Dieter

PS. Das Tabellenkürzel und der Personenname, muss nur 1 mal in der ersten Zeile eines Datensatzes stehen. In Deinem Beispiel also in Zeile 2, 6, 10 und 14
Bitte warten ..
Mitglied: ShitzOvran
22.03.2011 um 16:23 Uhr
Hey Hallo nocheinmal,

das script is soweit angepasst und läuft eigentlich seit einigen Wochen erfolgreich.
Jetzt habe ich aber das Problem, dass das Skript nach zB 64 durchgängen einfach aufhört und Fehler ausspuckt

01.
Laufzeitfehler '1004': 
02.
 
03.
Microsoft Excel kann die Daten  nicht einfügen
er bleibt dann hängen, wenn versucht wird das Diagramm als Vorlage einzufügen... Es scheint so, als gäbe es einen Überlauf oÄ

kann man da irgendwie was machen?

best regards
...
Bitte warten ..
Mitglied: 76109
23.03.2011 um 10:50 Uhr
Hallo ShitzOvran!

Bei meinen Tests, ist bei mir ebenfalls der besagte Fehler aufgetreten. Eine Erklärung habe ich dafür allerdings nicht gefunden. Von daher neuer Versuch mit Plan B, wobei die Charts jetzt neu erstellt und nicht mehr kopiert werden

Anmerkungen:
Um eventuelle Seiteneffekte durch den alten VBA-Code auszuschließen, müssen die Tabellenblätter 'Ost' und 'West' gelöscht und neu erstellt werden.
Das Tabellenblatt mit der Chart-Vorlage wird natürlich nicht mehr benötigt.
Ausserdem sind neue Konstannten hinzugekommen: Breite, Höhe, Datenreihen-Text und Datenreihen-Farbe.

Hier der neue Code (getestet mit ca 650 Charts pro Ost/West):
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SheetChart1 = "Ost"       'Tabelle - Chart1, Buchstabenkürzel Left(1) 
05.
Const SheetChart2 = "West"      'Tabelle - Chart2, Buchstabenkürzel Left(1) 
06.
 
07.
Const SheetDaten = "Daten"      'Tabelle - ChartX-Daten 
08.
 
09.
Const DatenStart = 2            'Daten - Ab Zeile x 
10.
Const DatenInterval = 4         'Daten - Anzahl Zeilen (KW's) 
11.
 
12.
Const ColSheet = 1              'Daten - Spalte Sheet-Kürzel ChartX 
13.
Const ColName = 2               'Daten - Spalte Person/Name 
14.
 
15.
Const ChartWidth = 450          'Chart-Breite 
16.
Const ChartHeight = 293.25      'Chart-Höhe 
17.
 
18.
Const ColorD = 45               'Farbe Spalte D 
19.
Const ColorE = 36               'Farbe Spalte E 
20.
Const ColorF = 11               'Farbe Spalte F 
21.
 
22.
Const TextC = "Kalenderwochen"  'Text Spalte C 
23.
Const TextD = "OFFEN"           'Text Spalte D 
24.
Const TextE = "in Bearbeitung"  'Text Spalte E 
25.
Const TextF = "Geschlossen"     'Text Spalte F 
26.
 
27.
Sub CreateCharts() 
28.
    Dim SheetChartX As String, i As Long 
29.
     
30.
    ThisWorkbook.Activate                               'Diese Arbeitsmappe aktivieren 
31.
     
32.
    Application.ScreenUpdating = False                  'Bildschirmaktualisierung Aus 
33.
     
34.
    Sheets(SheetChart1).ChartObjects.Delete             'Alle Charts entfernen in Sheet-Ost 
35.
    Sheets(SheetChart2).ChartObjects.Delete             'Alle Charts entfernen in Sheet-West 
36.
 
37.
    With Sheets(SheetDaten)                             'Datenblöcke auswerten 
38.
        For i = DatenStart To .Cells(.Rows.Count, ColName).End(xlUp).Row Step DatenInterval 
39.
            If .Cells(i, ColSheet) Like Left(SheetChart1, 1) Then 
40.
                SheetChartX = SheetChart1               'Sheet Chart-Ost 
41.
            Else 
42.
                SheetChartX = SheetChart2               'Sheet Chart-West 
43.
            End If 
44.
             
45.
            Call SetNewChart(SheetChartX, .Cells(i, ColName)) 
46.
        Next 
47.
    End With 
48.
 
49.
    Application.ScreenUpdating = True                   'Bildschirmaktualisierung Ein 
50.
End Sub 
51.
 
52.
Private Sub SetNewChart(ByRef SheetChartX, ByRef RngName) 
53.
    Dim ChartTop As Double, i As Long 
54.
     
55.
    With Sheets(SheetChartX).ChartObjects 
56.
        If .Count = 0 Then 
57.
            ChartTop = 0 
58.
        Else 
59.
            With .Item(.Count).BottomRightCell 
60.
                ChartTop = .Top + .Height 
61.
            End With 
62.
        End If 
63.
         
64.
        With .Add(Top:=ChartTop, Left:=0, Height:=ChartHeight, Width:=ChartWidth).Chart 
65.
            .ChartType = xlColumnStacked 
66.
             
67.
             For i = 1 To 3 
68.
                .SeriesCollection.NewSeries 
69.
                .SeriesCollection(i).Name = Array("", TextD, TextE, TextF)(i) 
70.
                .SeriesCollection(i).Values = RngName.Offset(0, i + 1).Resize(DatenInterval, 1) 
71.
                .SeriesCollection(i).Interior.ColorIndex = Array("", ColorD, ColorE, ColorF)(i) 
72.
             Next 
73.
              
74.
            .SeriesCollection(1).XValues = RngName.Offset(0, 1).Resize(DatenInterval, 1) 
75.
             
76.
            .HasTitle = True 
77.
            .ChartTitle.Characters.Text = RngName.Text 
78.
            .Axes(xlCategory, xlPrimary).HasTitle = True 
79.
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = TextC 
80.
        End With 
81.
    End With 
82.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: ShitzOvran
25.03.2011 um 13:46 Uhr
Hallihallo,
Das klappt ganz gut, leider ist natürlich dadurch die Elegance verloren gegangen, dass auch normale User diese Funktionalität ohne VBA-Wissen nutzen können. das erstellen eines Vorlagediagramms wäre schon schön.

in erster Linie interessiert mich allerdings, warum es zu solch einem Fehler kommt und ob man das vllt irgendwie umgehen kann, indem man zwischendruch irgendeinen Cache leeren kann oder ähnliches...

LG
Bitte warten ..
Mitglied: 76109
26.03.2011 um 15:39 Uhr
Hallo ShitzOvran!

Na, dann eben so
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const SheetChart0 = "Chart"     'Tabelle - Chart-Vorlage 
05.
Const SheetChart1 = "Ost"       'Tabelle - Chart1, Buchstabenkürzel Left(1) 
06.
Const SheetChart2 = "West"      'Tabelle - Chart2, Buchstabenkürzel Left(1) 
07.
 
08.
Const SheetDaten = "Daten"      'Tabelle - ChartX-Daten 
09.
 
10.
Const DatenStart = 2            'Daten - Ab Zeile x 
11.
Const DatenInterval = 4         'Daten - Anzahl Zeilen (KW's) 
12.
 
13.
Const ColSheet = 1              'Daten - Spalte Sheet-Kürzel ChartX 
14.
Const ColName = 2               'Daten - Spalte Person/Name 
15.
 
16.
Sub CreateCharts() 
17.
    Dim i As Long 
18.
     
19.
    ThisWorkbook.Activate                               'Diese Arbeitsmappe aktivieren 
20.
     
21.
    With Application 
22.
        .StatusBar = "Diagramme werden erstellt..." 
23.
        .ScreenUpdating = False                         'Bildschirmaktualisierung Aus 
24.
    End With 
25.
     
26.
    Sheets(SheetChart1).ChartObjects.Delete             'Alle Charts entfernen in Sheet-Ost 
27.
    Sheets(SheetChart2).ChartObjects.Delete             'Alle Charts entfernen in Sheet-West 
28.
 
29.
    With Sheets(SheetChart0) 
30.
        .Visible = xlSheetVisible                       'Vorlage-Sheet einblenden 
31.
        .ChartObjects(1).Activate                       'Vorlage-Chart aktivieren/selektieren 
32.
    End With 
33.
     
34.
    With Sheets(SheetDaten)                             'Datenblöcke auswerten 
35.
        For i = DatenStart To .Cells(.Rows.Count, ColName).End(xlUp).Row Step DatenInterval 
36.
            If .Cells(i, ColSheet) Like Left(SheetChart1, 1) Then 
37.
                Call SetNewChart(SheetChart1, .Cells(i, ColName)) 
38.
            Else 
39.
                Call SetNewChart(SheetChart2, .Cells(i, ColName)) 
40.
            End If 
41.
        Next 
42.
    End With 
43.
 
44.
    Sheets(SheetChart0).Visible = xlSheetHidden         'Vorlage-Sheet ausblenden 
45.
     
46.
    With Application 
47.
        .StatusBar = False                              'StatusBar "Bereit" 
48.
        .CutCopyMode = False                            'Kopiermodus aufheben/Zwischenablage leeren 
49.
        .ScreenUpdating = True                          'Bildschirmaktualisierung Ein 
50.
    End With 
51.
End Sub 
52.
 
53.
Private Sub SetNewChart(ByRef SheetChartX, ByRef RngName) 
54.
    Dim ChartTop As Double, i As Long, x 
55.
     
56.
    With Sheets(SheetChartX).ChartObjects               'With Chart-Objecte 
57.
        If .Count = 0 Then                              'Wenn Zähler Chart-Objecte = 0 
58.
            ChartTop = 0                                'Dann Chart-Position = Top 0 
59.
        Else 
60.
            With .Item(.Count).BottomRightCell          'Sonst Chart-Positionen ermitteln 
61.
                ChartTop = .Top + .Height               'Sonst Chart-Position = Top X 
62.
            End With 
63.
        End If 
64.
        
65.
        Selection.Copy: .Parent.Paste                   'Chart-Vorlage nach Ziel kopieren 
66.
        
67.
        With .Item(.Count).Chart                        'With New-Chart-Object 
68.
            .Parent.Top = ChartTop:  .Parent.Left = 0   'Chart-Position X setzen 
69.
            .ChartTitle.Characters.Text = RngName.Text  'Chart-Titel setzen 
70.
             
71.
             For i = 1 To 3                             'Chart-Datenreihen setzen 
72.
                .SeriesCollection(i).Values = RngName.Offset(0, i + 1).Resize(DatenInterval, 1) 
73.
             Next 
74.
             
75.
            .SeriesCollection(1).XValues = RngName.Offset(0, 1).Resize(DatenInterval, 1) 
76.
        End With 
77.
    End With 
78.
End Sub
Gruß Dieter
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Netzwerkgrundlagen
IPsec - .conf und .secret erstellen aus Gruppe und User (16)

Frage von MaxMLe zum Thema Netzwerkgrundlagen ...

RedHat, CentOS, Fedora
gelöst Erstellen von Desktopverknüpfungen und Anpassung der Taskleiste (2)

Frage von honeybee zum Thema RedHat, CentOS, Fedora ...

Vmware
ESXI Template erstellen (2)

Frage von Phill93 zum Thema Vmware ...

Batch & Shell
Ordner erstellen ll Datei hinein kopieren (1)

Frage von heyalice zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (20)

Frage von Xaero1982 zum Thema Microsoft ...

Outlook & Mail
gelöst Outlook 2010 findet ost datei nicht (19)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...