Как я могу сделать отступ HTML с VBA? - PullRequest
Новая
       34

Как я могу сделать отступ HTML с VBA?

2 голосов
/ 03 апреля 2020

Я генерирую HTML в VBA (MSACCESS), который работает нормально, но с точки зрения отступов это немного беспорядок. Есть ли простой способ сделать отступ для текста HTML в VBA? Я использую функциональность формата кода Visual Studio, чтобы сделать красивее HTML, но я должен сделать это вручную, и это очень утомительно!

Пример: 

<div class="anythinggoes">
<ul><li>A</li>
        <li>B</li><li>C</li>
    </ul></div> <!-- anythinggoes -->

Должно стать чем-то вроде : 

<div class="anythinggoes">
    <ul>
        <li>A</li>
        <li>B</li>
        <li>C</li>
    </ul>
</div> <!-- anythinggoes -->

Любая помощь будет высоко ценится!

1 Ответ

2 голосов
/ 03 апреля 2020

ВНИМАНИЕ! Впереди уродливый код!

Добро пожаловать на борт, RichD. Я думаю, что этот код может помочь вам:

Сначала определите эти переменные в области действия модуля: 

Private InlineTags As Variant
Private InlineClosingTags As Variant

Затем мы можем использовать эту функцию: 

Function ReadableHTML(HTML As String) As String
    Dim a As String, i As Long, TabsNo As Long, tabs As String, l As Long, tag As String

    'add here tags that you want to keep on the same line of their parent
    InlineTags = Array("!--", "a", "i", "b", "sup", "sub") 'never followed by a line break
    InlineClosingTags = Array("li", "h1", "h2", "h3", "h4") 'always followed by a line break

    a = CleanOf(HTML)
    TabsNo = -1
    i = 1
    l = Len(a)
    Do While i < l
        If Mid(a, i, 2) = "</" Then
            tag = Mid(a, i + 2, InStr(i + 2, a, ">") - i - 2)
            If Not IsInArray(tag, InlineClosingTags) Or Mid(a, i - 1, 1) = ">" Then
                tabs = Chr(10) & Filler(TabsNo, Chr(9))
                a = Left(a, i - 1) & tabs & Right(a, Len(a) - i + 1)
                l = Len(a)
                i = i + Len(tabs)
            End If
            TabsNo = TabsNo - 1
        Else
            Select Case Mid(a, i, 1)
            Case "<"
                tag = Mid(a, i + 1, InStr(i + 1, a, ">"))
                If Not IsInArray(tag, InlineTags) Then
                    TabsNo = TabsNo + 1
                    tabs = Chr(10) & Filler(TabsNo, Chr(9))
                    a = Left(a, i - 1) & tabs & Right(a, Len(a) - i + 1)
                    l = Len(a)
                    i = i + Len(tabs)
                End If
            Case Chr(10)
                If Mid(a, i + 1, 1) <> Chr(9) And Mid(a, i + 1, 1) <> "<" Then
                    tabs = Chr(10) & Filler(TabsNo + 1, Chr(9))
                    a = Left(a, i) & tabs & Right(a, Len(a) - i)
                    l = Len(a)
                    i = i + Len(tabs)
                End If
            End Select
        End If
        i = i + 1
    Loop
    ReadableHTML = treatInlineTags(a, False)
End Function

Который использует эти вспомогательные функции: 

Function treatInlineTags(a As String, HideFlag As Boolean)
    'Hides/unhides inline tags from CleanOf
    If HideFlag Then
        For i = LBound(InlineTags) To UBound(InlineTags)
            a = Replace(a, "<" & InlineTags(i) & " ", "|" & InlineTags(i) & "¦")
            a = Replace(a, "<" & InlineTags(i) & ">", "|" & InlineTags(i) & "|")
            a = Replace(a, "</" & InlineTags(i) & ">", "|/" & InlineTags(i) & "|")
        Next i
    Else
        For i = LBound(InlineTags) To UBound(InlineTags)
            a = Replace(a, "|" & InlineTags(i) & "¦", "<" & InlineTags(i) & " ")
            a = Replace(a, "|" & InlineTags(i) & "|", "<" & InlineTags(i) & ">")
            a = Replace(a, "|/" & InlineTags(i) & "|", "</" & InlineTags(i) & ">")
        Next i
    End If
    treatInlineTags = a
End Function

Function IsInArray(a As String, Arr As Variant) As Boolean
    Dim i As Long
    For i = LBound(Arr) To UBound(Arr)
        If a = Arr(i) Then
            IsInArray = True
            Exit Function
        End If
    Next i
End Function

Function CleanOf(a As String) As String
    'Removes unwanted spaces between tags
    Dim i As Long, b As Boolean, l As Long
    a = Replace(a, Chr(13), "")
    a = Replace(a, Chr(10), "")
    a = treatInlineTags(a, True)
    For i = 1 To Len(a)
        Select Case Mid(a, i, 1)
        Case ">", "<"
            If i - l > 1 And l > 0 Then a = Left(a, l) & Right(a, Len(a) - i + 1)
            If i > 1 Then l = i
            If l > 0 Then b = True
        Case Is <> " "
            b = False
            l = 0
        End Select
    Next i
    CleanOf = a
End Function

Function Filler(n As Long, Optional Str As String = "0") As String
    If n > 0 Then Filler = Replace(Space$(n), " ", Str)
End Function

Чтобы проверить это: 

Sub test()
    Dim a As String, b As String
    a = "<div class=""myclass""> " & Chr(13) & _
    "<ul><li>A</li>                   " & Chr(13) & _
    "<li>B</li><li>C</li>             " & _
    "</ul></div> <!-- just a comment -->" & _
    "<h2 class=""mytitle"">a title: inline and " & _
    "followed by a line break</h2>" & _
    "<div><ul><li><i class=""myitalic"">italic " & _
    "content: inline and NOT followed by a line break</i>" & _
    "</li></ul></div>"

    b = "<li><i class=""mylist""></i>a list <ul>" & _
    "<li>element 1</li><li>element 2</li><li>element 3</li></ul> " & _
    "</li><li>This <b>is bold</b> in an element list " & _
    "<a href=""#mydestination"">""with an href"" " & _
    "</a></li>"

    Debug.Print Chr(10) & "Test1 - input:" & Chr(10) & a
    Debug.Print Chr(10) & "Test1 - output:" & Chr(10) & ReadableHTML(a)

    Debug.Print Chr(10) & "Test2 - input:" & Chr(10) & b
    Debug.Print Chr(10) & "Test2 - output:" & Chr(10) & ReadableHTML(b)
End Sub
...