AW: Textfile Punkt Komma @Christian?
22.08.2008 17:32:48
fcs
Hallo Petra,
das folgende Makro schreibt die Zellinhalte in eine Textdatei, wobei mit Leerzeichen aufgefüllt wird.
Sub Text_Export()
Dim i As Integer, arrZeichen(), lngSpalten As Long, lngZeileLast As Long
Dim wks As Worksheet, strtext As String, spalte As Integer, sfile As Variant
Set wks = ActiveSheet
'Dialogfenster Speichern unter
sfile = Application.GetSaveAsFilename _
(fileFilter:="Text Files (*.txt), *.txt")
If sfile False Then
With wks
'Anzahl Spalten
lngSpalten = 39 '.UsedRange.Column + .UsedRange.Columns.Count - 1
'Letzte Datenzeile in Spalte B (2)
lngZeileLast = .Cells(.Rows.Count, 2).End(xlUp).Row ' .UsedRange.Row _
+ .UsedRange.Rows.Count - 1
'Zeichen pro Spalte ermitteln
ReDim arrZeichen(1 To lngSpalten)
'Hilfswerte für Anzahl Zeichen in Spalten berechnen und unterhalb Daten eintragen
For spalte = 1 To lngSpalten
'max. Textlänge in Zellen
.Cells(lngZeileLast + 1, spalte).FormulaArray = _
"=MAX(LEN(R1C" & spalte & ":R" & lngZeileLast & "C" & spalte & "))"
'Spaltenbreite
.Cells(lngZeileLast + 2, spalte).Value = .Columns(spalte).ColumnWidth
Next
'Anzahl Zeichen in Spalte gem. Spaltenbreite oder max. Textlänge in Spalte festlegen
For spalte = 1 To lngSpalten
arrZeichen(spalte) = Application.WorksheetFunction.Max(.Cells(lngZeileLast + 1, _
spalte), Int(.Cells(lngZeileLast + 2, spalte).Value * 0.8)) + 1
Next
'Tabelleninhalte in Textdatei schreiben
Open sfile For Output As #1
For i = 1 To lngZeileLast
'Zellinhalte in Zeile zusammenfügen inkl. Auffüllen mit Leerzeichen
For spalte = 1 To lngSpalten
strtext = strtext & Space(arrZeichen(spalte) - Len(.Cells(i, spalte).Text)) _
& .Cells(i, spalte).Text
Next
Print #1, strtext
strtext = ""
Next i
Close #1
MsgBox sfile
'Hilfszeilen wieder löschen
.Range(.Rows(lngZeileLast + 1), .Rows(lngZeileLast + 2)).ClearContents
End With
End If
End Sub
Das folgende Makro ersetzt in der gewählten PRN-Datei die Punkte durch Komma.
Sub PRN_bereinigen()
Dim sfile As Variant, lngI As Long, arrDaten() As String, intFF As Integer, strtext As String
sfile = Application.GetOpenFilename(Filefilter:="PRN-Dateien(*.PRN),*.PRN", _
Title:="PRN-Datei öffnen")
If sfile False Then
intFF = FreeFile()
Open sfile For Input As #intFF
Do Until EOF(intFF)
lngI = lngI + 1
ReDim Preserve arrDaten(1 To lngI)
Line Input #intFF, strtext
arrDaten(lngI) = Replace(strtext, ".", ",")
Loop
Close #intFF
Open sfile For Output As #intFF
For lngI = 1 To lngI
Print #intFF, arrDaten(lngI)
Next
Close #intFF
End If
End Sub
Gruß
Franz