Helleseher/in gesucht für Fehler 9, Index außer
23.05.2006 11:43:57
Reinhard
mit der Datei: https://www.herber.de/bbs/user/33861.xls
lese ich die Datei
Die Datei https://www.herber.de/bbs/user/33862.txt wurde aus Datenschutzgründen gelöscht
in die xls-Datei ein. Es ist keine txt-Datei sondern muss eine rtf-Datei und nur wegen dem Hochladen hier umbenannt.
In der xls-Datei muss man nur Pfad und dateinamen in Tabelle2 in A1 und B1 eintragen.
Der Code der Datei ist nachfolgend gelistet.
Nun tritt bei einem Fremdrechner, wo noch dazu die Kommunikation mit dem Benutzer mehr als schwierig ist :-((( Fehler 9 , Index außerhalb auf.
Siehe:
Die Datei https://www.herber.de/bbs/user/33863.jpg wurde aus Datenschutzgründen gelöscht
Die Datei https://www.herber.de/bbs/user/33864.jpg wurde aus Datenschutzgründen gelöscht
Bin für jeden Tipp dankbar.
Gruß
Reinhard
Option Explicit
' Die Bibliothek "Microsoft Word x.x Object Library"
' muss aktiviert sein (EARLY BINDING)
Sub ImportFromWord1()
Dim WordApp As New Word.Application, strPath As String, wks1 As Worksheet
Dim strFile As String, zei, s, s2, s3, n, kurz
strFile = Worksheets("Tabelle2").Range("B1")
Set wks1 = ThisWorkbook.Worksheets("Tabelle1")
wks1.UsedRange.Clear
strPath = Worksheets("Tabelle2").Range("A1")
With WordApp
.ChangeFileOpenDirectory strPath
.Documents.Open strFile
With .Selection
.WholeStory
.Copy
End With
wks1.Range("A1").Select
'wks1.PasteSpecial Format:="Unicode-Text", Link:=False, DisplayAsIcon:=False
wks1.Paste
wks1.Range("A1").Select
.ActiveDocument.Close SaveChanges:=False
.Quit
End With
For zei = ActiveSheet.Range("A65536").End(xlUp).Row To 1 Step -1
Cells(zei, 1).HorizontalAlignment = xlCenter
Cells(zei, 1).HorizontalAlignment = xlLeft
If InStr(Cells(zei, 1), "Einlage") <= 0 Then
Cells(zei, 1).EntireRow.Delete
Else
s = Split(Cells(zei, 1), "Einlage:")
s2 = Split(s(0), "*")
If UBound(s2) > 0 Then Cells(zei, 5) = Left(s2(1), 10)
If InStrRev(s2(0), ",") >= Len(s2(0)) - 2 Then s2(0) = Left(s2(0), InStrRev(s2(0), ",") - 1)
s3 = Split(s2(0), ",")
Cells(zei, 1) = ""
For n = 1 To 2
If InStr(s3(0), "Dr.") > 0 And InStr(s3(0), "Dr.") < 6 Then
If Cells(zei, 1) <> "" Then Cells(zei, 1) = Cells(zei, 1) & " "
Cells(zei, 1) = Cells(zei, 1) & "Dr."
s3(0) = Mid(s3(0), InStr(s3(0), "Dr.") + 4)
End If
Next n
Cells(zei, 2) = s3(0)
If UBound(s3) = 2 Then
Cells(zei, 3) = s3(1)
Cells(zei, 4) = s3(2)
End If
If UBound(s3) = 1 Then Cells(zei, 4) = s3(1)
'Cells(zei, 3) = s3(UBound(s3))
If UBound(s) = 1 And InStr(s(1), ",") > 0 Then
s2 = Split(s(1), ",")
kurz = ""
For n = 1 To Len(s2(0))
If Mid(s2(0), n, 1) >= "0" And Mid(s2(0), n, 1) <= "9" Then kurz = kurz & Mid(s2(0), n, 1)
Next n
Cells(zei, 6) = CLng(kurz) + Left(s2(1), 2) / 100
Cells(zei, 7) = Right(s2(1), 3)
If InStr(Cells(zei, 7), "DEM") > 0 Then Cells(zei, 7) = "DM"
End If
End If
Next zei
zei = ActiveSheet.Range("A65536").End(xlUp).Row
Range("f1:f" & zei).NumberFormat = "#,##0.00"
Columns("A:G").AutoFit
Fehler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub