使用VBA在导出的HTML表中添加超链接

问题描述 投票：0回答：1

我有一个有3列的excel表：

    A        B            C
  Item   Description   Hyperlink

我将其导出到JSON文件和带有表的HTML文件，用户可以在该表中查看JSON文件中的项目。这对我来说非常有用。现在我陷入困境，不知道如何对此进行最后的改进。

我希望在HTML文件的A列的“item”上有C列的超链接。要导出HTML文件，我使用以下代码（我在某处找到）：

Sub Test()
    RangeToHtml Range("A2:B100"), "G:\PD\PW\Production webpagefiles\new\Overview_Table.html"
End Sub

Sub RangeToHtml(rng As Range, fileName As String)
    Dim resBeg As String
    resBeg = "<html><head><title>Overview</title><link rel=""stylesheet""  href=""Overview_Table_css.css"" type=""text/css"" media=""all"" /></head><body><table><tr class=""heading""><td>Item</td><td>Description</td></tr>"
    resEnd = "</table></body></html>"
    For i = 1 To rng.Rows.Count
        '---Rows---
        resBeg = resBeg & "<tr>"
        For j = 1 To rng.Columns.Count
            '---Columns---
            resBeg = resBeg & "<td>"
            resBeg = resBeg & rng.Cells(i, j).Value
            resBeg = resBeg & "</td>"
        Next j
        resBeg = resBeg & "</tr>"
    Next i
    Call SaveStringToFile(resBeg & resEnd, fileName)
End Sub

Sub SaveStringToFile(str As String, fileName As String)
    Open fileName For Output As #1
    Print #1, str
    Close #1
End Sub

谁能给我一个正确的方向？

html excel vba
1个回答
1
投票

我相信以下内容将按照您的预期进行，它将像以前一样创建表，但在为A列中的表创建单元格时，它将从C列中获取值并将其添加为新创建的.html文件的超链接：

Sub Test()
    RangeToHtml Range("A2:B100"), "G:\PD\PW\Production webpagefiles\new\Overview_Table.html"
End Sub

Sub RangeToHtml(rng As Range, fileName As String)
    Dim resBeg As String
    resBeg = "<html><head><title>Overview</title><link rel=""stylesheet""  href=""Overview_Table_css.css"" type=""text/css"" media=""all"" /></head><body><table><tr class=""heading""><td>Item</td><td>Description</td></tr>"
    resEnd = "</table></body></html>"
    For i = 1 To rng.Rows.Count
        '---Rows---
        resBeg = resBeg & "<tr>"
        For j = 1 To rng.Columns.Count
            '---Columns---
            If j = 1 Then 'if column 1 = A, then add hyperlink found in column C by offseting by 2 columns
                resBeg = resBeg & "<td><a href=" & rng.Cells(i, j).Offset(0, 2).Value & ">" & rng.Cells(i, j).Value & "</a></td>"
            Else
                resBeg = resBeg & "<td>" & rng.Cells(i, j).Value & "</td>"
            End If
        Next j
        resBeg = resBeg & "</tr>"
    Next i
    Stop
    Call SaveStringToFile(resBeg & resEnd, fileName)
End Sub

Sub SaveStringToFile(str As String, fileName As String)
    Open fileName For Output As #1
    Print #1, str
    Close #1
End Sub
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.