AW: hat das einfügen der leerzeilen
13.03.2009 00:52:07
bully
unten steht nun der gesamte Code, vielleicht findest du einen Fehler.
ich habe es jetzt mehrmals getestet. Wenn ich den Code ein zweites Mal starte, sind alle Zellen mit einem Leerschlag weg! Also habe ich mir gedacht, ich starte nur den Replace Befehl ein zweits Mal sogar mit einer Wait-Funktion dazwischen, das Resultat bleibt aber das gleiche wie beim enfachen Durchlauf (es entstehen Leerzeilen in der abgespeicherten Datei). Lasse ich aber den ganzen Code zweimal durchlaufen, sind die Leerzeichen weg, und in der abgespeicherten Datei sind auch keine Leerzeilen mehr vorhanden.
Das kann ich mir nicht erklären. Weisst du worin der Unterschied besteht?
Gruss bully
Sub Eberdatei()
'Eberliste downloaden ---> Internetverbindung muss aktiv sein!!
Anfang:
If MsgBox("Eberliste Herunterladen? - Ja/Nein", vbYesNo + vbQuestion, " ") = vbYes Then
If MsgBox("Ist Ihre Internetverbindung aktiv?" & Chr(13) & Chr(13) & "Ziel-Diskette im _
Laufwerk A: ?", _
vbOKCancel + vbQuestion, "Bitte prüfen Sie vor dem Download: ") = vbOK Then
Else
Worksheets("Eber").Activate
Exit Sub
End If
Else
Worksheets("Eber").Activate
Exit Sub
End If
'öffnen der Website und download der txt.datei mit Modul 5
download
'stoppt das Makro für 1 Sekunde
Application.Wait Now + TimeValue("00:00:01")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'öffnet die KB-Eber Datei und kopieert die Bestandeseber hinein
Workbooks.OpenText Filename:= _
"D:\Daten 09\Fredy\Temporär\Eber.txt", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Range("A7").Select
Selection.EntireRow.Insert
Windows("Auswertung1.xls").Activate
Rows("3:17").Select
Selection.Copy
Windows("Eber.txt").Activate
Selection.EntireRow.Insert
'entfernt die überzähligen Leerzeilen
Dim f As Long
Dim LZ As Long
LZ = ActiveSheet.UsedRange.Rows.Count
Range("E7").Select
For f = f To LZ
If Len(ActiveCell.Value) = "0" _
Then Selection.EntireRow.Delete _
Else ActiveCell.Offset(1, 0).Select
Next f
'speichert die Datei unter neuem Namen
ActiveWorkbook.SaveAs Filename:="D:\Daten 09\Fredy\Temporär\Eber.txt", _
FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Range("E:G").Replace " ", "", LookAt:=xlWhole
Cells(20, 5).End(xlUp).Offset(1, 0).Select
If MsgBox(" Datei erfolgreich gespeichert ", vbOKOnly) Then
Exit Sub
End If
End Sub