Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
772to776
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
772to776
772to776
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dynamische Diagrammerstellung - Problem mit Fokus

Dynamische Diagrammerstellung - Problem mit Fokus
23.06.2006 09:18:51
Till
Hallo Leute,
ich versuche schon seit 3 geschlagenen Tage eine automatisierte Diagrammerstellung durchzuführen. Ich hab zwar schon eine funktionierende Lösung, leider aber noch nicht so dynamisch wie ich mir das vorstelle.
Hier meine Probleme:
1. Problem:
Ich lasse 3 Mal hintereinander aus einer per Browser ausgewählten Datei, die ich gleichzeitig abspeichere, verschiedene Tabellen erstellen, die ich in ein neu generiertes Datenblatt schieben lasse.
Bei jedem neuen Makro zur Erstellung der Tabelle verliert Excel den Fokus auf die richtige Arbeitsmappe. Diesen muss ich ihm (leider nur per Makro-Rekorder herausgefunden) mit folgendem Code wiedergeben:
'Fokus zurück auf Seite
ActiveWindow.Visible = False
Windows("Polling_Data_13.05.2006.xls").Activate
'ThisWorkbook.Activate
Range("H1").Select
Dadurch ist das ganze aber nicht mehr Dynamisch! Kann man das ganze irgendwie umschiffen? Ich will hier keine festen Dateinamen (wie im Code) verwenden, da ich ja per Browseraufruf verschiedene Dateien zum Einlesen und anschließenden Diagrammgenerieren auswählen möchte.
2. Problem:
Gibt es eine Möglichkeit zusätzliche Buttons (oder Scrollbalken oder ähnliches) einzufügen, die die Spalte F (also die Uhrzeit) jeweils so filtert, dass auf ein neues Stundenintervall gefiltert wird. Gleiches gilt für Spalte E, also die Auswahl des Messtages und Spalte D, die Auswahl des Messstandortes?
3. Problem:
Wie kann man durch die Veränderung der Messbasis aus dem 2. Problem, dann automatisch (quasi in einem Rutsch) die Diagrammtitel und Skalierung der Achsen ändern.
Vielen Dank schon mal!
Gruß Till
Und hier der gesamte Code, den ich bisher hab:

Sub auswahl()
ChDrive "C"
ChDir "C:\My Autoscope\Polling Data"
Dim Pfad2$
Pfad2 = Application.GetOpenFilename(fileFilter:="Autoscope Pollingergebnisse (*.xls), *.xls")
If Pfad2 = "Falsch" Then Exit Sub
Workbooks.OpenText Filename:=Pfad2, DataType:=xlDelimited, semicolon:=True
Application.Run "AddChartObject"
End Sub


Sub AddChartObject()
'Makro zum Einfügen neuer Diagramme nach Importieren von Dateninhalten aus den Pollingdateien
Dim objName As Range
Dim rngF As Range
Dim rngK As Range
Dim rngUnion As Range
On Error GoTo Dia_mach_Error
Application.ScreenUpdating = False
'Filtern aktivieren
Columns("D:H").Select
Selection.AutoFilter
'Filter für Spalte E einstellen
Selection.AutoFilter Field:=2 ', Criteria1:="D1*"
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
WaitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait WaitTime
Application.SendKeys ("{Down}{Down}{Down}~"), True
'Filter für Spalte H einstellen
Selection.AutoFilter Field:=5, Criteria1:="100"
'Neues Tabellenblatt einfügen
Sheets.Add
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "div_Diagramme"
With Excel.Application.Worksheets(2)
.Name = "Wertetabelle"
End With
'Tabelle einfügen
Set objName = Sheets("Wertetabelle").Range("D10")
Set rngF = Sheets("Wertetabelle").Range("F5:F3200")
Set rngK = Sheets("Wertetabelle").Range("K5:K3200")
Set rngUnion = Application.Union(rngF, rngK)
With ActiveSheet.ChartObjects.Add _
(Left:=0, Width:=375, Top:=0, Height:=225)
.Chart.SetSourceData Source:=rngUnion
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = objName
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Tageszeit [h]"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Qges [Kfz/h]"
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
'ActiveChart.Legend.Select
'Selection.Position = xlBottom
'ActiveChart.HasDataTable = True
'ActiveChart.DataTable.ShowLegendKey = True
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'Die Kopf- und Fußzeilen des Druckbildes des ersten in der aktuellen Arbeitsmappe
'vorhandenen Diagramms werden modifiziert. Ihnen werden die gleichnamigen uebergebenen
'Parameter zugewiesen.
'Fuer die rechte Kopfzeile wird kein Parameter uebergeben, da sie immer das
'aktuelle Datum und den Namen der durch die Testsequenz erstellten Excel-Datei
'enthalten soll:
With ActiveSheet.PageSetup
.RightHeader = "Datum: &D" & Chr(10) & "Dateiname: " & Dateiname & ".xls"
.CenterFooter = "Seite: &P"
.PrintArea = "$A$1:$M$37"
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = False
End With
'Abspann...
'On Error GoTo 0
'Exit Sub
GoTo Ende
Dia_mach_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") im Makro Dia_mach in Modul1"
Ende:
Application.ScreenUpdating = True
'Fokus zurück auf Seite
ActiveWindow.Visible = False
Windows("Polling_Data_13.05.2006.xls").Activate
'ThisWorkbook.Activate
Range("H1").Select
MsgBox "Das 1. Diagramm ist generiert worden. Bitte bestätigen Sie O.K.", _
vbOKOnly + vbInformation, Title:="Diagramme!"
Application.Wait Now + TimeValue("00:00:01")
Application.Run "dia2"
End Sub


Sub dia2()
Dim objName As Range
Dim rngF As Range
Dim rngK As Range
Dim rngUnion As Range
On Error GoTo Dia_mach_Error
Application.ScreenUpdating = False
Sheets("div_Diagramme").Activate
'Tabelle einfügen
Set objName = Sheets("Wertetabelle").Range("D10")
Set rngF = Sheets("Wertetabelle").Range("F5:F3200")
Set rngK = Sheets("Wertetabelle").Range("L5:L3200")
Set rngUnion = Application.Union(rngF, rngK)
With ActiveSheet.ChartObjects.Add _
(Left:=375, Width:=375, Top:=0, Height:=225)
.Chart.SetSourceData Source:=rngUnion
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 2").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = objName
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Tageszeit [h]"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Vmittel [km/h]"
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
'ActiveChart.Legend.Select
'Selection.Position = xlBottom
'ActiveChart.HasDataTable = True
'ActiveChart.DataTable.ShowLegendKey = True
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'Abspann...
'On Error GoTo 0
'Exit Sub
GoTo Ende
Dia_mach_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") im Makro Dia_mach in Modul1"
Ende:
Application.ScreenUpdating = True
'Fokus zurück auf Seite
ActiveWindow.Visible = False
Windows("Polling_Data_13.05.2006.xls").Activate
'ThisWorkbook.Activate
Range("H1").Select
'MsgBox "Das 2. Diagramm ist generiert worden. Bitte bestätigen Sie O.K.", _
'vbOKOnly + vbInformation, Title:="Diagramme!"
Application.Wait Now + TimeValue("00:00:01")
Application.Run "dia3"
End Sub


Sub dia3()
Dim objName As Range
Dim rngF As Range
Dim rngK As Range
Dim rngUnion As Range
On Error GoTo Dia_mach_Error
Application.ScreenUpdating = False
Sheets("div_Diagramme").Activate
'Tabelle einfügen
Set objName = Sheets("Wertetabelle").Range("D10")
Set rngF = Sheets("Wertetabelle").Range("F5:F3200")
Set rngK = Sheets("Wertetabelle").Range("V5:V3200")
Set rngUnion = Application.Union(rngF, rngK)
With ActiveSheet.ChartObjects.Add _
(Left:=0, Width:=375, Top:=230, Height:=225)
.Chart.SetSourceData Source:=rngUnion
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 3").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = objName
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Tageszeit [h]"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Belegung [-]"
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
'ActiveChart.Legend.Select
'Selection.Position = xlBottom
'ActiveChart.HasDataTable = True
'ActiveChart.DataTable.ShowLegendKey = True
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'Abspann...
'Fokus zurück auf Seite
ActiveWindow.Visible = False
Windows("Polling_Data_13.05.2006.xls").Activate
'ThisWorkbook.Activate
Range("H1").Select
'Seitenumbrüche final einrichten
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
'formatieren und speichern
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\My Autoscope\Polling Data\Diagramme_" & Sheets("Wertetabelle").Range("E5") & ".xls", FileFormat:=xlNormal, CreateBackup:=False
ActiveWorkbook.Saved = True
Application.DisplayAlerts = True
' Ende formatieren und speichern
MsgBox "Die erforderlichen Diagramme sind generiert worden und unter C:\My Autoscope\Polling Data abrufbar!", _
vbOKOnly + vbInformation, Title:="Diagramme!"
ActiveWorkbook.Close
On Error GoTo 0
Exit Sub
Dia_mach_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") im Makro Dia_mach in Modul1"
Application.ScreenUpdating = True
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dynamische Diagrammerstellung - Problem mit Fo
25.06.2006 17:34:17
fcs
Hallo Till,
zu deinem Problem Nr. 1:
Den Namen der Datei, der du den Fokus zurückgeben möchtest kannst du etwa nach folgendem Schema speichern und wieder aufrufen.

Public Dateiname As String
Sub test()
'Code zum Öffnen der Datei z.B.: Polling_Data_13.05.2006.xls
'Falls die Zurück-Datei die Datei ist, die zum Zeitpunkt des Makro-Starts aktiv ist
'dann nachfolgende Zeile nach den Variablen-Deklarationen einfügen.
Dateiname = ActiveWorkbook.Name
'... weiterer Coce
Windows(Dateiname).Activate
Range("H1").Select
'... weiterer Coce
End Sub
Sub test1()
'... weiterer Coce
'Fokus zurück auf Seite
Windows(Dateiname).Activate
Range("H1").Select
'... weiterer Coce
End Sub

Problem Nr. 2 und 3: grundsätzlich machbar erfordert aber etwas mehr Detailkenntnisse zu den Tabellen und Diagrammen, die jeweils betroffen sind. Mir persönlich sträuben sich halt nur immer die Nackenhaare, wenn es darum geht per Makro Datum oder Zeitangaben zu filtern, weil sich Excel mit der Behandlung von Datums-/Zeitangaben leider etwas schwer. tut.
mfg
Franz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige