Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1072to1076
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
Inhaltsverzeichnis

Laufzeitfehler: Datei Öffnen

Laufzeitfehler: Datei Öffnen
13.05.2009 09:05:51
Jakob
Hallo,
ich habe mir den folgenden Code zusammengebastelt. Ich weiß nicht ob es gewünscht ist, das ich das Macro hier aufführe.
Das Makro HauptdateiOeffnen wird ja 2 x geöffnet. Beim 1. Mal gibt es keine Probleme. Der 2. Aufruf führt aber zu einen Laufzeitfehler 1004 "Die Methode 'Open' für das Objekt 'Workbooks' ist fehlgeschlagen" und die Datei Frachtkosten wird nicht geöffnet.
Der Cursor steht in der folgenden Zeile des Makros HauptdateiOeffnen:
Workbooks.Open Filename:="\\frasdat2\projects\Transport\Budget & Analysen\Kostenanalysen\Frachtkosten.xls", ReadOnly:=False
Wenn ich aber vor den 2. Aufruf des Makros HauptdateiOeffnen ein Stop setze wird die Datei Frachtkosten geöffnet und ich kann das ganze ohne Fehlermeldung beenden. Woran kann das liegen?

Sub FrachtkostenNeu()
Dim varAntwort As Variant
Dim sPath As String
Dim sPath2 As String
Dim sPath3 As String
Dim lz As Variant
Call HauptdateiOeffnen
sPath = "\\frasdat2\projects\Transport\Budget & Analysen\Kostenanalysen\Sicherung\"
sPath2 = "\\frasdat2\projects\Transport\Budget & Analysen\Kostenanalysen\"
sPath3 = "\\frasdat3\Benutzer\Frachtkosten\"
If Dir(sPath & "Frachtkosten " & Format(Date, "DD.MM.YYYY") & ".xls")  "" Then
If MsgBox("Eine Sicherungskopie mit dem heutigen Datum existiert bereits." & Chr(10) & _
"Soll die Datei ersetzt werden?", vbYesNo) = vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sPath & "Frachtkosten " & Format(Date, "DD.MM.YYYY") & ".xls"
Application.DisplayAlerts = False
MsgBox "Die Datei mit dem aktuellen Datum wurde überschrieben." & Chr(10) & _
"Die 'Frachtkosten' für den abgelaufenen Monat werden jetzt ermittelt."
Else
MsgBox "Die Datei wurde 'nicht' unter dem aktuellen Datum gespeichert." & Chr(10) & _
"Die 'Frachtkosten' für den abgelaufenen Monat werden jetzt ermittelt."
End If
Else
ActiveWorkbook.SaveAs sPath & "Frachtkosten " & Format(Date, "DD.MM.YYYY") & ".xls"
MsgBox "Die Datei wurde unter dem aktuellen Datum gespeichert." & Chr(10) & _
"Die 'Frachtkosten' für den abgelaufenen Monat werden jetzt ermittelt."
End If
ActiveWorkbook.Close
' Bitte Laufwerk und Pfad anpassen
ChDrive ("C:")
ChDir ("C:\Documents and Settings\Benutzer\SapWorkDir\")
varAntwort = Application.GetOpenFilename _
("(*.xl*),*.xl*", 1, _
"Datei auswählen") 'Eigener Dialog Titel
If varAntwort  False Then
Workbooks.Open varAntwort
End If
Range("1:3,5:5").Delete Shift:=xlUp
Columns("A:A").Delete Shift:=xlToLeft
Columns("A:AU").EntireColumn.AutoFit
Columns("AO:AR").HorizontalAlignment = xlRight
Range("A:C,E:E,H:K,M:N,P:P,S:S,X:Y,AA:AB,AE:AE,AM:AN").HorizontalAlignment = xlGeneral
Call FormatUeberschrift
Columns("AL:AL").Insert Shift:=xlToRight
'    Formel bis zum Ende kopieren
With Range("AL2:AL" & Range("Z65536").End(xlUp).Row)
.FormulaR1C1 = "=TRIM(RC[-1])*1"
.Select
'    Formel durch Werte ersetzen
Selection.Copy
Range("AK2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Columns("AL:AL").Delete Shift:=xlToLeft
Columns("AK:AK").NumberFormat = "0.00"
Columns("G:G").ColumnWidth = 7.33
Columns("Y:Y").ColumnWidth = 6.33
Columns("AA:AA").ColumnWidth = 7.25
Columns("AB:AB").ColumnWidth = 6.33
Columns("AG:AG").ColumnWidth = 7.25
Columns("AN:AN").ColumnWidth = 6.33
Columns("AU:AU").ColumnWidth = 4.63
Rows("1:1").EntireRow.AutoFit
Range("AK1") = "Paletten"
Columns("AK:AK").EntireColumn.AutoFit
Columns("V:V").Select
Selection.Insert Shift:=xlToRight
Range("V1") = "Mode"
Columns("V:V").ColumnWidth = 5.5
Columns("V:V").EntireColumn.AutoFit
'    Formel bis zum Ende kopieren
With Range("V2:V" & Range("Z65536").End(xlUp).Row)
.FormulaR1C1 = "=IF(RC21=80,""Luft"",IF(RC21=76,""See"",IF(RC21=2,""LKW"","""")))"
.Select
'    Formel durch Werte ersetzen
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Columns("AP:AP").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("AP1") = "Periode"
Range("AQ1") = "Jahr"
Range("BB2").FormulaR1C1 = "=LEFT(RC41,SEARCH("","",RC41))*1"
Range("BC2").FormulaR1C1 = "=RIGHT(RC41,4)*1"
Range("BB2:BC2").Cut Destination:=Range("AP2")
Range("AP2:AQ2").Select
Selection.AutoFill Destination:=Range("AP2:AQ" & Range("Z65536").End(xlUp).Row)
Columns("AP:AQ").EntireColumn.AutoFit
Columns("BB:BC").Delete Shift:=xlToLeft
'    Spalten verschieben   ####################################
Columns("AO:AQ").Cut
Range("AG1").Insert Shift:=xlToRight
Columns("AX:AX").Cut
Range("AJ1").Insert Shift:=xlToRight
Range("AK:AL,AN:AQ,AW:AW").NumberFormat = "#,##0.000"
'    Gesamten Bereich markieren und Kopieren  ###############
Range("A2", Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Call HauptdateiOeffnen  'Frachtkosten.xls
Sheets("Daten").Range("A1").Select
lz = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1
Cells(lz, 1).Select
ActiveSheet.Paste
Sheets("Pivot").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveWorkbook.SaveAs sPath2 & "Frachtkosten " & Format(Date, "MMM.YYYY") & ".xls"
ActiveWorkbook.Close
ActiveWorkbook.SaveAs sPath3 & Application.ActiveWorkbook.Name, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
End Sub


Makro HauptdateiOeffnen


Sub HauptdateiOeffnen()
Dim bExists As Boolean
Dim oWorkbook As Object
' Prüfen ob Datei bereits geöffnet ist
bExists = False
With Application
For Each oWorkbook In .Workbooks
If UCase$(oWorkbook.Name) = "Frachtkosten.xls" Then
' Jetzt aktivieren
Windows(oWorkbook.Name).Activate
bExists = True
Exit For
End If
Next
End With
' Mappe neu laden!
If Not bExists Then
On Error Resume Next
Workbooks.Open Filename:="\\frasdat2\projects\Transport\Budget & Analysen\Kostenanalysen\ _
Frachtkosten.xls", ReadOnly:=False
On Error GoTo 0
End If
End Sub


Vielen Dank für Eure Hilfe.
Gruß,
Jakob

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Laufzeitfehler: Datei Öffnen
13.05.2009 11:07:42
Jakob
Hallo,
ein Kollege konnte das Problem lösen. Scheinbar war das Makro zu schnell. Durch diesen Zusatz vor den 2. Aufruf der Datei Frachtkosten.xls klappt es.
Application.Wait (Now + TimeValue("0:00:01"))
Gruß,
Jakob

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige