Top-Themen

Aktuelle Themen (A bis Z)

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

Frage Entwicklung VB for Applications

GELÖST

Automatisiertes Erstellen von Exceldiagrammen

Mitglied: ShitzOvran

ShitzOvran (Level 1) - Jetzt verbinden

13.01.2011, aktualisiert 10:17 Uhr, 5149 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 ..
Ähnliche Inhalte
Windows 10
Automatisiert batch-Dateien erstellen
Frage von ScripterWindows 101 Kommentar

Hallo, bei Win 10 ist es möglich über Verknüpfungen im Startmenü mithilfe der Assistentin Cortana PROGRAMME per Sprachsteuerung zu ...

Microsoft
Neue Dateiendung in Registry erstellen (automatisiert)
gelöst Frage von testLXMicrosoft8 Kommentare

Hallo Ich habe ein Programm geschrieben, dass ".pm" Datei erstellt. Ich möchte, dass wenn man auf die Datei klickt, ...

Batch & Shell
Skript - automatisiert Fotos von Videos erstellen
gelöst Frage von SchnoedlBatch & Shell5 Kommentare

Hallo, ich bräuchte wieder einmal eure Hilfe. Ich habe einige Videos (.mp4) in mehreren Unterzeichnissen abgespeichert. Ist es möglich ...

Windows Server
Automatisiertes Löschen
gelöst Frage von Jabberwocky86Windows Server6 Kommentare

Hallo Zusammen Ich habe auf dem Fileserver eine Freigabe, welche für alle zugänglich ist. Nun möchte ich dass der ...

Neue Wissensbeiträge
Linux

Meltdown und Spectre: Linux Update

Information von Frank vor 1 TagLinux

Meltdown (Variante 3 des Prozessorfehlers) Der Kernel 4.14.13 mit den Page-Table-Isolation-Code (PTI) ist nun für Fedora freigegeben worden. Er ...

Tipps & Tricks

Solutio Charly Updater Fehlermeldung: Das Abgleichen der Dateien in -Pfad- mit dem Datenobject ist fehlgeschlagen

Tipp von StefanKittel vor 2 TagenTipps & Tricks

Hallo, hier einmal als Tipp für alle unter Euch die mit der Zahnarztabrechnungssoftware Charly von Solutio zu tun haben. ...

Sicherheit

Meltdown und Spectre: Wir brauchen eine "Abwrackprämie", die die CPU-Hersteller bezahlen

Information von Frank vor 2 TagenSicherheit12 Kommentare

Zum aktuellen Thema Meltdown und Spectre: Ich wünsche mir von den CPU-Herstellern wie Intel, AMD oder ARM eine Art ...

Sicherheit

Meltdown und Spectre: Realitätscheck

Information von Frank vor 2 TagenSicherheit10 Kommentare

Die unangenehme Realität Der Prozessorfehler mit seinen Varianten Meltdown und Spectre ist seit Juni 2017 bekannt. Trotzdem sind immer ...

Heiß diskutierte Inhalte
Batch & Shell
Meltdown Microsoft Prüf Script - .zip Datei leider leer
gelöst Frage von MasterBlaster88Batch & Shell13 Kommentare

Hallo zusammen, ich patche gerade unsere Windows Server bzgl. der Meltdown Lücke. Patch vorhanden, Reg Keys gesetzt Um das ...

Batch & Shell
Shell-Skript - Syntax error: Unterminated quoted string
Frage von newit1Batch & Shell13 Kommentare

Hallo Ich schreibe ein Skript das eine CSV-Datei in eine mySQL Datenbank schieben soll. Bekomme nach start des Skrips ...

E-Mail
Erfahrungen mit hMailServer gesucht
Frage von it-fraggleE-Mail10 Kommentare

Hallo, meine neue Stelle möchte einen eigenen Mailserver. Ich als Linuxkind war direkt geistig mit Postfix dabei. Leider wollen ...

Entwicklung
VBS: alle PDF-Dateien in einem Ordner gleichzeitig öffnen
gelöst Frage von JuweeeEntwicklung9 Kommentare

Hallo, ich habe in deiner Ordnerstruktur (.\Tagesberichte\xx.18\) mehrere dynamische PDF-Formulare (mit LCD erstellt). Die Berichtsformulare sind im Layout alle ...