AW: Application.Workbooks.Open(KplName) versagt
11.02.2009 14:14:00
Matthias
Hallo Rainer,
hier der Code:
Public Function HoleWert(ByVal WoherXLS As String, ByVal Datum As String, ByVal ProjektNummer _
As String, ByVal StartZeile As Long, ByVal DatumSpalte As Integer, ByVal ProjektZeileBezug As Long, ByVal ProjektSpalteStart As Integer) As Currency
Dim Verz As String, KplName As String, DatumWert As Date, JahrTab As String
Dim LeereZeilen As Integer, strTemp As String, DatumSuche As Date
Dim strTmp01 As String, strTmp02 As String, strTmp03 As String, strTmp04 As String
Dim I As Long, Z As Long, S As Long, E As Long, wb As Workbook
Const MaxLeereZeilen = 3
HoleWert = 0
'On Error GoTo ExitHoleWert
Verz = ActiveWorkbook.Path
If Right$(Verz, 1) "\" Then Verz = Verz & "\"
KplName = Verz & WoherXLS
strTemp = Dir(KplName)
If strTemp "" Then
For E = 1 To 20
If XLSisOpen(WoherXLS) Then Exit For
Set wb = Application.Workbooks.Open(KplName)
Next E
If IsDate(Datum) Then
DatumWert = CDate(Datum)
JahrTab = Trim(Str(Year(DatumWert)))
For I = StartZeile To 40000
strTmp01 = Application.Workbooks(WoherXLS).Worksheets(JahrTab).Cells(I, 1).Value
strTmp02 = Application.Workbooks(WoherXLS).Worksheets(JahrTab).Cells(I, 2).Value
strTmp03 = Application.Workbooks(WoherXLS).Worksheets(JahrTab).Cells(I, 3).Value
strTmp04 = Application.Workbooks(WoherXLS).Worksheets(JahrTab).Cells(I, 4).Value
If strTmp01 = "" And strTmp02 = "" And strTmp03 = "" And strTmp04 = "" Then
LeereZeilen = LeereZeilen + 1
Else
LeereZeilen = 0
strTemp = Application.Workbooks(WoherXLS).Worksheets(JahrTab).Cells(I, DatumSpalte). _
Value
If IsDate(strTemp) Then
DatumSuche = CDate(strTemp)
If DatumSuche = DatumWert Then
LeereZeilen = MaxLeereZeilen + 1
For E = ProjektSpalteStart To 249
strTemp = Trim(Application.Workbooks(WoherXLS).Worksheets(JahrTab).Cells( _
ProjektZeileBezug, E).Value)
If strTemp = "" Then
Exit For
Else
If UCase(Trim(ProjektNummer)) = UCase(strTemp) Then
strTemp = Trim(Application.Workbooks(WoherXLS).Worksheets(JahrTab).Cells(I, _
E).Value)
If IsNumeric(strTemp) Then HoleWert = CCur(strTemp)
Exit For
End If
End If
Next E
End If
End If
End If
If LeereZeilen >= MaxLeereZeilen Then Exit For
Next I
'HoleWert = CCur(JahrTab)
'MsgBox "WoherXLS: " & Chr(9) & WoherXLS & vbCrLf & "KplName: " & Chr(9) & KplName & _
vbCrLf & "Datum: " & Chr(9) & Chr(9) & Datum & vbCrLf & "ProjektNummer: " & Chr(9) & ProjektNummer & vbCrLf & "DatumWert: " & Chr(9) & DatumWert & vbCrLf & "JahrTab: " & Chr(9) & Chr(9) & JahrTab, vbInformation
' HoleWert = Application.Workbooks(WoherXLS).Worksheets(BlattName).Cells(Zeile, Spalte). _
Value
Else
MsgBox "Das übergebene Datum:" & vbCrLf & Chr(34) & Datum & Chr(34) & vbCrLf & "ist kein _
Datum!", vbCritical + vbOKOnly, "FEHLER AUFGETRETEN"
End If
Else
MsgBox "Die Datei:" & vbCrLf & Chr(34) & KplName & Chr(34) & vbCrLf & "exisiert nicht!", _
vbCritical + vbOKOnly, "FEHLER AUFGETRETEN"
End If
Exit Function
ExitHoleWert:
MsgBox "Ein Fehler bei der Ausführung ist aufgetreten!" & vbCrLf & vbCrLf & "Fehler-Code: " & _
Chr(9) & "#" & Mid$(Str$(Err.Number), 2) & vbCrLf & "Ausgelöst von: " & Chr(9) & Err.Source & vbCrLf & "Beschreibung: " & Chr(9) & Err.Description & vbCrLf & vbCrLf & "Aufgetreten im:" & vbCrLf & "Dokument:" & Chr(9) & Chr(34) & ActiveWorkbook.Name & Chr(34) & vbCrLf & "Tabellenblatt: " & Chr(9) & Chr(34) & ActiveSheet.Name & Chr(34), vbCritical + vbOKOnly, "FEHLER AUFGETRETEN"
End Function
In der Excel-Zelle steht dann eine Formel:
=holewert(DI$2;$DC15;DI$1;9;2;7;9)
Damit hole ich aus einer anderen Excel-Datei aus einem Sheet (z. B. "2009") einen speziellen Wert, der zum übergebenen Datum und richtigen Projektnummer gehört.
Gruß, Matthias