AW: Wie Userform nach Absturz neuladen?
12.01.2007 09:38:25
Till
Hallo Leute,
sorry dass ich jetzt erst antworte.
Den Tipp von Rainer hatte ich auch mal berücksichtigt...leider mit dem gleichen Ergebnis.
Die Programmierung sah da so aus.
Private Sub UserForm_activate()
On Error Resume Next
Dim intCounter As Integer
'Dim intSheetCounter As Integer
'Laden der Wertetabelle in Listbox
Dim AM As Object ' Arbeitsmappe als Objekt
Me.ListBox1.Clear ' Leeren der Listbox, falls vorher gefüllt
ListBox1.ColumnCount = 8
'Zuweisen der Spaltenbreite in Pt
'1 cm ~ 28,3 Pt
Me.ListBox1.ColumnWidths = "0; 0; 0; 80; 80; 80; 80; 80" ' Bestimmung der Spaltenbreite
'For intSheetCounter = 1 To 1 'Worksheets.Count
For Each AM In Application.Workbooks ' suche geöffnete Arbeitsmappen
With Sheets("Wertetabelle")
For intCounter = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(intCounter, 1) <> "" Then
ListBox1.AddItem .Cells(intCounter, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(intCounter, 2).Value
' Ab hier kann beliebig ergänzt werden. Bitte Nummerierung beachten.
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(intCounter, 3).Value
ListBox1.List(ListBox1.ListCount - 1, 3) = .Cells(intCounter, 4).Value
ListBox1.List(ListBox1.ListCount - 1, 4) = .Cells(intCounter, 5).Value
ListBox1.List(ListBox1.ListCount - 1, 5) = .Cells(intCounter, 6).Value
ListBox1.List(ListBox1.ListCount - 1, 6) = .Cells(intCounter, 7).Value
ListBox1.List(ListBox1.ListCount - 1, 7) = .Cells(intCounter, 8).Value
ListBox1.List(ListBox1.ListCount - 1, 8) = .Cells(intCounter, 10).Value
End If
Next intCounter
End With
'Next intSheetCounter
Next AM
End Sub
Aber ich glaube, dass das Problem doch wo anders liegt.
Ich hab da letzte Nacht noch mal drüber nachgedacht. Und zwar wird das Tabellenblatt "Wertetabelle" durch meine Combobox-Auswahl erst generiert.
Das was da dann abläuft hat folgenden Hintergrund. Ich muss Daten aus Variablen txt.-Dateien auslesen. Und je nach Auswahl des Namens aus der Combobox, soll automatisch die richtige Datei aus dem richtigen Ordner eingelesen werden und die entsprechenden Diagramme generiert werden. Natürlich auch mit dem richtigen Datum, das man per Kalendar-Element auswählen muss, wodurch in A1 das gewählte Datum eingetragen wird und dieses dann für den Namen der zu importierenden Txt-Datei genommen wird.
Die Wertetabelle lass ich dann in der Listbox der Userform anzeigen und die Diagramme als temporäre GIFs in einem Bildelelement der selben Userform
Hier der Code (nur für eine Messstelle, da kommen noch 37 andere, also 37x der ähnliche Code zusätzlich)
Private Sub ComboBox2_Change()
'Dropdown für Straße
'On Error Resume Next
Select Case ComboBox2.Value
Case "VDe 11-01-A1/Joseph-Beuys-Ufer"
Dim subfolder As String
Dim Datum As String
Dim ByI As Byte
subfolder = ("040468FF6A69740E\Linie_0510\")
Datum = ActiveSheet.Range("A1").Value 'Datum = Range("a1").Value
' Dateiname 030117_m.xls; JJJJMMTT
Application.ScreenUpdating = False 'hier ggf. abschalten
For ByI = 0 To 0
'Workbooks.Open Filename:="C:\My Autoscope\Polling Data\" & Format(subfolder) & Format(Datum) & "_" & Format(ByI) & ".txt" '& "_1.txt" & "_2.txt"
'Next ByI
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
'On Error GoTo Dia_mach_Error1_1
'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 ActiveSheet.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
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = "Kennlinie Qges" '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
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
GoTo Ende1_1
'Dia_mach_Error1_1:
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") im Makro Dia_mach in Modul1"
Ende1_1:
'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
'On Error GoTo Dia_mach_Error1_2
'Application.ScreenUpdating = False
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 ActiveSheet.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
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = "Kennlinie Vmittel" '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
'Überschrift in 12er Fettschrift
ActiveSheet.ChartObjects("Diagramm 2").Activate
ActiveChart.ChartTitle.Select
Selection.Font.Bold = True
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
GoTo Ende1_2
'Dia_mach_Error1_2:
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") im Makro Dia_mach in Modul1"
Ende1_2:
Sheets("Wertetabelle").Select
Application.Wait Now + TimeValue("00:00:01")
'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
'On Error GoTo Dia_mach_Error1_3
'Application.ScreenUpdating = False
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 ActiveSheet.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
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = "Kennlinie Belegungsgrad" '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
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
GoTo Ende1_3
'Dia_mach_Error1_3:
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") im Makro Dia_mach in Modul1"
Ende1_3:
Sheets("Wertetabelle").Select
Application.Wait Now + TimeValue("00:00:01")
'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
'On Error GoTo Dia_mach_Error1_4
'Application.ScreenUpdating = False
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 ActiveSheet.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
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = "Kennlinie Verkehrsstärke Pkw" '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 = "Qpkw [Kfz/min]"
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
'Keine Hintergrundfarbe im Diagramm:
With Excel.Application
.ActiveChart.PlotArea.Select
.Selection.Interior.ColorIndex = xlNone
End With
GoTo Ende1_4
'Dia_mach_Error1_4:
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") im Makro Dia_mach in Modul1"
Ende1_4:
Sheets("Wertetabelle").Select
'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
'On Error GoTo Dia_mach_Error1_5
'Application.ScreenUpdating = False
' 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 ActiveSheet.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
.HasTitle = True
'.ChartTitle.Characters.Text = "Darstellung der Verkehrskenngrößen "
.ChartTitle.Characters.Text = "Kennlinie Verkehrsstärke Lkw" '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 = "Qlkw [Kfz/min]"
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
'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
ActiveSheet.PageSetup.PrintArea = "$A$1:$S$36"
With ActiveSheet.PageSetup
.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
'Code für nächste Messstelle....nach Auswahl in Combobox
Case "VDe 16-01-C1-MD/Rheinufertunnel Einf."
'u.s. w. (analog zu oben)
Hoffe das ganze macht alles ein wenig deutlicher! Ich weiß, dass man den Code irgendwie schlanker gestalten könnte, leider fehlt mir die Zeit...
Vielleicht kommt dadurch der Fehler zustande?
Hoffe, Ihr könnt mir helfen?
Danke!
Gruß Till