Office: (Office 2003) Und Oder Gleich

sw-blitz007 · 26. Februar 2011

Wo wird denn ein Fehler gemeldet?
Oder habe ich da etwas übersehen, wo Du den Fehler kennzeichnest?
Ansonsten gilt immer noch #15 für Deinen Spaghetticode *tongue.gif*

ebs17 · 26. Februar 2011

aber ich bekomme immer wieder andere Fehler
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie kann das sein, wenn Du doch mit einem mehrfachen On Error Resume Next konsequent versuchst, Fehler zu ignorieren?
Wenn Vogel Strauß den Kopf in den Sand steckt, dann sieht er NICHTS.

Konsequent wäre dann vielleicht ein
Code:

On Error Application.Quit
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

hcscherzer · 26. Februar 2011

Siehe auch hier.

Erich290607 · 26. Februar 2011

Hallo Michael,

mittlerweile fülle ich die Tabs in Excel je Blatt eine Woche, doch bin ich immer noch am Basteln wie ich denn das Suchen Ergebnis aus der ListView bekomme. Doch bin ich mir auch nicht mehr ganz sicher ob Excel hier das richtige Werkzeug ist aufgrund der "Zeilenbegrenzung" hatte ich für das Jahr 2009 eine Meldung von Excel erhalten
vieleicht wäre es doch besser die daten in eine temporäre Tabelle zu speichern ? *eek.gif*

Code:

Dim db As DAO.Database
Dim Suchbegriffe() As String
Dim strOperator As String
Dim strSQL As String
Dim i As Integer
Dim strKriterium As String
Dim strSuchbegriffe() As String
Dim rsID As DAO.Recordset
Dim rsDat As DAO.Recordset
Dim oXL As Object
Dim oWb As Object
Dim oSh As Object
Dim t As Long
Dim Start As Long
Dim lZeile2 As Integer
Dim lngJNummer As Long
Dim Mysql As String
Dim DATNA As String
Dim FELDNA As String
Dim tmp, TTD, Addr, rs As DAO.Recordset, _
TransP As Boolean, j As Long, B As Long, St As Long

lngJNummer = InputBox("Bitte geben Sie das Jahr an, welches ausgewertet werden soll", "Schichtbuchdaten")

On Error Resume Next
Me!DATEINAME2 = Application.CurrentProject.path & "\Schichtbuchdaten.xls"
'//DATNA = "Lagerort Halle-6"

Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Add
oXL.Visible = True
On Error Resume Next
Me!DATEINAME2 = "\\SB\Bereich05\SB_Ergebniss.xls"
'//DATNA = "SB_GC"
Set oExcel = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set oExcel = CreateObject("Excel.Application")
End If

Set db = CurrentDb
Set rsID = db.OpenRecordset("SELECT abf_YW.KW, abf_YW.J " & _
" FROM abf_YW " & _
" WHERE abf_YW.J =" & lngJNummer, dbOpenForwardOnly)

'Do While Not rsID.EOF

'Set oSh = oWb.Worksheets.Add
'oSh.Name = rsID.Fields(0) 'Tabellenblatt Jahr + Woche

With rsID
Do While Not .EOF

On Error GoTo 0
If Len(Nz(Me.txtSuchbegriffe, "")) > 0 Then
Set db = CurrentDb
strSuchbegriffe = Split(Me.txtSuchbegriffe, " ")
If Me.ogrVerknuepfung = 2 Then
strOperator = "="
End If
If Me.ogrVerknuepfung = 1 Then
strOperator = "AND"
Else
strOperator = "OR"
End If
End If

Dim strWoche As String
strWoche = .Fields(0)

Set rsDat = db.OpenRecordset("SELECT abf_Schichtbuchdaten.StörungID_P AS Nummer, " & _
" abf_Schichtbuchdaten.Stoergrund, " & _
" abf_Schichtbuchdaten.StörDatum AS Tag, " & _
" abf_Schichtbuchdaten.W AS Woche, " & _
" abf_Schichtbuchdaten.Arbeitsfolge," & _
" abf_Schichtbuchdaten.StoerZeitM AS Minuten," & _
" abf_Schichtbuchdaten.Schichtart " & _
" FROM abf_Schichtbuchdaten ", dbOpenForwardOnly)

'Wie bekomme ich das Ergebnis zur Woche aus Formular Suche

Set oSh = oWb.Worksheets.Add
oSh.Name = .Fields(0)
For i = 0 To rsDat.Fields.count - 1
oSh.Cells(4, i + 1) = rsDat.Fields(i).Name

oSh.Range("A1").Value = "BMG"
oSh.Range("A2").Value = "Halle 6 / 4"
oSh.Range("C1").Value = "Störungsliste"
oSh.Range("C2").Value = "Erstellt"
oSh.Range("D2").Value = Now
Next

oSh.Cells(5, 1).CopyFromRecordset rsDat

Start = 5 ' Start erst ab dieser Zeile
'lZeile2 = oSh.Cells(oSh.Rows.count, 1).SpecialCells(xlCellTypeLastCell).row
'hier Bspw Überlauf (2009)
For t = Start To lZeile2
With oSh
.Range(.Cells(t, "A"), .Cells(t, "F")).Interior.ColorIndex = IIf(t Mod 2 = 1, 35, xlNone)
End With
Next t

rsDat.Close

.MoveNext
Loop

End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

sw-blitz007 · 26. Februar 2011

Prima, Deine Antwort passt 0% zu meiner Frage *Smilie .

Prinzipiell ist Excel ein Tabellenkalkulationsprogramm
und Access eine "Desktop Datenbank". Da musst schon Du
Dich entscheiden, was Du haben möchtest.
Allgemein gesprochen:
Rechnen oder strukturierte Daten ablegen/auswerten?*confused.gif*

Erich290607 · 26. Februar 2011

Sorry, beitrag #34 im Code kein Fehler der gemeldet wird
bzw. im Code blau makiert

mir fällt der Lösungsansatz zur WHERE Klausel nicht ein, wie zu jeder Woche das gewünschte Suchenergebnis aus Formular

solche Meldungen bekomme ich noch Bspw.

Erich290607 · 26. Februar 2011

das sieht schon besser aus ? *eek.gif* *wink.gif*

der Zwischencode sieht jetzt so aus und funktioniert die Daten werden zur korrekten Woche eingetragen
schaut bitte mal drüber! nur die Datenmenge ist noch nicht identisch mit dem Suchen Ergebnis, dort wurden 31 Einträge gefunden
12 hat mein Code nach Excel exportiert

Code:

Dim db As DAO.Database
Dim Suchbegriffe() As String
Dim strOperator As String
Dim strSQL As String
Dim i As Integer
Dim strKriterium As String
Dim strSuchbegriffe() As String
Dim rsID As DAO.Recordset
Dim rsDat As DAO.Recordset
Dim oXL As Object
Dim oWb As Object
Dim oSh As Object
Dim t As Long
Dim Start As Long
Dim lZeile2 As Integer
Dim lngJNummer As Long
Dim Mysql As String
Dim DATNA As String
Dim FELDNA As String
Dim tmp, TTD, Addr, rs As DAO.Recordset, _
TransP As Boolean, j As Long, B As Long, St As Long

lngJNummer = InputBox("Bitte geben Sie das Jahr an, welches ausgewertet werden soll", "Schichtbuchdaten")

On Error Resume Next
Me!DATEINAME2 = Application.CurrentProject.path & "\Schichtbuchdaten.xls"
'//DATNA = "Lagerort Halle-6"

Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Add
oXL.Visible = True
On Error Resume Next
Me!DATEINAME2 = "D:\Schichtbuch\SB_Ergebniss.xls"
'//DATNA = "SB_GC"
Set oExcel = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set oExcel = CreateObject("Excel.Application")
End If

Set db = CurrentDb
Set rsID = db.OpenRecordset("SELECT abf_YW.KW, abf_YW.J " & _
" FROM abf_YW " & _
" WHERE abf_YW.J =" & lngJNummer, dbOpenForwardOnly)

'Do While Not rsID.EOF

'Set oSh = oWb.Worksheets.Add
'oSh.Name = rsID.Fields(0) 'Tabellenblatt Jahr + Woche

With rsID
Do While Not .EOF

On Error GoTo 0
If Len(Nz(Me.txtSuchbegriffe, "")) > 0 Then
Set db = CurrentDb
strSuchbegriffe = Split(Me.txtSuchbegriffe, " ")
If Me.ogrVerknuepfung = 2 Then
strOperator = "="
End If
If Me.ogrVerknuepfung = 1 Then
strOperator = "AND"
Else
strOperator = "OR"
End If
End If

Dim strWoche As String
strWoche = .Fields(0)

Set rsDat = db.OpenRecordset("SELECT abf_Schichtbuchdaten.StörungID_P AS Nummer, " & _
" abf_Schichtbuchdaten.Stoergrund, " & _
" abf_Schichtbuchdaten.StörDatum AS Tag, " & _
" abf_Schichtbuchdaten.NrJahr , " & _
" abf_Schichtbuchdaten.W, " & _
" abf_Schichtbuchdaten.Arbeitsfolge," & _
" abf_Schichtbuchdaten.StoerZeitM AS Minuten," & _
" abf_Schichtbuchdaten.Schichtart " & _
" FROM abf_Schichtbuchdaten " & _
" WHERE NrJahr = " & lngJNummer & " And Stoergrund like '*" & Me!txtSuchbegriffe & "*'" & " And W= '" & strWoche & "'", dbOpenForwardOnly)

'Wie bekomme ich das Ergebnis zur Woche aus Formular Suche

Set oSh = oWb.Worksheets.Add
oSh.Name = .Fields(0)
For i = 0 To rsDat.Fields.count - 1
oSh.Cells(4, i + 1) = rsDat.Fields(i).Name

oSh.Range("A1").Value = "BMG"
oSh.Range("A2").Value = "Halle 6 / 4"
oSh.Range("C1").Value = "Störungsliste"
oSh.Range("C2").Value = "Erstellt"
oSh.Range("D2").Value = Now
Next

oSh.Cells(5, 1).CopyFromRecordset rsDat
oSh.Columns("C:G").EntireColumn.AutoFit

Start = 5 ' Start erst ab dieser Zeile
'#lZeile2 = oSh.Cells(oSh.Rows.count, 1).SpecialCells(xlCellTypeLastCell).row
For t = Start To lZeile2
With oSh
.Range(.Cells(t, "A"), .Cells(t, "G")).Interior.ColorIndex = IIf(t Mod 2 = 1, 35, xlNone)
End With
Next t
oSh.Range("A4").AutoFilter

rsDat.Close

.MoveNext
Loop

End With

With oXL

FELDNA = Dir(Me!DATEINAME2)
If Not IsNull(FELDNA) And FELDNA "" Then
Kill Me!DATEINAME2
End If
.ErrorCheckingOptions.OmittedCells = False
oWb.SaveAs Me!DATEINAME2

.ErrorCheckingOptions.OmittedCells = True
.Quit

MsgBox "Störungsmappe unter: " & vbCrLf & _
Me!DATEINAME2 & vbCrLf & _
"gespeichert", vbInformation, "Stördauerverlauf"

End With

Set oExcel = Nothing
Set oXL = Nothing
EndeEX2:
Exit Sub
FehlerEx2:
If Err 91 Then
FEHKZ = 9
MsgBox Err.Number & " " & Err.Description
End If
MsgBox Err.Number & " " & Err.Description
Resume EndeEX2
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Scorefun · 7. Januar 2021

von sw-blitz007

Mit GetObject() bekommst Du hier eine Referenz auf ein bereits laufendes Excel.
Mit CreateObject() wird ein neues Objekt erzeugt, also hier bspw. Excel gestartet.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hast Du überhaupt richtig gelesen ?*Smilie

ebs17 · 26. Februar 2011

//OT:
@Ralf: Sicher hat er das, und seine Aussage ist doch unzweifelhaft richtig. Wenn Michael ein anderes Problem beleuchtet als das, was Du im Auge hast, ist das doch nicht verwunderlich. Es gibt ja reichliche Auswahl, die auch nach Hinweisen nicht spürbar abnimmt. Statt Eingrenzung auf ein Problem scheint Erich es zu bevorzugen, den Code zu erweitern und dabei die Möglichkeit zu nutzen, weitere Probleme einzubringen.

Selbst die Code-Formatierung (sinnvolle Einrückungen) scheint ein unlösbares Problem zu sein. Ich nutze dazu übrigens den Smart Indenter.

Wobei: "richtig gelesen" heißt was?

sw-blitz007 · 26. Februar 2011

//OT: @Scorefun
uups, da wollte ich nur Deine Frage beantworten *wink.gif*
Diese Antwort war nicht auf "Superprogrammierer E"'s Spaghetti gezielt *yelrotflmao

Scorefun · 7. Januar 2021

von ebs17

//OT:
@Ralf: Sicher hat er das, und seine Aussage ist doch unzweifelhaft richtig.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Seine Aussage ist zweifellos richtig, bezieht sich aber nicht auf das, was ich bei Erich's Code angemeckert habe...

Erich schreibt :

Code:

Set oXL = CreateObject("Excel.Application")
Set oWb = oXL.Workbooks.Add
oXL.Visible = True
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

hier wird eine Excel-Instanz erstellt mit der Variable oXL, die Erich im weiteren Verlauf seines Codes auch benutzt, aber dann kommt

Code:

Set oExcel = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set oExcel = CreateObject("Excel.Application")
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

setzt er eine neue Excel-Instanz, die er gar nicht braucht...

Capito? *biggrin.gif*

Erich290607 · 26. Februar 2011

Antwort zu #41

ist bereinigt, habe das angemekerte geprüft und bereinigt

eine vorletzte Frage zu diesem Code, den habe ich noch nicht ganz verstanden

wie kann ich zusätzlich nur nach einem gewünschtem Jahr filtern

Code:

strSQL = "SELECT tblArbeitsfolge.Arbeitsfolge, tblStoerungen.Stoergrund, tblStoerungen.StörDatum," & _
" tblStoerungen.StoerZeitM, tblBereiche.Bereich, tblSchichtarten.Schichtart," & _
" tblMitarbeiterNamen.Name, tblStoerungen.DS_ID, tblStoerungen.StörungID_P," & _
" tblStoerungen.NrJahr , tblMaschine.Bezeichnung" & _
" FROM tblMaschine INNER JOIN (tblMitarbeiterNamen INNER JOIN" & _
" (tblBereiche INNER JOIN (tblArbeitsfolge INNER JOIN (tblSchichtarten INNER JOIN tblStoerungen" & _
" ON tblSchichtarten.SchichtArtID_P = tblStoerungen.SchichtartID_F)" & _
" ON tblArbeitsfolge.ArbeitsfolgeID = tblStoerungen.ArbeitsfolgeID_F)" & _
" ON tblBereiche.BereichID_P = tblStoerungen.BereichID_F)" & _
" ON tblMitarbeiterNamen.MitarbeiterID_P = tblStoerungen.MitarbeiterID_F)" & _
" ON tblMaschine.MaschineID_P = tblStoerungen.MaschinenID_F WHERE "

For i = 0 To UBound(strSuchbegriffe)
strKriterium = strKriterium & " " & strOperator & " Stoergrund LIKE '*" & strSuchbegriffe(i) & "*'"
Next i
strKriterium = Mid(strKriterium, 5)
strSQL = strSQL & strKriterium
Set rst = db.OpenRecordset(strSQL)
ctlListView.ListItems.Clear
Do While Not rst.EOF
lngJNummer = DLookup("NrJahr", "tblStoerungen", "StörungID_P = " & rst!StörungID_P)
strNummer = DLookup("Stoergrund", "tblStoerungen", "StörungID_P = " & rst!StörungID_P)
Set objListitem = ctlListView.ListItems.Add(, "a" & rst!StörungID_P, rst!Stoergrund)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ebs17 · 26. Februar 2011

von Scorefun

setzt er eine neue Excel-Instanz, die er gar nicht braucht...
Capito?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klar, das sieht man, spätestens nachdem Du es in #28 so deutlich herausgestellt hattest, dass man es nicht übersehen konnte. Da gibt es nicht extrem viel zu ergänzen. Da die zusätzliche Instanz im weiteren aber nicht (sichtbar) verwendet wurde, dürfte sie im Code auch keinen Fehler erzeugen und höchstens den Taskmanager beschäftigen.
Somit gibt es (oder gab es) dann aber noch mindestens einen richtigen Fehler.

von Erich290607

wie kann ich zusätzlich nur nach einem gewünschtem Jahr filtern
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Erich, Du bemerkst, dass Du eine Where-Klausel dynamisch zusammenstellst? Wie wäre es, den gewünschten zusätzlichen Filter dort einzubauen?

Scorefun · 7. Januar 2021

von ebs17

dürfte sie im Code auch keinen Fehler erzeugen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

habe ich auch nicht behauptet *wink.gif*

von ebs17

und höchstens den Taskmanager beschäftigen.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

genau *biggrin.gif*

Erich290607 · 7. Januar 2021

von ebs17

Klar, das sieht man, spätestens nachdem Du es in #28 so deutlich herausgestellt hattest, dass man es nicht übersehen konnte. Da gibt es nicht extrem viel zu ergänzen. Da die zusätzliche Instanz im weiteren aber nicht (sichtbar) verwendet wurde, dürfte sie im Code auch keinen Fehler erzeugen und höchstens den Taskmanager beschäftigen.
Somit gibt es (oder gab es) dann aber noch mindestens einen richtigen Fehler.

Erich, Du bemerkst, dass Du eine Where-Klausel dynamisch zusammenstellst? Wie wäre es, den gewünschten zusätzlichen Filter dort einzubauen?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ja, doch meine Frage lautet wie baue ich es da ein*wink.gif*