Добавить гиперссылку в экспортированную таблицу HTML с VBA - PullRequest
Новая
       6

Добавить гиперссылку в экспортированную таблицу HTML с VBA

0 голосов
/ 30 августа 2018

У меня есть лист Excel с 3 столбцами: 

    A        B            C
  Item   Description   Hyperlink

Я экспортирую это в JSON-файл и HTML-файл с таблицей, где пользователи могут просматривать элементы в JSON-файле. Это работает довольно хорошо для меня. Теперь я застрял и не знаю, как сделать свое последнее улучшение в этом.

Я хочу получить гиперссылку из столбца C на «элемент» из столбца A в HTML-файле. Для экспорта 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

Может ли кто-нибудь дать мне выстрел в правильном направлении?

1 Ответ

0 голосов
/ 30 августа 2018

Я полагаю, что следующее будет делать то, что вы ожидаете, оно создаст таблицу, как и ранее, но при создании ячеек для таблицы в столбце 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...