Wikipedia:Technik/Text/Basic/EXCEL-Tabellenumwandlung
For an english translation of this text please look here.
Beschreibung
Das ist Version V1x des Excel-VBA-Makros format_as_wikitable. Das Makro konvertiert einen beliebig selektierten Excel-Tabellen-Bereich in einen Wiki-Text, der dann via Zwischenablage in die Wikipedia übertragen werden kann.
Funktionsumfang
- Konvertiert einen beliebig selektierten Zellbereich ins Wiki-Tabellenformat inklusive den wesentlichen Formatierungen.
- Textauszeichnungen (Größe, Farbe, Stil (kursiv, fett, unterstrichen)) bleiben erhalten.
- Textausrichtungen innnerhalb von Zellen (horizontal und vertikal) bleiben erhalten.
- Spaltenbreiten und Zeilenhöhen bleiben erhalten.
- Im Weiteren wird die Ausgabe volumenoptimiert, d.h. für die Zellenformatierung werden keine repetitive, redundante Attributinformationen geschrieben.
- Aufgrund der inkompatiblen Konzepte bezüglich der Rahmenformatierung wird die Rahmenformatierung nicht in die Ausgabe übernommen.
Kommentare und allfällige Problemmeldungen sollten hier auf der Diskussionsseite hinterlegt werden. Sie steht auf meiner<-- wessen? --> Beobachtungsliste.
Tipps für anwendungsbezogene Formatierung in Excel
Nachfolgend wird auf einige Probleme und Grenzen in den Darstellung hingewiesen. Einen Überblick über die Darstellungsmöglichkeiten erhalten Sie hier.
Grenzen der Darstellungsmöglichkeiten
Dieses Makro verfolgt das Ziel eine Excel-Tabelle möglichst so in Wiki-Code umzuwandeln, dass die Tabelle in Wikipedia gleich dargestellt wird wie in Excel. Die Darstellungsmöglichkeiten vom Wiki-Tabellencode setzen dieser Zielsetzung in gewissen Bereichen aber Grenzen:
- Rahmenformate: In Excel kann der Rahmen jeder Zelle individuell formatiert werden. Das ist in Wiki nicht möglich. Hier erfolgt die Rahmendarstellungen einheitlich für die ganze Tabelle mittels Standardvorlage.
Vermeidung von Quellformaten, die zu unerwünschten Ergebnissen führen
Eine Excel-Tabelle, die mit VBA-Programmcode ausgelesen wird, gibt den Zelleninhalt z. T. nicht so wieder, wie er dargestellt wird. Folgende Probleme sind bekannt und können durch entsprechende explizite Formatierungen in Excel vermieden werden:
- Lokale Datumsformate werden vom Excel-Makro nicht korrekt exportiert. Eine Lösung ist nicht bekannt.
- Das Zahlenformat Standard sollte vermieden werden. Es transferiert den Zelleninhalt nicht korrekt. Die Zahl „1000“ wird z.B. dargestellt als „(1000)“.
Vermeidung von Darstellungskonflikten aufgrund unterschiedlicher Standardeinstellungen
Weiter gibt es Unterschiede in den Standardeinstellungen zwischen Excel und Wiki, welche zu implizieten Umformatierungen von Zelleninhalten führen. Diese können vermieden werden, wenn in Excel explizit formatiert wird. Dies betrifft insbesondere:
- Horizontale Ausrichtung
- Vertikale Ausrichtung
Installation
VBA-Makro
Im Prinzip: Den Makrotext in einem VBA-Modul einfügen und starten. Die folgende Anleitung kann für andere Excel-Versionen leicht abweichen:
- Mit Excel die Datei öffnen, die umgewandelt werden soll
- Den VBA-Editor öffnen (Menü: Extras/Makro/Visual-Basic-Editor) oder 'Alt-F11'
- In der linken Spalte sind die geöffneten VBA-Projekte angezeigt
- Dort auf 'VBA-Projekt' (mit dem Namen des aktuellen Dokuments, also nicht z.B. bei Eurotools!) mit der rechten Maustaste hinklicken
- Im Kontextmenü Einfügen/Modul wählen
- Im rechten großen Fenster erscheint eine leere weiße Seite (evtl. steht oben Option Explicit)
- Den gesamten Quelltext unten kopieren und in diese leere weiße Seite einfügen
- Im aktuellen Arbeitsblatt den Zellenbereich auswählen, der in eine Wiki-Tabelle konvertiert werden soll. Der Bereich darf keine verbundene Zellen enthalten.
- Das Makro ausführen
- Den Text aus dem neuen Arbeitsblatt „Wikioutput“ in die Zwischenablage kopieren und von dort in das Wikipadia-Textfeld einfügen.
- In Wikipedia die Vorschaufunktion verwenden
- Wenn Resultat befriedigend, Wiki-Text speichern
Optional: Makro als Add-in installieren
Eine Excel-Datei mit dem Makro-Code kann auch als XLA-Datei gespeichert werden. Danach kann das Makro als Add-In-Kommando verwendet werden, muss also nicht in jede neue Datei kopiert werden.
- Nachdem das Makro in einer Datei installiert und erfolgreich getestet ist, kann eine XLA-Datei erzeugt werden:
- Sinnvollerweise enthält die Datei nur ein leeres Arbeitsblatt und das Makroprojekt – alle anderen Seiten werden gelöscht.
- Speichern als XLA-Datei: Datei > speichern unter. Im Speicherdialog muss der Dateityp auf XLA geändert werden. Das ist ganz unten in der Liste (Dateityp: Microsoft Excel-Add-In (*.xla)). Der Datei einen sinnvollen Namen geben (Bsp: Writewikitable.xla). Der Pfad wird automatisch auf C:\Dokumente und Einstellungen\myUsername\Anwendungsdaten\Microsoft\AddIns eingestellt. Speichern.
- Excel schließen und erneut öffnen.
- Unter Extras > Addins erscheint nun das neue XLA. Dieser wird durch Ankreuzen aktiviert.
- Das Makro „Format_as_wikitable“ steht nun zur Vefügung – auch wenn es unter Extras > Makro > Ausführen nicht sichtbar ist.
- Natürlich ist es nun etwas mühsam, jedes Mal den Makronamen blind einzutippen – dem kann aber abgeholfen werden, indem ein benutzerdefinierter Menüeintrag definiert wird, dem dann das Makro zugeweisen wird. Danach erscheint der Befehl mit dem Makroaufruf o, Menü. Im Detail geht das so:
- Ansicht > Symbolleisten > Anpassen.., dann unter Kategorie Neues Menü den Befehl Neues Menü an den gewünschten Ort im Menü ziehen (Drag&Drop). Sinnvoll ist sicher ein Menüeintrag unter dem Extras-Menü.
- Diesem neuen Menüeintrag kann man einen sinnvollen Namen geben. Hierzu neuen Menüeintrag auswählen und im Kontextmenü, d. h. mit der rechten Maustaste anklicken. Eingabe erfolgt unter Feld Name.
- Im selben Kontextmenü kann man weiter unten das Makro Format_as_wikitable zuweisen.
- Erst wenn diese Arbeiten abgeschlossen sind, darf die Dialogbox Anpassen geschlossen werden bzw. muss jetzt geschlossen werden. Damit verlässt man die anwenderspezifischen Anpassung der Menüstruktur. Warnung: Solange die Dialogbox offen ist, funktionieren die Befehle nicht als Befehle, sondern können verschoben oder gelöscht werden. Besser man geht mit Bedacht vor und zerstört nicht die von Microsoft ausgelieferten Menüstrukturen.
- Fertig, diese Arbeiten werden als persönlichen Einstellungen automatisch gespeichert, sollten also fortan immer verfügbar sein.
VBA-Makro
'
'
' <MS-EXCEL VBA code: format_as_wikitable generates a wiki-Table from a EXCEL-cellrange>
'
' (c) Othmar Lippuner>, 2006, 2007
' Version V16; last changed 15.2.2007
'licenced under GNU GENERAL PUBLIC LICENSE at 10 April 2006 by author <Othmar Lippuner>
' GNU-License Version from 2, June 1991
'
' Everyone is permitted to copy and distribute verbatim copies
' of this license document, but changing it is not allowed.
'
'Installation:
' 1. Copy the Makrocode into a textfile FORMAT_AS_WIKITABLE.BAS
' 2. Import the macrofile FORMAT_AS_WIKITABLE_V10.BAS into a VBA-project of your EXCEL-File
'
'Usage:
' 1. Select the range you wan't to publish in EXCEL
' 2. Execute the macro FORMAT_AS_WIKITABLE
' 3. copy the complete wiki-text in outputtable WIKIOUTPUT into clipboard
' 4. paste the clipboardtext into your wikieditor
'
' The main formatting attributes of excel are converted into wiki-parameters
' Some strategies are applied to minimize the wiki-textcode generated, e.g. if possible
' attributes are written als lineparameter instead of cellparameters thus reducing
' textvolume and DB-load to the wikiservers, an increasing the readability of the tablecode
' while editing.
'
' Attributes converted
' bold
' italic
' textsize
' underline
' backgroundcolor
' textcolor
' horizontalalignment
' verticalaligment
' numberformats
'
'
' Attributes not converted
' character font just uses the standard font settings of your favortie wiki-skin
' styles
' borders just uses the standard border settings of class="wikitable"
'
' not supported features
' nested table (excel can not do that)
' connected cells in EXCEL, please dont use connected cells
' charts or any other graphical gagets
'
'
'Software Requirements
' Software is tested under EXCEL 2003, should be fine also with EXCEL-2000, its up to you to check it out
'
' Caution: Any worksheet named "wikioutput" will be deleted, recreated and then overwritten
' when executing the macro. In other words: By executing the macro 'format_as_wikitablle'
' you accept that the name and content of this worksheet is reserved to the macro
' 'format_as_wikitablle'.
'
' Version history
'
' V10 10.4.2006, released
' V11 17.4.2006, ernonous formatting corrected
' V12 26.5.2006, verify that selection is a cellrange
' V13 28.9.2006, V13: replace linebreaks in cellcontent with a Wiki-<BR>
' V14 15.2.2006, V14: empty cells get   for correct rendering of cellheight
' V15 21.4.2007 V15: class="wikitable" instead of deprected wikicoded [[Prettytable]]
'
'
' Copyright (C) <2006> <Othmar Lippuner ,Switzerland>
'
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 51 Franklin Street, Fifth Floor,
' Boston, MA 02110-1301, USA
'
'
'
' format_as_wikitablle.bas version 13, Copyright (C) Othmar Lippuner
' format_as_wikitablle.bas comes with ABSOLUTELY NO WARRANTY;
' This is free software, and you are welcome to redistribute it
' under certain conditions; consult the GNU-Public license for these
' conditions.
'
'
'
' <Othmar Lippuner>, 10 April 2006 meet me at [[:de:Benutzer Diskussion:Ollio]]
'
'
Option Explicit
Const co = 1 ' all output is written in column 1
Const VersionID = "V1.5"
Const prettytable = True
Const emptyCell_nbsp = True '<< 5.3.2007
Dim iline As Long
Dim icolumn As Long
Dim os As String
Dim oline As Long 'lineindex in outputtable
Dim iLineMax As Long
Dim iColumnMax As Long
Dim selrange As Range 'inputrange
Dim orange As Range 'outputrange
Dim outtabName As String
Dim tableformatting As String
Dim wasUnderlined As Boolean ' remember Textdecoration:underline state
' document the setting of lookahead attributation in line parameter
' if lineparameter is set then skip over cell-attributation
Dim lineattribut_borders_set As Boolean
Dim lineattribut_fontsize_set As Boolean
Dim lineattribut_bold_set As Boolean
Dim lineattribut_italic_set As Boolean
Dim lineattribut_backgroundcolor_set As Boolean
Dim lineattribut_fondcolor_set As Boolean
Dim lineattribut_Halignment_set As Boolean
Dim lineattribut_Valignment_set As Boolean
Dim lineattribut_borders As Long
Dim lineattribut_fontsize As Long
Dim lineattribut_backgroundcolor As Long
Dim lineattribut_fondcolor As Long
Dim lineattribut_Halignment As Long
Dim lineattribut_Valignment As Long
Function hexdigit(wrk As Long) As String
If wrk > 15 Then
MsgBox "illegal hexdigit value : " & wrk
Else
Select Case wrk
Case 0: hexdigit = "0"
Case 1: hexdigit = "1"
Case 2: hexdigit = "2"
Case 3: hexdigit = "3"
Case 4: hexdigit = "4"
Case 5: hexdigit = "5"
Case 6: hexdigit = "6"
Case 7: hexdigit = "7"
Case 8: hexdigit = "8"
Case 9: hexdigit = "9"
Case 10: hexdigit = "A"
Case 11: hexdigit = "B"
Case 12: hexdigit = "C"
Case 13: hexdigit = "D"
Case 14: hexdigit = "E"
Case 15: hexdigit = "F"
End Select
End If
End Function 'hexdigit
Function myhex(num As Long) As String
'konvert a 16-Bit long to HEX-String inkl fixecd leading zeros
Dim lastdivisor As Long
Dim divisor As Long
Dim wrk As Long
Dim k As Long
Dim result As String
If wrk > 16 ^ 6 Then
MsgBox "illegal hexdigit value : " & wrk
Else
lastdivisor = 1
result = ""
divisor = 16
For k = 1 To 6
wrk = (num Mod divisor) \ lastdivisor
result = hexdigit(wrk) & result
lastdivisor = divisor
If k < 7 Then ' avoid overflow
divisor = divisor * 16
End If
Next k
myhex = result
End If
End Function 'myhex
Private Sub write_tablehead()
tableformatting = " <hiddentext>generated with [[:de:Wikipedia:Helferlein/VBA-Macro for EXCEL tableconversion]] " & VersionID & "<\hiddentext>"
If prettytable Then
tableformatting = " class=" & """wikitable""" & tableformatting
End If
oline = oline + 1: orange.Cells(oline, 1) = "{|" & tableformatting
End Sub 'write_tablehead
Private Sub write_lineheader()
Dim col_lookahead As Long
Dim lineheader As String
lineattribut_borders_set = True
lineattribut_fontsize_set = True
lineattribut_bold_set = True
lineattribut_italic_set = True
lineattribut_backgroundcolor_set = True
lineattribut_fondcolor_set = True
lineattribut_Halignment_set = True
lineattribut_Valignment_set = True
' init variables for delta-detection
' xxxx lineattribut_borders = selrange.Cells(iline, 1).Borders
If Not IsNull(selrange.Cells(iline, 1).Font.Size) Then
lineattribut_fontsize = selrange.Cells(iline, 1).Font.Size
Else
lineattribut_fontsize = 10 'take default
End If
If Not IsNull(selrange.Cells(iline, 1).Font.Bold) Then
lineattribut_bold_set = selrange.Cells(iline, 1).Font.Bold
Else
lineattribut_bold_set = False
End If
If Not IsNull(selrange.Cells(iline, 1).Font.Italic) Then
lineattribut_italic_set = selrange.Cells(iline, 1).Font.Italic
Else
lineattribut_italic_set = False
End If
lineattribut_backgroundcolor = selrange.Cells(iline, 1).Interior.Color
lineattribut_fondcolor = selrange.Cells(iline, 1).Font.Color
lineattribut_Halignment = selrange.Cells(iline, 1).HorizontalAlignment
lineattribut_Valignment = selrange.Cells(iline, 1).VerticalAlignment
' loop on line for deltadectection
For col_lookahead = 2 To iColumnMax
' xxxx If lineattribut_borders <> selrange.Cells(iline, 1).Borders Then
' xxxx lineattribut_borders_set = False: End If
If Not IsNull(selrange.Cells(iline, col_lookahead).Font.Size) Then
If lineattribut_fontsize <> selrange.Cells(iline, col_lookahead).Font.Size Then
lineattribut_fontsize_set = False: End If
End If
If Not selrange.Cells(iline, col_lookahead).Font.Bold Then
lineattribut_bold_set = False: End If
If Not selrange.Cells(iline, col_lookahead).Font.Italic Then
lineattribut_italic_set = False: End If
If lineattribut_backgroundcolor <> selrange.Cells(iline, col_lookahead).Interior.Color Then
lineattribut_backgroundcolor_set = False:
End If
If lineattribut_fondcolor <> selrange.Cells(iline, col_lookahead).Font.Color Then
lineattribut_fondcolor_set = False: End If
If lineattribut_Halignment <> selrange.Cells(iline, col_lookahead).HorizontalAlignment Then
lineattribut_Halignment_set = False: End If
If lineattribut_Valignment <> selrange.Cells(iline, col_lookahead).VerticalAlignment Then
lineattribut_Valignment_set = False: End If
Next col_lookahead
lineheader = formatstring_for_a_linecontent
' write linetrailer
oline = oline + 1: orange.Cells(oline, 1) = "|- " & lineheader
End Sub 'write_lineheader
Private Sub write_linetrailer()
' write linebuffer to output ==== anyway sofare it is empty
oline = oline + 1: orange.Cells(oline, 1) = os
' flush the linebuffer
os = ""
End Sub 'write_linetrailer
Function excelHexStr2HTML(str As String) As String
Dim a_str As String
Dim b_str As String
Dim c_str As String
a_str = Left(str, 2)
c_str = Right(str, 2)
b_str = Left(Right(str, 4), 2)
excelHexStr2HTML = c_str & b_str & a_str
End Function
Private Function skip_underline(str As String) As String
Dim k As Long
Dim so As String
so = ""
' skip unwanted underscores in EXCEL-transforms
For k = 1 To Len(str)
If Mid$(str, k, 1) <> "_" Then
so = so & Mid$(str, k, 1)
End If
Next k
skip_underline = so
End Function
Private Function process_cellcontent(cellcontent As String) As String
Const verbose = False
Dim hyperlink As String
'dont use .NumberFormatlocal because it
' returns wrong Dateformatstrings "[$-807]TTTT, T. MMMM JJJJ"; instead of "TTTT, T. MMMM JJJJ;" that won't work with format
With selrange.Cells(iline, icolumn)
If verbose Then
Debug.Print iline; "/"; icolumn, .NumberFormat, .value
End If
If .NumberFormat <> "General" And .NumberFormat <> "Standard" Then
cellcontent = skip_underline(Format(.value, .NumberFormat))
Else
If cellcontent = "" Then '<< 15.2.2007
If Not emptyCell_nbsp Then '<< 05.3.2007
cellcontent = " " '<< 05.3.2007
Else '<< 05.3.2007
cellcontent = " " '<< 15.2.2007
End If '<< 05.3.2007
Else
cellcontent = cellcontent
End If '<< 15.2.2007
End If
' Process hyperlinks
'----------------------------------------
If .Hyperlinks.Count > 0 Then
hyperlink = .Hyperlinks(1).Address
If Len(WorksheetFunction.Substitute(hyperlink, "http://", "")) <> Len(hyperlink) Then 'There may be a neater way to do this
cellcontent = " [" & hyperlink & " " & cellcontent & "]" 'http link
Else
cellcontent = " [[" & hyperlink & "|" & cellcontent & "]]" 'assume that anything without http is a local wiki link
End If
End If
End With
' V13: replace linebreaks in cellcentent with a Wiku-<BR> to avoid havoc in wiki-rendering
' thanks feedback of ManWing2, 26. Sep 2006
process_cellcontent = Replace(cellcontent, vbLf, "<BR>")
End Function
Private Sub writefirstlinecell(colnr As Long)
With selrange.Cells(iline, icolumn)
If .MergeArea.Column = .Column And .MergeArea.row = .row Then
oline = oline + 1: orange.Cells(oline, 1) = formatstring_for_a_cellcontent(True, colnr = 1) & " | " & _
process_cellcontent(selrange.Cells(iline, icolumn))
End If
End With
End Sub
Private Sub writecell(colnr As Long)
With selrange.Cells(iline, icolumn)
If .MergeArea.Column = .Column And .MergeArea.row = .row Then
oline = oline + 1: orange.Cells(oline, 1) = formatstring_for_a_cellcontent(False, colnr = 1) & " | " & _
process_cellcontent(selrange.Cells(iline, icolumn))
End If
End With
End Sub
Private Sub write_tabletail()
oline = oline + 1: orange.Cells(oline, 1) = "|}"
End Sub
Function doublequotestring(str As String, Placeholderchar As String) As String
Dim k As Long
Dim so As String
so = ""
For k = 1 To Len(str)
If Mid$(str, k, 1) = Left(Placeholderchar, 1) Then
so = so & """"
Else
so = so & Mid$(str, k, 1)
End If
Next k
doublequotestring = so
End Function
Function WorksheetExits(tabname As String) As Boolean
Dim found As Boolean
found = False
On Error GoTo err_exit
Worksheets(tabname).Select
found = True
err_exit:
WorksheetExits = found
End Function 'WorksheetExits
Public Sub Format_as_wikitable()
' implicit parameter: selected range
' writes the output into table: wikioutput
' caution if this table exists it is deleted !!!
If Not TypeOf Selection Is Range Then
MsgBox "Error: You must select a cellrange, to convert to a wiki-table, but you " _
& vbCrLf & " have selected a " & TypeName(Selection)
Else
Set selrange = Selection
wasUnderlined = False
iLineMax = selrange.Rows.Count
iColumnMax = selrange.Columns.Count
outtabName = "wikioutput"
If WorksheetExits(outtabName) Then
Worksheets(outtabName).Delete
End If
oline = 0
' create output worksheet
Worksheets.Add 'always added at first place (?)
Worksheets(1).name = outtabName
Worksheets("wikioutput").Select
Set orange = ActiveSheet.Range(Cells(1, 1), Cells(65353, 1))
orange.Select
'( Rows(65534), Columns(1))
write_tablehead
For iline = 1 To iLineMax
write_lineheader
For icolumn = 1 To iColumnMax
If iline = 1 Then
writefirstlinecell (icolumn)
Else
writecell (icolumn)
End If
Next icolumn
write_linetrailer
Next iline
write_tabletail
End If 'Not TypeOf selrange Is Range Then
End Sub
Function formatstring_for_a_cellcontent(firstline As Boolean, firstrow As Boolean) As String
Dim str As String
Dim stylestring As String
Dim attribute_String As String
Dim colhexval As String
Dim prop As String
stylestring = ""
attribute_String = ""
With selrange.Cells(iline, icolumn)
' Determine backgroundcolor_prop
'----------------------------------------
If Not lineattribut_backgroundcolor_set Then
colhexval = excelHexStr2HTML(myhex(.Interior.Color))
prop = "@background-color:#" & colhexval
' Apply backgroundcolor_prop to Stylestring
If colhexval <> "FFFFFF" Then 'don't write defaultvalue for white, to help to save wikidb-tablespace
If stylestring = "" Then
stylestring = prop
Else
stylestring = stylestring & ";" & prop
End If
End If
End If
' Determine Borders_prop
'----------------------------------------
'.Borders
' do something
' Determine Width_prop
'----------------------------------------
If firstline Then
prop = "width=@" & .Width & "@"
' Apply Width_prop to Stylestring
attribute_String = attribute_String & " " & prop
End If
' Determine Colspan_prop
'----------------------------------------
If .MergeArea.Columns.Count > 1 Then
prop = "colspan=@" & .MergeArea.Columns.Count & "@"
attribute_String = attribute_String & " " & prop
End If
' Determine Rowspan_prop
'----------------------------------------
If .MergeArea.Rows.Count > 1 Then
prop = "rowspan=@" & .MergeArea.Rows.Count & "@"
attribute_String = attribute_String & " " & prop
End If
' Determine Font_prop
'========================================
'.Font
' Determine Font prop font.size
'----------------------------------------
With .Font
If Not IsNull(.Size) And .Size <> 10 And Not lineattribut_fontsize_set Then ' trapped ISnull-Condition and ignore standard fontsize
prop = "font-size:" & .Size
If stylestring = "" Then
stylestring = "@" & prop & "pt"
Else
stylestring = stylestring & ";" & prop & "pt"
End If
End If
' Determine Font prop font.bold
'----------------------------------------
If .Bold And Not lineattribut_bold_set Then
prop = "font-weight:bold"
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
' Determine Font prop underline
'----------------------------------------
If .Italic Then
prop = "font-style:Italic"
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
' Determine Font prop font.italic
'----------------------------------------
If .Underline = xlUnderlineStyleNone And Not lineattribut_italic_set Then ' toggle switch off
If wasUnderlined Then ' toggle switch off
prop = "text-decoration:none"
wasUnderlined = False ' toggle switch on
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
Else '.Underline <> xlUnderlineStyleNone
If Not wasUnderlined Then
prop = "text-decoration:underline"
wasUnderlined = True ' toggle switch on
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
End If
' Determine Color prop font.color
'----------------------------------------
If Not IsNull(.Color) And .Color <> 0 And Not lineattribut_fondcolor_set Then ' trapped ISnull-Condition and ignore standard color
prop = "color:#" & excelHexStr2HTML(myhex(.Color))
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
End With
' Determine Height_prop
'----------------------------------------
' .Height
If firstrow Then
prop = "Height=@" & .Height & "@"
' Apply Width_prop to Stylestring
attribute_String = attribute_String & " " & prop
End If
' Determine HorizontalAlignment_prop
'----------------------------------------
'.HorizontalAlignment
If .HorizontalAlignment <> xlHAlignLeft And Not lineattribut_Halignment_set Then ' dont write the default
prop = ""
Select Case .HorizontalAlignment
Case xlHAlignRight: prop = "align=@right@"
Case xlHAlignCenter: prop = "align=@center@"
End Select
' Apply Width_prop to Stylestring
attribute_String = attribute_String & " " & prop
End If
' Determine VerticalAlignment_prop
'----------------------------------------
If .VerticalAlignment <> xlVAlignCenter And Not lineattribut_Halignment_set Then ' dont write the default
prop = ""
Select Case .VerticalAlignment
Case xlVAlignTop: prop = "valign=@top@"
Case xlVAlignBottom: prop = "valign=@bottom@"
End Select
' Apply Width_prop to Stylestring
attribute_String = attribute_String & " " & prop
End If
' Determine IndentLevel_prop
'----------------------------------------
'.IndentLevel >> maybe later to come
' Determine Style_prop
'----------------------------------------
'.Style >> maybe later to come
'----------------------------------------
'.WrapText << Attribut is wiki not relevant, while unconditional default
'----------------------------------------
'
If stylestring <> "" Then
str = doublequotestring("style=" & stylestring & "@", "@")
End If
str = str & doublequotestring(attribute_String, "@")
End With
If str <> "" Then
str = "|" & str
End If
formatstring_for_a_cellcontent = str
End Function 'formatstring_for_a_cellcontent
Function formatstring_for_a_linecontent() As String
Dim prop As String
Dim stylestring As String
Dim colhexval As String
Dim attribute_String As String
Dim ostr As String
With selrange.Cells(iline, 1) 'take first column as reference
' Determine backgroundcolor_prop
'----------------------------------------
If lineattribut_backgroundcolor_set Then
colhexval = excelHexStr2HTML(myhex(.Interior.Color))
prop = "@background-color:#" & colhexval
' Apply backgroundcolor_prop to Stylestring
If colhexval <> "FFFFFF" Then 'don't write defaultvalue for white, to help to save wikidb-tablespace
If stylestring = "" Then
stylestring = prop
Else
stylestring = stylestring & ";" & prop
End If
End If
End If
' Determine Borders_prop
'----------------------------------------
'.Borders
' do something
' Determine Font_prop
'========================================
'.Font
' Determine Font prop font.size
'----------------------------------------
With .Font
If Not IsNull(.Size) And .Size <> 10 And lineattribut_fontsize_set Then ' trapped ISnull-Condition and ignore standard fontsize
prop = "font-size:" & .Size
If stylestring = "" Then
stylestring = "@" & prop & "pt"
Else
stylestring = stylestring & ";" & prop & "pt"
End If
End If
' Determine Font prop font.bold
'----------------------------------------
If lineattribut_bold_set Then
prop = "font-weight:bold"
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
' Determine Font prop underline
'----------------------------------------
If lineattribut_italic_set Then
prop = "font-style:Italic"
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
' Determine Font prop font.italic
'----------------------------------------
If lineattribut_italic_set Then ' toggle switch off
prop = "text-decoration:underline"
wasUnderlined = True ' toggle switch on
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
' Determine Color prop font.color
'----------------------------------------
If Not IsNull(.Color) And .Color <> 0 And lineattribut_fondcolor_set Then ' trapped ISnull-Condition and ignore standard color
prop = "color:#" & excelHexStr2HTML(myhex(.Color))
If stylestring = "" Then
stylestring = "@" & prop
Else
stylestring = stylestring & ";" & prop
End If
End If
End With
' Determine Height_prop
'----------------------------------------
' Determine HorizontalAlignment_prop
'----------------------------------------
'.HorizontalAlignment
If .HorizontalAlignment <> xlHAlignLeft And lineattribut_Halignment_set Then ' dont write the default
prop = ""
Select Case .HorizontalAlignment
Case xlHAlignRight: prop = "align=@right@"
Case xlHAlignCenter: prop = "align=@center@"
End Select
' Apply Width_prop to Stylestring
attribute_String = attribute_String & " " & prop
End If
' Determine VerticalAlignment_prop
'----------------------------------------
If .VerticalAlignment <> xlVAlignCenter And lineattribut_Halignment_set Then ' dont write the default
prop = ""
Select Case .VerticalAlignment
Case xlVAlignTop: prop = "valign=@top@"
Case xlVAlignBottom: prop = "valign=@bottom@"
End Select
' Apply Width_prop to Stylestring
attribute_String = attribute_String & " " & prop
End If
' Determine IndentLevel_prop
'----------------------------------------
'.IndentLevel >> maybe later to come
' Determine Style_prop
'----------------------------------------
'.Style >> maybe later to come
'----------------------------------------
'.WrapText << Attribut is wiki not relevant, while unconditional default
'----------------------------------------
'
If stylestring <> "" Then
ostr = doublequotestring("style=" & stylestring & "@", "@")
End If
ostr = ostr & doublequotestring(attribute_String, "@")
End With
'If ostr <> "" Then
' ostr = "|" & ostr
'End If
formatstring_for_a_linecontent = ostr
End Function 'formatstring_for_a_linecontent