AW: OT @Reinhard
Reinhard
Hallo Hübi,
jain, habe schon nachgebessert, bzw bin laufend dabei wenn ich was entdecke, aber an den Spaltenköpfenpositionen habe ich nichts bewusst geändert.
Geändert habe ich die Zeile:
anz = ThisWorkbook.Names.Count 'Anzahl der im Workbook benutzten Namen ermitteln
in
anz = ActiveWorkbook.Names.Count 'Anzahl der im Workbook benutzten Namen ermitteln
da das Makro sonst in Personl.xls die namen zählt :-)
Weiterhin habe ich die Funktion
Function SName(ByVal sp As Integer) As String
entfernt.
Anstatt dem Funktionsaufruf im Makro:
A1Name = SName(.Cells(1, s).Column)
steht dort jetzt
A1Name = Replace(.Cells(1, s).Address(0, 0), "1", "")
Anschliessend der aktuelle Code, wegen Html-Tags müssen dort dann nur noch die html-Tags korrekt geschrieben werden, also in
Mastersatz = "(pre)" & Left(Mastersatz, Len(Mastersatz) - 1) & Formeln & vbLf
die runden Klammern von "(pre)" ersetzen durch die eckigen Klammern, dito für die Codezeile vor End With.
Meine Personl.xls mit dem Code und einem Klassenmodul dass den Verweis für fm20.dll (MS Forms 2.0 Object Lib) setzt, ist hier: https://www.herber.de/bbs/user/18334.xls
Gruß
Reinhard
Sub herber()
'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 = Replace(.Cells(1, s).Address(0, 0), "1", "")
If Breite(s) < Len(A1Name) Then Breite(s) = Len(A1Name)
vor = Int((Breite(s) - Len(A1Name)) / 2)
hinter = Breite(s) - vor - Len(A1Name)
Mastersatz = Mastersatz & String(vor, " ") & A1Name & String(hinter, " ") & " "
Next s
Mastersatz = Mastersatz & vbLf
'Die Zellen der jeweiligen Zeile werden eingelesen und gemäß Spaltenbreite formatiert, dann in Mastersatz aufgenommen
For z = 1 To anzZ
For s = 1 To anzS
ZeilenSatz(z) = ZeilenSatz(z) & Right(String(Breite(s), " ") & .Cells(z, s).Value, Breite(s)) & " "
Next s
Mastersatz = Mastersatz & ZeilenSatz(z) & vbLf
Next z
Formeln = ""
For s = 1 To anzS ' alle Zellen werden geprüft ob sie Formeln enthalten
For z = 1 To anzZ
If .Cells(z, s).HasFormula Then
Formeln = Formeln & .Cells(z, s).Address(0, 0) & ": " & .Cells(z, s).FormulaLocal & vbLf
End If
Next z
Next s
If Formeln <> "" Then 'wenn es Formeln gibt
Formeln = vbLf & vbLf & "Benutzte Formeln:" & vbLf & Left(Formeln, Len(Formeln) - 1)
End If
'Formeln werden in Masteratz gelesen
Mastersatz = "(pre)" & Left(Mastersatz, Len(Mastersatz) - 1) & Formeln & vbLf
anz = ActiveWorkbook.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 < Len(ActiveWorkbook.Names.Item(n).Name) Then Länge = Len(ActiveWorkbook.Names.Item(n).Name)
Next n
'Länge = Länge + 3
For n = 1 To anz
Bezeichnungen = Bezeichnungen & Left(ActiveWorkbook.Names.Item(n).Name & String(Länge, " "), Länge) & ": "
Bezeichnungen = Bezeichnungen & ActiveWorkbook.Names.Item(n).RefersToLocal & vbLf
Next n
End If
'evtl. Bezeichnungen(Namen) werden in Mastersatz eingelesen
Mastersatz = Left(Mastersatz, Len(Mastersatz) - 1) & Bezeichnungen
Mastersatz = Mastersatz & vbLf & "Gruß" & vbLf & "Reinhard"
Mastersatz = Mastersatz & vbLf & vbLf & "Tabelle wurde eingefügt mit Code von <a href="https://www.herber.de/forum/technik/messages/1226.html"">https://www.herber.de/forum/technik/messages/1226.html"</a> & "(/pre)"
End With
'Mastersatz wird in Zwischenablage geschrieben
Set kurz = New DataObject
kurz.SetText Mastersatz
kurz.PutInClipboard
Set kurz = Nothing
End Sub