AW: Hallo Tüfftler - Formatierte Ausgabe in UserFo
07.06.2006 08:20:53
Erich
Hallo Harald,
vielleicht kannst du diese Funktion - abgewandelt - gebrauchen.
Sie ist mal entstanden, um bei wer-weiss-was Tabellen darstellen zu können.
' Fehlerwerte FFFF in Zellen werden mit ">>..." ausgegeben
' Texte erscheinen linksbündig, Zahlen rechtsbündig
' (dafür wird die Spaltenbreite künstlich um 1 erhöht)
' Version 07.05.2005
Dim anzS%, ss%, anzZ&, begZ&, zz&, SpBr%(), Erg$, SpNam$, FWert$
Dim vor%, nac%, Tz$, fz$
Tz = "|"
fz = "_"
With rg
anzS = .Columns.Count
anzZ = .Rows.Count
begZ = .Cells(1, 1).Row - 1
ReDim SpBr(anzS)
' max. Breite der Zeilennummer
SpBr(0) = Len(Format(anzZ + begZ))
' max. Breite pro Spalte
For ss = 1 To anzS
SpBr(ss) = 0
For zz = 1 To anzZ
' Fehler erkennen (wird mit am Ende mit ">" aufgefüllt)
FWert = Fehlerwert(zz, ss)
If FWert > "" Then
If SpBr(ss) < Len(FWert) + 1 Then _
SpBr(ss) = Len(FWert) + 1
Else
If SpBr(ss) < Len(.Cells(zz, ss).Text) Then _
SpBr(ss) = Len(.Cells(zz, ss).Text)
End If
Next zz
SpBr(ss) = SpBr(ss) + 1 ' künstliche Erhöhung um 1
Next ss
' Kopf und Spaltenbezeichnungen
Erg = String(SpBr(0), fz) & Tz
For ss = 1 To anzS
SpNam = SpName(.Cells(1, ss).Column)
If SpBr(ss) < Len(SpNam) Then _
SpBr(ss) = Len(SpNam)
vor = Int((SpBr(ss) - Len(SpNam)) / 2)
nac = SpBr(ss) - vor - Len(SpNam)
Erg = Erg & String(vor, fz) & SpNam & String(nac, fz) & Tz
Next ss
Erg = Erg & vbCrLf
For ss = 0 To anzS
Erg = Erg & String(SpBr(ss), "-") & Tz
Next ss
Erg = Erg & vbCrLf
For zz = 1 To anzZ
' -------------------------------------------------------- Zeilennummer
Erg = Erg & Right(" " & Format(zz + begZ), SpBr(0)) & Tz
' ---------------------------------------------------------- Zellinhalt
For ss = 1 To anzS
' Fehler erkennen (wird zwischen "<" und ">>>..." ausgegeben)
FWert = Fehlerwert(zz, ss)
If FWert <> "" Then
Erg = Erg _
& "<" & Left(FWert & String(SpBr(ss), ">"), SpBr(ss) - 1)
Else
' Zellinhalt (Text oder numerisch)
If Application.WorksheetFunction.IsNumber(.Cells(zz, ss)) Then
Erg = Erg _
& Right(String(SpBr(ss), " ") & .Cells(zz, ss).Text, SpBr(ss))
Else
Erg = Erg _
& Left(.Cells(zz, ss).Text & String(SpBr(ss), " "), SpBr(ss))
End If
End If
If ss < anzS Then Erg = Erg & Tz
Next ss
Erg = Erg & Tz & vbCrLf
Next zz
End With
FktTab2Txt = Left(Erg, Len(Erg) - Len(vbCrLf))
End Function
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort