AW: VBA export nach txt - 80 Spalten mit >600 Zeic
06.05.2006 10:00:05
Reinhard
Hi Horst,
die Datei https://www.herber.de/bbs/user/33378.xls
hat folgenden Code:
' 20060504 von Harald E
Sub IntTextDatei2()
Dim iRow As Long, iCol As Integer, iFile As Integer, sfile As String, sTxt As String, sTxt2, sTxt3
sfile = "C:\temp\" & Date & "Text.txt"
sFile2 = "C:\temp\" & Date & "Farben.txt"
sFile3 = "C:\temp\" & Date & "Fett.txt"
iFile = FreeFile
Open sfile For Output As #iFile
iFile2 = FreeFile
Open sFile2 For Output As #iFile2
iFile3 = FreeFile
Open sFile3 For Output As #iFile3
sTxt = "'"
For iRow = 1 To Range("B65536").End(xlUp).Row
For iCol = 1 To 79
sTxt = sTxt & Cells(iRow, iCol).Value & vbTab
sTxt2 = sTxt2 & Cells(iRow, iCol).Font.ColorIndex & vbTab
sTxt3 = sTxt3 & Cells(iRow, iCol).Font.Bold & vbTab
Next iCol
sTxt = Left(sTxt, Len(sTxt) - 1)
sTxt2 = Left(sTxt2, Len(sTxt2) - 1)
sTxt3 = Left(sTxt3, Len(sTxt3) - 1)
Print #iFile, sTxt
Print #iFile2, sTxt2
Print #iFile3, sTxt3
sTxt = "'"
sTxt2 = ""
sTxt3 = ""
Next iRow
Close
lRow = Worksheets("02").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(2).Cells(lRow, 1) = Date
MsgBox "Habe die Daten in eine Textdatei eingelesen!"
End Sub
Sub Einlesen()
Dim iFile As Integer, zei As Long, Satz As String, Satz2, sfile, n
sfile = "C:\temp\" & Date & "Text.txt"
iFile = FreeFile
Worksheets.Add
Open sfile For Input As #iFile
While Not EOF(iFile)
Input #iFile, Satz
zei = zei + 1
Satz2 = Split(Satz, vbTab)
Range(Cells(zei, 1), Cells(zei, 79)) = Satz2
Wend
sfile = "C:\temp\" & Date & "Farben.txt"
iFile = FreeFile
Open sfile For Input As #iFile
zei = 0
While Not EOF(iFile)
Input #iFile, Satz
zei = zei + 1
Satz2 = Split(Satz, vbTab)
For n = 1 To 79
ActiveSheet.Cells(zei, n).Font.ColorIndex = CInt(Satz2(n - 1))
Next n
Wend
sfile = "C:\temp\" & Date & "Fett.txt"
iFile = FreeFile
Open sfile For Input As #iFile
zei = 0
While Not EOF(iFile)
Input #iFile, Satz
zei = zei + 1
Satz2 = Split(Satz, vbTab)
For n = 1 To 79
ActiveSheet.Cells(zei, n).Font.Bold = -1 * (Satz2(n - 1) = "Wahr")
Next n
Wend
Close
ActiveSheet.Columns("A:CA").AutoFit
End Sub
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..