AW: Combobox auf Userform zum Starten untersch. Ma
20.01.2007 00:56:36
Till
Hallo Sepp,
danke für den letzten Tipp schon mal.
Also weiter unten der Code für eins von den 38 Makros.
Hier der Grund für die Anzahl der Makros.
Ich importiere aus unterschiedlichen Ordnern (je nach Straße) datumsbdingt verschiedene Txt-Dateien. Die Txt-Dateien heißen so wie das Datum, was ich mir jeweils in die Zelle A1 bei Auswahl aus einem Kalendarelement (liegt auch auf der Userform) schreiben lasse.
Bei Auswahl des ersten Straßennames in der Dropdownliste soll also dieser Einlesevorgang stattfinden, und jeweils 5 Diagramme erstellt werden, die man nachher als Image auf der Userform als GIF nacheineinader durchschalten kann. Die reinen Quelldaten dieser jeweiligen Txt-Datei soll außerdem auf einem anderen Karteireiter der Userform in einer Listbox erscheinen.
In der temporär geöffneten Txt-Datei entstehen dabei 2 weitere Mappen "Wertetabelle" und "div_Diagramme", aus der dann die Grafiken und die Quelldaten gelesen werden können.
Tricky ist dabei nur noch, wie ich die temporären Grafiken und Wertetabellen löschen kann, wenn ich dann einen anderen Straßenquerschnitt auswähle, um den selben Prozess zu starten.
Vielleicht wird jetzt alles deutlicher.
Danke schon mal!
Gruß Till
Hier mal der Kram, den ich wohl nicht überall sauber bisher programmiert hab.
Sub Straße1()
On Error Resume Next
Dim subfolder As String
Dim Datum As String
Dim ByI As Byte
subfolder = ("040468FF6A69740E\Linie_0510\")
Datum = Range("a1").Value
' Dateiname 030117_m.xls; JJJJMMTT
Application.ScreenUpdating = False 'hier ggf. abschalten
For ByI = 0 To 0
Workbooks.OpenText Filename:="C:\My Autoscope\Polling Data\" & Format(subfolder) & Format(Datum) & "_" & Format(ByI) & ".txt", DataType:=xlDelimited, semicolon:=True
Next ByI
'Makro zum Einfügen neuer Diagramme nach Importieren von Dateninhalten aus den Pollingdateien
'Namenskonvention 1_1: Makro für Diagramm 1 der 1. Station, 1_2: Makro für Diagramm 2 der 1. Station, 2_1: Makro für Diagramm 1 der 2. Station u.s.w.
Dim objName1_1 As Range
Dim rngF1_1 As Range
Dim rngK1_1 As Range
Dim rngUnion1_1 As Range
'Filtern aktivieren
Columns("D:H").Select
Selection.AutoFilter
'Filter für Spalte E einstellen
Selection.AutoFilter Field:=2 ', Criteria1:="D1*"
Application.SendKeys ("{Down}{Down}{Down}~"), True
'Filter für Spalte H einstellen
Selection.AutoFilter Field:=5, Criteria1:="100"
'Neues Tabellenblatt einfügen und Umbenennen der beiden Blätter
Sheets.Add
With Excel.Application.Worksheets(1)
.Name = "div_Diagramme"
End With
With Excel.Application.Worksheets(2)
.Name = "Wertetabelle"
End With
'Tabelle einfügen
Set objName1_1 = Sheets("Wertetabelle").Range("D10")
Set rngF1_1 = Sheets("Wertetabelle").Range("F5:F22400")
Set rngK1_1 = Sheets("Wertetabelle").Range("K5:K22400")
Set rngUnion1_1 = Application.Union(rngF1_1, rngK1_1)
With Excel.Application.Worksheets("div_Diagramme").ChartObjects.Add _
(Left:=0, Width:=375, Top:=0, Height:=225)
.Chart.SetSourceData Source:=rngUnion1_1
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.ChartArea.AutoScaleFont = False
.HasTitle = True
.ChartTitle.Characters.Text = "Kennlinie Qges" 'objName
.ChartTitle.Font.Bold = True
.ChartTitle.Font.Size = 12
.HasLegend = False
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
With .AxisTitle
.Characters.Text = "Tageszeit [h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
With .AxisTitle
.Characters.Text = "Qges [Kfz/h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
End With
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'hier beginnt der Code für Diagramm2
Dim objName1_2 As Range
Dim rngF1_2 As Range
Dim rngK1_2 As Range
Dim rngUnion1_2 As Range
Sheets("div_Diagramme").Activate
'Tabelle einfügen
Set objName1_2 = Sheets("Wertetabelle").Range("D10")
Set rngF1_2 = Sheets("Wertetabelle").Range("F5:F22400")
Set rngK1_2 = Sheets("Wertetabelle").Range("L5:L22400")
Set rngUnion1_2 = Application.Union(rngF1_2, rngK1_2)
With Excel.Application.Worksheets("div_Diagramme").ChartObjects.Add _
(Left:=375, Width:=375, Top:=0, Height:=225)
.Chart.SetSourceData Source:=rngUnion1_2
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 2").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.ChartArea.AutoScaleFont = False
.HasTitle = True
.ChartTitle.Characters.Text = "Kennlinie Vmittel" 'objName
.ChartTitle.Font.Bold = True
.ChartTitle.Font.Size = 12
.HasLegend = False
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
With .AxisTitle
.Characters.Text = "Tageszeit [h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
With .AxisTitle
.Characters.Text = "Vmittel [km/h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
End With
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'hier beginnt der Code für Diagramm3
Dim objName1_3 As Range
Dim rngF1_3 As Range
Dim rngK1_3 As Range
Dim rngUnion1_3 As Range
Sheets("div_Diagramme").Activate
'Tabelle einfügen
Set objName1_3 = Sheets("Wertetabelle").Range("D10")
Set rngF1_3 = Sheets("Wertetabelle").Range("F5:F22400")
Set rngK1_3 = Sheets("Wertetabelle").Range("V5:V22400")
Set rngUnion1_3 = Application.Union(rngF1_3, rngK1_3)
With Excel.Application.Worksheets("div_Diagramme").ChartObjects.Add _
(Left:=0, Width:=375, Top:=230, Height:=225)
.Chart.SetSourceData Source:=rngUnion1_3
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 3").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.ChartArea.AutoScaleFont = False
.HasTitle = True
.ChartTitle.Characters.Text = "Kennlinie Belegungsgrad" 'objName
.ChartTitle.Font.Bold = True
.ChartTitle.Font.Size = 12
.HasLegend = False
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
With .AxisTitle
.Characters.Text = "Tageszeit [h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
With .AxisTitle
.Characters.Text = "Belegung [-]"
.Font.Size = 10
.Font.Bold = True
End With
End With
End With
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'hier beginnt der Code für Diagramm4
Dim objName1_4 As Range
Dim rngF1_4 As Range
Dim rngK1_4 As Range
Dim rngUnion1_4 As Range
Sheets("div_Diagramme").Activate
'Tabelle einfügen
Set objName1_4 = Sheets("Wertetabelle").Range("D10")
Set rngF1_4 = Sheets("Wertetabelle").Range("F5:F22400")
Set rngK1_4 = Sheets("Wertetabelle").Range("M5:M22400")
Set rngUnion1_4 = Application.Union(rngF1_4, rngK1_4)
With Excel.Application.Worksheets("div_Diagramme").ChartObjects.Add _
(Left:=0, Width:=375, Top:=460, Height:=225)
.Chart.SetSourceData Source:=rngUnion1_4
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 4").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.ChartArea.AutoScaleFont = False
.HasTitle = True
.ChartTitle.Characters.Text = "Kennlinie Verkehrsstärke Pkw" 'objName
.ChartTitle.Font.Bold = True
.ChartTitle.Font.Size = 12
.HasLegend = False
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
With .AxisTitle
.Characters.Text = "Tageszeit [h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
With .AxisTitle
.Characters.Text = "QPkw [Kfz/h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
End With
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'hier beginnt der Code für Diagramm5
Dim objName1_5 As Range
Dim rngF1_5 As Range
Dim rngK1_5 As Range
Dim rngUnion1_5 As Range
' Lkw-Verkehrsstärke berechnen lassen
Sheets("Wertetabelle").Select
'fügt Straßennamen in F1 ein
Range("F1").Select
ActiveCell.FormulaR1C1 = "=LEFT(R[4]C[-2],12)"
Range("A1").Select
'weiter mit Verkehrsstärke Lkw
Range("X5").Select
ActiveCell.FormulaR1C1 = "=RC[-13]-RC[-11]"
Range("X5").Select
Selection.AutoFill Destination:=Range("X5:X22400"), Type:=xlFillDefault
Range("X5:X22400").Select
Sheets("div_Diagramme").Activate
'Tabelle einfügen
Set objName1_5 = Sheets("Wertetabelle").Range("D10")
Set rngF1_5 = Sheets("Wertetabelle").Range("F5:F22400")
Set rngK1_5 = Sheets("Wertetabelle").Range("X5:X22400")
Set rngUnion1_5 = Application.Union(rngF1_5, rngK1_5)
With Excel.Application.Worksheets("div_Diagramme").ChartObjects.Add _
(Left:=375, Width:=375, Top:=460, Height:=225)
.Chart.SetSourceData Source:=rngUnion1_5
.Chart.ChartType = xlXYScatter
End With
'Anwählen des Diagramms
ActiveSheet.ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
'Formatieren der Tabelle
With ActiveChart
.ChartArea.AutoScaleFont = False
.HasTitle = True
.ChartTitle.Characters.Text = "Kennlinie Verkehrsstärke Lkw" 'objName
.ChartTitle.Font.Bold = True
.ChartTitle.Font.Size = 12
.HasLegend = False
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
.MinimumScaleIsAuto = True
.MaximumScale = 1
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
With .AxisTitle
.Characters.Text = "Tageszeit [h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
.HasMajorGridlines = True
.HasMinorGridlines = False
With .AxisTitle
.Characters.Text = "QLkw [Kfz/h]"
.Font.Size = 10
.Font.Bold = True
End With
End With
End With
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
'Abspann
Sheets("div_Diagramme").Select
Range("A1").Select
' letzte Aktualisierung Seiteneinrichtung
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$S$36"
.RightHeader = "Datum: &D" & Chr(10) & "Verkehrsdatenvisualisierung:" & " " & _
Format(Worksheets("Wertetabelle").Range("F1").Value)
.CenterFooter = "Seite: &P"
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.View = xlNormalView
'Lineup der Charts
Dim MyWidth As Single, MyHeight As Single
Dim NumWide As Long
Dim iChtIx As Long, iChtCt As Long
MyWidth = 375 '200
MyHeight = 225 '150
NumWide = 3
iChtCt = ActiveSheet.ChartObjects.Count
For iChtIx = 1 To iChtCt
With ActiveSheet.ChartObjects(iChtIx)
.Width = MyWidth
.Height = MyHeight
.Left = ((iChtIx - 1) Mod NumWide) * MyWidth
.Top = Int((iChtIx - 1) / NumWide) * MyHeight
End With
Next
Application.ScreenUpdating = True
End Sub