Excel-Tabellen in HTML konvertieren, Teil 2

mt

Formatierung der Tabellenzellen in Excel ermitteln

Variablen-Typ für Zelleigenschaften

Für die interne Speicherung der Format-Informationen der einzelnen Tabellenzellen wird ein benutzerdefinierter Typ vereinbart. Das ermöglicht die kompakte Verarbeitung aller notwendigen Zelleigenschaften.

Hier der benutzerdefinierte Typ:

Type usrBorderItem
vTop As Variant
vLeft As Variant
vBottom As Variant
vRight As Variant
End Type

Type usrRangeFormat
lFontColor As Long
iFontColorIndex As Integer

bFontBold As Boolean
bFontItalic As Boolean

vFontSize As Variant

vFontName As Variant

lInteriorColor As Long
iInteriorColorIndex As Integer
iRangePixelWidth As Integer
dRangePointsWidth As Double
dRangeCharsWidth As Double

iRangePixelHeight As Integer
dRangePointsHeight As Double
dRangeCharsHeight As Double

lBorderColor As Long
vBorderColor As usrBorderItem
vBorderColorIndex As usrBorderItem
iBorderPixelWidth As Integer
vBorderWeight As usrBorderItem
strBorderLineStyle As String
vBorderLineStyle As usrBorderItem
End Type

Funktion GetRangeFormatInfo(…)

Für die Ermittlung der Formateigenschaften der einzelnen Tabellenzellen wird die Funktion GetRangeFormatInfo benutzt.

'**
'** Informationen zur Zellformatierung holen
'**
Function GetRangeFormatInfo(ByRef rngRange As Object, ByRef usrRangeFormat As usrRangeFormat)
    With usrRangeFormat
        If Not IsNull(rngRange.Font.Color) Then
            .lFontColor = GetColorRGBdez(rngRange.Font.Color)
        Else
            .lFontColor = 0
        End If
        If Not IsNull(rngRange.Font.Bold) Then
            .bFontBold = rngRange.Font.Bold
        Else
            .bFontBold = False
        End If
        If Not IsNull(rngRange.Font.Italic) Then
            .bFontItalic = rngRange.Font.Italic
        Else
            .bFontItalic = False
        End If
        If Not IsNull(rngRange.Font.Size) Then
            .vFontSize = rngRange.Font.Size
        Else
            .vFontSize = 11
        End If
        If Not IsNull(rngRange.Font.Name) Then
            .vFontName = rngRange.Font.Name
        Else
            .vFontName = "Arial"
        End If
        .lInteriorColor = GetColorRGBdez(rngRange.Interior.Color)
        .dRangeCharsWidth = GetCellCharsWidth(rngRange)
        .iRangePixelWidth = GetCellPixelWidth(rngRange, 96)
        .dRangeCharsHeight = GetCellCharsHeight(rngRange)
        .iRangePixelHeight = GetCellPixelHeight(rngRange, 96)
        .lBorderColor = GetColorRGBdez(rngRange.Borders.Color)
        With .vBorderColor
            .vBottom = GetColorRGBdez(rngRange.Borders.Item(xlEdgeBottom).Color)
            .vLeft = GetColorRGBdez(rngRange.Borders.Item(xlEdgeLeft).Color)
            .vRight = GetColorRGBdez(rngRange.Borders.Item(xlEdgeRight).Color)
            .vTop = GetColorRGBdez(rngRange.Borders.Item(xlEdgeTop).Color)
        End With
        .strBorderLineStyle = GetLineStyle(rngRange.Borders.LineStyle)
        With .vBorderLineStyle
            .vBottom = rngRange.Borders.Item(xlEdgeBottom).LineStyle
            .vLeft = rngRange.Borders.Item(xlEdgeLeft).LineStyle
            .vRight = rngRange.Borders.Item(xlEdgeRight).LineStyle
            .vTop = rngRange.Borders.Item(xlEdgeTop).LineStyle
        End With
        .iBorderPixelWidth = GetPixelWidth(rngRange.Borders.Weight)
        With .vBorderWeight
            .vBottom = GetPixelWidth(rngRange.Borders.Item(xlEdgeBottom).Weight)
            .vLeft = GetPixelWidth(rngRange.Borders.Item(xlEdgeLeft).Weight)
            .vRight = GetPixelWidth(rngRange.Borders.Item(xlEdgeRight).Weight)
            .vTop = GetPixelWidth(rngRange.Borders.Item(xlEdgeTop).Weight)
        End With
    End With
End Function

nach oben⇑

Schriftstile ermitteln

        If Not IsNull(rngRange.Font.Bold) Then
            .bFontBold = rngRange.Font.Bold
        Else
            .bFontBold = False
        End If
        If Not IsNull(rngRange.Font.Italic) Then
            .bFontItalic = rngRange.Font.Italic
        Else
            .bFontItalic = False
        End If

In der vorliegenden Version des Makros werden nur die Schriftstile „fett“ (rngRange.Font.Bold) und „kursiv“ (rngRange.Font.Italic)  ausgewertet und als CSS-Eigenschaft eingefügt. Die Schriftstile werden in Excel im Datentyp Boolean gespeichert. Abhängig vom ausgewähltem Bereich kann es vorkommen das die beiden Werte undefiniert sind und den Wert Null liefern. Das muss bei der Wertzuweisung abgefangen werden.

nach oben⇑

Schriftgröße und Font ermitteln

        If Not IsNull(rngRange.Font.Size) Then
            .vFontSize = rngRange.Font.Size
        Else
            .vFontSize = 11
        End If
        If Not IsNull(rngRange.Font.Name) Then
            .vFontName = rngRange.Font.Name
        Else
            .vFontName = "Arial"
        End If

Excel liefert die Zeichengröße in Punkten (Points). Der Bezugswert sind 72 Pixel/Inch. Im Makro erfolgt die Umrechnung mit einer Bildschirmauflösung von 96 Pixel/Inch. Für die Festlegung der Schriftgröße über font-size in Pixeln wird deshalb Round(usrFormatInfo.vFontSize * vScreenRes / 72) verwendet. vScreenRes ist 96 Pixel/Inch.

nach oben⇑

Spaltenbreite und Zeilenhöhe

Function GetCellPixelWidth(ByRef rngRange As Range, ByVal iScreenResolution As Integer)
Dim vRangePoints, vRangeChars, vRangePixels As Variant
vRangeChars = 0
vRangePoints = 0
    If Not IsNull(rngRange.Width) Then
        vRangePoints = rngRange.Width
    End If
    If Not IsNull(rngRange.ColumnWidth) Then
        vRangeChars = rngRange.ColumnWidth
    End If
    vRangePixels = (vRangePoints / 72) * iScreenResolution 'pixel width of column
    GetCellPixelWidth = vRangePixels
End Function

Function GetCellPixelHeight(ByRef rngRange As Range, ByVal iScreenResolution As Integer)
Dim vRangePoints, vRangeChars, vRangePixels As Variant
vRangeChars = 0
vRangePoints = 0
    If Not IsNull(rngRange.Height) Then
        vRangePoints = rngRange.Height
    End If
    If Not IsNull(rngRange.RowHeight) Then
        vRangeChars = rngRange.RowHeight
    End If
    vRangePixels = (vRangePoints / 72) * iScreenResolution 'pixel width of column
    GetCellPixelHeight = vRangePixels
End Function

Excel liefert die Spaltenbreite in Punkten in Width und die Zeilenhöhe in Punkten in Height. Die Umrechnung von Punkten in Pixel erfolgt auf gleiche Weise, wie zuvor bei der Schriftgröße.

nach oben⇑

Farben ermitteln

Um die Farben als echten Farbwert zu erhalten, der dann als RGB-Wert in CSS eingebunden werden kann, muss man die Eigenschaft Color auswerten. Für die Verwendung im Style-Sheet muss der Farbwert umgeformt werden. Das leistet die Funktion GetColorRGBdez.

Private Function lGetColorRGBdez(ByVal lColor As Long) As Long
Dim strHelp1, strHelp2 As String
Dim lFarbwert As Long
    strHelp1 = Hex(lColor)
    strHelp1 = Application.WorksheetFunction.Dec2Hex(lColor, 6)
    strHelp2 = Mid(strHelp1, 5, 2) & Mid(strHelp1, 3, 2) & Mid(strHelp1, 1, 2)
    lFarbwert = Application.WorksheetFunction.Hex2Dec(strHelp2)
    GetColorRGBdez = lFarbwert
End Function

nach oben⇑

Rahmenbreiten

Excel liefert Rahmenbreiten nicht in Pixeln oder Punkten, sondern hat fest definierten Breiten, die als VBA-Konstanten geliefert werden. Mit der Funktion GetPixelWidth werden entsprechende Werte in Pixeln fest zugewiesen.

Private Function vGetPixelWidth(ByVal vWeight As Variant) As Variant
    Select Case vWeight
        Case xlHairline:
            GetPixelWidth = 1
        Case xlMedium:
            GetPixelWidth = 2
        Case xlThick:
            GetPixelWidth = 4
        Case xlThin:
            GetPixelWidth = 1
        Case Else
            GetPixelWidth = 0
    End Select
End Function

Linienstile der Rahmen

Linienstile können nur mit Einschränkungen von Excel übernommen werde, da mit CSS weniger Varianten zur Verfügung stehen. Excel codiert die Linienstile über VBA-Konstanten. Die Funktion vGetLineStyle setzt die Werte in CSS-Eigenschaften um.

Private Function vGetLineStyle(ByVal vLineStyle As Variant) As Variant
    Select Case vLineStyle
        Case xlContinuous:
            vGetLineStyle = "solid"
        Case xlDash:
            vGetLineStyle = "dashed"
        Case xlDashDotDot:
            vGetLineStyle = "dotted"
        Case xlDot:
            vGetLineStyle = "dotted"
        Case xlDouble:
            vGetLineStyle = "double"
        Case xlLineStyleNone:
            vGetLineStyle = "none"
        Case xlSlantDashDot:
            vGetLineStyle = "groove"
        Case Else
            vGetLineStyle = "none"
    End Select
End Function

nach oben⇑

Das komplette Makro

Makro für HTML5

Das komplette Makro Excel2HTML5(usrHTML5-Tabellen-V0.3) gibt es hier.

Im Excel-VBA-Editor kann die Datei als Modul importiert werde. Vorsicht ist mit dem bTestFlag geboten. Wenn es auf TRUE gesetzt wird, werden Testausgaben ins aktive Tabellenblatt geschrieben. Das kann zur Zerstörung des Inhaltes führen.

nach oben⇑

Makro für (X)HTML

Das komplette Makro Exce2HTML (usrXHTMLTabellen-V0.3) gibt es hier.

Im Excel-VBA-Editor kann die Datei als Modul importiert werde. Vorsicht ist mit dem bTestFlag geboten. Wenn es auf TRUE gesetzt wird, werden Testausgaben ins aktive Tabellenblatt geschrieben. Das kann zur Zerstörung des Inhaltes führen.

Rahmen-Makro zum Aufruf in Excel

 

Optimierungen – Reduzierung der Zeichenzahl des HTML-Codes

CSS-Eigenschaften die sich auf Container bzw. Boxen beziehen und damit vier verschiedene Werte erhalten können, dürfen in CSS in verkürzter Schreibweise angegeben werden. Das gilt zum Beispiel für border, border-color, border-style, border-width, margin, padding etc. Bei der verkürzten Schreibweise werden die Eigenschaften vom Browser je nach Anzahl der Werte zugewiesen.

Es gilt:

  • Eine Angabe/Wert: für alle 4 Eigenschaften gilt derselbe Wert, die selbe Angabe
  • Zwei Angaben/Werte: 1. Wert für oben und unten, eigenschaft-top und eigenschaft-bottom, 2. Wert für links und rechts, eigenschaft-left und eigenschaft-right
  • Drei Angaben/Werte: 1. Wert für oben, eigenschaft-top, 2. Wert für links und rechts, eigenschaft-left und eigenschaft-right, 3. Wert für unten, eigenschaft-bottom
  • Vier Angaben/Werte: 1. Wert für oben, eigenschaft-top, 2. Wert für rechts, eigenschaft-right, 3. Wert für unten, eigenschaft-bottom, 4. Wert für links, eigenschaft-left

Die folgenden Funktionen prüfen die aus Excel ermittelten Eigenschaften und liefern jeweils eine Zeichenkette mit den notwendigen Angaben für die CSS-Eigenschaft.

Rahmenfarben in verkürzter Schreibweise

Private Function strGetColorCSS(ByRef usrRangeFormat As usrRangeFormat) As String
Dim lColorTop, lColorRight, lColorBottom, lColorLeft As Long
    lColorTop = usrRangeFormat.vBorderColor.vTop
    lColorRight = usrRangeFormat.vBorderColor.vRight
    lColorBottom = usrRangeFormat.vBorderColor.vBottom
    lColorLeft = usrRangeFormat.vBorderColor.vLeft
    
    If (lColorTop = lColorBottom) And (lColorLeft = lColorRight) And (lColorTop <> lColorRight) Then
            strGetColorCSS = "#" & Application.WorksheetFunction.Dec2Hex(lColorTop, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorRight, 6)
    ElseIf (lColorLeft = lColorRight) And (lColorTop <> lColorBottom) Then
            strGetColorCSS = "#" & Application.WorksheetFunction.Dec2Hex(lColorTop, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorRight, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorBottom, 6)
    ElseIf (lColorLeft <> lColorRight) And (lColorTop <> lColorBottom) Then
            strGetColorCSS = "#" & Application.WorksheetFunction.Dec2Hex(lColorTop, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorRight, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorBottom, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorLeft, 6)
    ElseIf (lColorLeft <> lColorRight) And (lColorTop = lColorBottom) Then
            strGetColorCSS = "#" & Application.WorksheetFunction.Dec2Hex(lColorTop, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorRight, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorBottom, 6) & " " & _
                "#" & Application.WorksheetFunction.Dec2Hex(lColorLeft, 6)
    Else
            strGetColorCSS = "#" & Application.WorksheetFunction.Dec2Hex(lColorTop, 6)
    End If
End Function

Rahmenbreiten in verkürzter Schreibweise

Private Function strGetLineWidthCSS(ByRef usrRangeFormat As usrRangeFormat) As String
Dim iLineWidthTop, iLineWidthRight, iLineWidthBottom, iLineWidthLeft As Integer
    iLineWidthTop = usrRangeFormat.vBorderWeight.vTop
    iLineWidthRight = usrRangeFormat.vBorderWeight.vRight
    iLineWidthBottom = usrRangeFormat.vBorderWeight.vBottom
    iLineWidthLeft = usrRangeFormat.vBorderWeight.vLeft
    
    If (iLineWidthTop = iLineWidthBottom) And (iLineWidthLeft = iLineWidthRight) And (iLineWidthTop <> iLineWidthRight) Then
            strGetLineWidthCSS = iLineWidthTop & "px" & " " & _
                iLineWidthRight & "px"
    ElseIf (iLineWidthLeft = iLineWidthRight) And (iLineWidthTop <> iLineWidthBottom) Then
            strGetLineWidthCSS = iLineWidthTop & "px" & " " & _
                iLineWidthRight & "px" & " " & _
                iLineWidthBottom & "px"
    ElseIf (iLineWidthLeft <> iLineWidthRight) And (iLineWidthTop <> iLineWidthBottom) Then
            strGetLineWidthCSS = iLineWidthTop & "px" & " " & _
                iLineWidthRight & "px" & " " & _
                iLineWidthBottom & "px" & " " & _
                iLineWidthLeft & "px"
    ElseIf (iLineWidthLeft <> iLineWidthRight) And (iLineWidthTop = iLineWidthBottom) Then
            strGetLineWidthCSS = iLineWidthTop & "px" & " " & _
                iLineWidthRight & "px" & " " & _
                iLineWidthBottom & "px" & " " & _
                iLineWidthLeft & "px"
    Else
            strGetLineWidthCSS = iLineWidthTop & "px"
    End If
End Function

Rahmenstile in verkürzter Schreibweise

Private Function strGetLineStyleCSS(ByRef usrRangeFormat As usrRangeFormat) As String
Dim strStyleTop, strStyleRight, strStyleBottom, strStyleLeft As String

    strStyleTop = vGetLineStyle(usrRangeFormat.vBorderLineStyle.vTop)
    strStyleRight = vGetLineStyle(usrRangeFormat.vBorderLineStyle.vRight)
    strStyleBottom = vGetLineStyle(usrRangeFormat.vBorderLineStyle.vBottom)
    strStyleLeft = vGetLineStyle(usrRangeFormat.vBorderLineStyle.vLeft)
    
    
    If (strStyleTop = strStyleBottom) And (strStyleLeft = strStyleRight) And (strStyleTop <> strStyleRight) Then
            strGetLineStyleCSS = strStyleTop & " " & _
                strStyleRight
    ElseIf (strStyleLeft = strStyleRight) And (strStyleTop <> strStyleBottom) Then
            strGetLineStyleCSS = strStyleTop & " " & _
                strStyleRight & " " & _
                strStyleBottom
    ElseIf (strStyleLeft <> strStyleRight) And (strStyleTop <> strStyleBottom) Then
            strGetLineStyleCSS = strStyleTop & " " & _
                strStyleRight & " " & _
                strStyleBottom & " " & _
                strStyleLeft
    ElseIf (strStyleLeft <> strStyleRight) And (strStyleTop = strStyleBottom) Then
            strGetLineStyleCSS = strStyleTop & " " & _
                strStyleRight & " " & _
                strStyleBottom & " " & _
                strStyleLeft
    Else
            strGetLineStyleCSS = strStyleTop
    End If
End Function

 

Zurück zu Teil 1.