AW: Zahlenformat beim CSV-abspeichern
20.09.2006 08:59:41
bst
Morgen Winfried,
versuch's mal so.
HTH, Bernd
--
Option Explicit
Const RecordSeparator As String = vbCrLf
Const FieldSeparator As String = ";"
Const TextQualifier As String = """"
Const TranslateCRLF As Boolean = True
Sub TestWrite()
Call CSVWrite(ActiveSheet.UsedRange, "e:\test\aus.csv")
End Sub
Public Sub CSVWrite(src As Range, fname As String)
Dim handle As Integer ' Filehandle bzw. Dateinummer
Dim i As Long ' Zähler über Zeilen
Dim j As Integer ' Zähler über Spalten
Dim arRow As Variant ' eine Zeile, für die Ausgabe zusammengebaut
Dim sVal As String ' ein Zellenwert
Dim maxcol As Integer ' max. Anzahl an Spalten
handle = FreeFile
maxcol = src.Columns.Count
Redim arRow(1 To maxcol)
Open fname For Output As #handle
For i = 1 To src.Rows.Count
For j = 1 To maxcol
If IsError(src(i, j)) Then
sVal = src(i, j).Text
Else
sVal = src(i, j).Value
End If
' Falls Trennzeichen in der Zelle vorkommen, Spezialbehandlung
If IsSeparatorInside(sVal) Then
' den Textkennzeichner verdoppeln und vorne und hinten anfügen
sVal = TextQualifier & Replace(sVal, TextQualifier, TextQualifier & TextQualifier) & TextQualifier
If TranslateCRLF Then sVal = Replace(sVal, vbLf, vbCrLf)
End If
arRow(j) = sVal
Next j
' Zeile mit Trennzeichen ausgeben
Print #handle, Join(arRow, FieldSeparator); RecordSeparator;
Next i
Close #handle
End Sub
Private Function IsSeparatorInside(s As String) As Boolean
IsSeparatorInside = True
' Test auf das Feldtrennzeichen
If InStr(s, FieldSeparator) Then Exit Function
' Test auf den Recordseparator
If InStr(s, RecordSeparator) Then Exit Function
' Test auf vbCR und vbLF
If InStr(s, vbCr) Then Exit Function
If InStr(s, vbLf) Then Exit Function
' Test auf den Textkennzeichner
If InStr(s, TextQualifier) Then Exit Function
' fertig, keine Sonderbehandlung notwendig
IsSeparatorInside = False
End Function