Tabellen formatieren um sie hier zu posten

Reinhard_fb8cb7 · 2. Februar 2005 um 20:17

Hallo Interessierte,
nachfolgend habe ich einen Code gebastelt, der hilfreich sein kann wenn man hier Tabellenausschnitte samt Formeln zum bessern Verständnis von Fragen/Antworten reinstellen will.

Die Anwendung ist simpel,

I) in der Tabelle den gewünschten Bereich markieren,
II) das Makro www() ausführen lassen
(durch tastenkombination, Extras–Makro–Makros–Ausführen oder mit F5 diekt im VB-Editor.

Ist ein Prototyp, grade aus dem Boden gestampft also nicht meckern wenn was nicht klappt, andrerseits jde Rückmeldung zwecks Verbesserung ist mir lieb. Natürlich können auch andere den Code verfeinern.

Und zum Ausprobieren, einfach auf beliebige Frage antworten, Makro benutzen und dann hier Strg-V, dann hier auf Vorschau klicken.
Falls dann mal aus Versehen der Beirag abgeschickt worden ist, unbeantwortete Beiträge kann man selbst wieder löschen:smile:
Gruß
Reinhard
(Alt+F11, Einfügen Modul, Code reinkopieren, Editor schliessen)

Sub www()
With Selection
 anzS = .Columns.Count
 anzZ = .Rows.Count
 ReDim Breite(anzS)
 ReDim Satz(anzZ)
 For s = 1 To anzS
 Breite(s) = 0
 For z = 1 To anzZ
 If Len(.Cells(z, s).Value) \> Breite(s) Then
 Breite(s) = Len(.Cells(z, s).Value)
 End If
 Next z
 Next s
 For z = 1 To anzZ
 Satz(z) = Right(" " & .Cells(z, 1).Row, Len(.Cells(anzZ, 1).Row)) & " "
 'Satz(z) = "" & Satz(z) & ""
 Next z
 Mastersatz = Mastersatz & "Tabellenblattname: " & ActiveSheet.Name & vbLf & vbLf
 Mastersatz = Mastersatz & " " & String(Len(.Cells(anzZ, 1).Row), " ")
 For s = 1 To anzS
 A1Name = SName(.Cells(1, s).Column)
 If Breite(s) " & A1Name & "" & String(hinter, " ") & " "
 Mastersatz = Mastersatz & String(vor, " ") & A1Name & String(hinter, " ") & " "
 Next s
 Mastersatz = Mastersatz & vbLf
 For z = 1 To anzZ
 For s = 1 To anzS
 Satz(z) = Satz(z) & Right(String(Breite(s), " ") & .Cells(z, s).Value, Breite(s)) & " "
 Next s
 Mastersatz = Mastersatz & Satz(z) & vbLf
 Next z
 Formeln = ""
 For z = 1 To anzZ
 For s = 1 To anzS
 If .Cells(z, s).HasFormula Then
 Formeln = Formeln & .Cells(z, s).Address(0, 0) & ": " & .Cells(z, s).FormulaLocal & vbLf
 End If
 Next s
 Next z
 If Formeln "" Then Formeln = vbLf & vbLf & "Benutzte Formeln:" & vbLf & Left(Formeln, Len(Formeln) - 1)
 Mastersatz = "

    " & Left(Mastersatz, Len(Mastersatz) - 1) & Formeln & "

"
End With
Set kurz = New DataObject
kurz.SetText Mastersatz
kurz.PutInClipboard
Set kurz = Nothing
End Sub

Function SName(ByVal sp As Integer) As String
If sp

Reinhard_fb8cb7 · 2. Februar 2005 um 21:06

Nachtrag wegen den Html-Tags
Nochma ich *g,
leider fand ich keine Möglichkeit die im Code stehenden Html-Tags sichtbar zu machen, wer-weiss-was führt sie aus, somit werden sie nicht angezeigt.
3, bzw letztlich nur 1 Zeile ist zu korrigieren.
Die Zeile 17 muss lauten:
'Satz(z) = „STRONG“ & Satz(z) & „/STRONG“
Die Zeile 26 muss lauten:
'Mastersatz = Mastersatz & String(vor, " ") & „STRONG“ & A1Name & „/STRONG“ & String(hinter, " ") & " "
Aber beide sind sowieso auf Remark gesetzt.
Wichtiger ist Zeile 2 Zeilen oberhalb von „End With“, sie muss lauten:
Mastersatz = „PRE“ & Left(Mastersatz, Len(Mastersatz) - 1) & Formeln & „/PRE“

Bei STRONG, /STRONG, PRE /PRE gilt, jewils direkt davor muss der eckige Pfeil (neben Y) nach links, und direkt dahinter der eckige Pfeil nach rechts eingegeben werden, alles innerhalb der Anführungszeichen. Klein/Groß von strong usw ist egal.
Gruß
Reinhard

Franz_e6478d · 2. Februar 2005 um 22:29

Hallo Reinhard,

Für alle die sehen möchten, wie das Ergebnis aussieht, hier ein Beispiel, das mit dem Makro erzeugt wurde.

Tabellenblattname: Tabelle1

 A B C D 
1 Variable1 Variable2 Produkt Bemerkung 
2 2 4 68 A 
3 4 8 92 B 
4 6 12 132 C 
5 8 16 188 D 

Benutzte Formeln:
C2: =PRODUKT(A2:B2)+SUMME($A$2:blush:B$5)
C3: =PRODUKT(A3:B3)+SUMME($A$2:blush:B$5)
C4: =PRODUKT(A4:B4)+SUMME($A$2:blush:B$5)
C5: =PRODUKT(A5:B5)+SUMME($A$2:blush:B$5)

Das gibt ein dickes Sternchen!

Gruß Franz

Reinhard_fb8cb7 · 2. Februar 2005 um 23:28

Danke für die Rückmeldung
Hallo Franz,
ich habe dann für mich noch unten angehängt:
MasterSatz=MasterSatz & „Gruß“ & vbLF & „Reinhard“.
Naja, weisst schon was ich meine, spart letztlich Zeit.
Gruß
Reinhard

Daniel01_59b322 · 3. Februar 2005 um 07:56

Hallo Reinhard,

coole Sache, noch 2 kleine Anmerkungen:

Den Code kann man etwas einfacher übernehmen wenn man zuvor das ganze Posting abspeichert. Dann bleiben im oberen Teil die Zeilenwechsel erhalten und auch die HTML-Tags. Mann muss dann nur noch die Stellen, an denen 1 Anweisung über 2 Zeilen geht wieder zusammenschieben, aber dank Syntaxhighlighting im VBA-Editor kein Problem.
Für Option Explicit-Fans (wie mich) wäre es nett, alle Variablen zu deklarieren, bei mir sieht das jetzt so aus:
Dim anzS%, anzZ%, s%, z%, Mastersatz$, A1Name$, vor%, hinter%, Formeln$
Dim kurz As DataObject

Aber ansonsten: Klasse Tool, kann man vielleicht sogar in eine FAQ hier aufnehmen, denn ich denke das Problem mit dem Posten von Tabellen haben sicherlich viele mal.

Gruß
Daniel

Reinhard_fb8cb7 · 15. Februar 2005 um 16:12

Hi Daniel,
der Artikel an sich ist schon im Archiv, nr du bist noch anklickbar, deshalb schreibe ich es hier.
Danke für dein Interesse.
Grundsätzlich , sollte sich das programm aufhängen an der Stelle:
Set kurz =…
bzw wenn man dein Dim nimmt an der Stelle:
Dim kurz as
so liegt das an fehlendem Verweis auf Microsoft Forms 2.0
(Im Vb-Editor unter Extras–Verweise erreichbar,
oder per vba mit
Application.VBE.ActiveVBProject.References.AddFromFile „fm20.dll“
Gruß
Reinhard

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

Reinhard_fb8cb7 · 15. Februar 2005 um 21:19

leicht verbesserte Version

Option Explicit
Sub www()
'Programm zum formatierten Einfügen von kleinen Beispieltabellen in wer-weiss-was
'Es werden auch benutzte Formeln und Namen aufgelistet
'Februar2005 Reinhard
'Im VBA-EDitor muss über Extras---Verweise der Verweis auf MS Forms2.0 Object Library
'gesetzt sein, sonst Fehlermeldung bei Dim kurz as DataObject
'Anwendung der Sub ist einfach, in Tabelle gewünschten Bereich markieren,
'Makro ausführen, dann in wer-weiss-was mit Strg+V einfügen
'In den Remarks ist mit positionieren oder/und formatieren das Einfügen von Leerzeichen gemeint
Dim anzS As Integer, s As Integer, anzZ As Long, z As Long
Dim ZeilenSatz() As String, Breite() As Integer, Mastersatz As String, A1Name As String
Dim vor As Integer, hinter As Integer
Dim Formeln As String, Bezeichnungen As String
Dim anz As Integer, n As Integer, Länge As Integer
Dim kurz As DataObject
With Selection
 anzS = .Columns.Count 'Anzahl Spalten im markierten Tabellenbereich
 anzZ = .Rows.Count 'Anzahl der Zeilen
 ReDim Breite(anzS) 'jede Spalte hat eine Breite
 ReDim ZeilenSatz(anzZ) 'aus der Zeile plus Füll-Leerzeichen wird ein Zeilensatz
 For s = 1 To anzS 'Schleife um pro Spalte die jeweilig höchste Breite zu ermitteln
 Breite(s) = 0
 For z = 1 To anzZ
 If Len(.Cells(z, s).Value) \> Breite(s) Then
 Breite(s) = Len(.Cells(z, s).Value)
 End If
 Next z
 Next s
 For z = 1 To anzZ 'die zeilennummer in jedem Zeilensatz wird generiert und formatiert
 ZeilenSatz(z) = Right(" " & .Cells(z, 1).Row, Len(.Cells(anzZ, 1).Row)) & " "
 Next z
 'MasterSatz wird mit Blattnamen gefüllt
 Mastersatz = "Tabellenblattname: " & ActiveSheet.Name & vbLf & vbLf
 'Mastersatz wird positioniert um A B C usw aufzunehmen
 Mastersatz = Mastersatz & " " & String(Len(.Cells(anzZ, 1).Row), " ")
 For s = 1 To anzS 'In MasterSatz werden die Spaltenbezeichnungen aufgrund ihrer Spaltenbreite eingefügt
 A1Name = SName(.Cells(1, s).Column)
 If Breite(s) "" Then 'wenn es Formeln gibt
 Formeln = vbLf & vbLf & "Benutzte Formeln:" & vbLf & Left(Formeln, Len(Formeln) - 1)
 End If
 'Formeln werden in Masteratz gelesen
 Mastersatz = "

    " & Left(Mastersatz, Len(Mastersatz) - 1) & Formeln & vbLf
     anz = ThisWorkbook.Names.Count 'Anzahl der im Workbook benutzten Namen ermitteln
     If anz \>= 1 Then 'Wenn es Namen gibt
     Bezeichnungen = vbLf & vbLf & "Namen in der Tabelle:" & vbLf
     Länge = Len(ActiveWorkbook.Names.Item(1).Name)
     For n = 1 To anz
     If Länge "
    End With
    'Mastersatz wird in Zwischenablage geschrieben
    Set kurz = New DataObject
    kurz.SetText Mastersatz
    kurz.PutInClipboard
    Set kurz = Nothing
    End Sub
    Function SName(ByVal sp As Integer) As String
    'Ermittlung der Spaltenbezeichnung A...IV aus der Spaltennummer 1...256
    If sp

Carola_a66a15 · 21. Februar 2005 um 13:44

Das ist ein Test …

A B C
1 10 30
2 15 45
3 20 60

Benutzte Formeln:
C1: =SUMME(B1*3)
C2: =SUMME(B2*3)
C3: =SUMME(B3*3)

Hallo Reinhard … BRAVO und Danke
Gruß Carola