时间戳

首页 > 解决方案 > VBA - 将多行 HTML 粘贴到单个单元格中

excel - VBA - 将多行 HTML 粘贴到单个单元格中

问题描述

我在 SO 上使用了另一个答案，以便能够将 HTML 字符串转换为在 excel 中显示的富文本。

但是，它带来了一个令人讨厌的副作用，即无法在单个单元格中添加多行数据（我发现的建议是删除粘贴逻辑）。

理想情况下，我不想在我的解决方案中使用 Internet Explorer 的 CreateObject，而只是让粘贴正常工作。

这是使用字典找到的代码，该字典将粘贴到每个单元格。

如何完成将 HTML 字符串转换为文本并将多行粘贴到单个单元格？

            ' Sort By Years Descending
            Dim yearKey As Variant
            Dim firstYear As Boolean
            Dim cellData As String
            firstYear = True
            cellData = "<HTML><DIV>"
            For Each yearKey In stakeholderEvents(stakeholder).Keys

                If Not firstYear Then
                    cellData = cellData & "<DIV></DIV>" ' Add Extra Blank Line
                End If

                cellData = cellData & "<B>" & yearKey & "</B>" & "<UL>" ' Add Year


                ' Loop Through Events For Year
                Dim eventItem As Variant
                For Each eventItem In stakeholderEvents(stakeholder)(yearKey)

                    cellData = cellData & "<LI>" & eventItem & "</LI>"
                Next

                cellData = cellData & "</UL>"

                firstYear = False
            Next

            cellData = cellData & "<DIV></BODY></HTML>"

            Set clipboardData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            clipboardData.SetText cellData
            clipboardData.PutInClipboard

            Sheet1.Activate

            'Sheet1.Range (Sheet1.Cells(rowIndex, stakeholderEventsColumn).Address)
            Sheet1.Cells(rowIndex, stakeholderEventsColumn).Select

            'Sheet1.Cells(rowIndex, stakeholderEventsColumn).Select
            Sheet1.PasteSpecial Format:="Unicode Text"

标签： excelvba

解决方案

HTML 替代方案（参考Excel 友好的 html：将列表保存在单个单元格中）：

Set clipboardData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboardData.SetText "<table><style>br {mso-data-placement:same-cell}</style><tr><td>" _
                    & "<b>Line 1</b><br>Line 2<br>Line 3"
clipboardData.PutInClipboard
Sheet1.Range("b2").PasteSpecial

XML 替代方案（可以通过分析.Value(11)格式化单元格来调整 XML）：

Dim c As Range
Set c = Sheet1.Range("b2")
c.Value = vbLf
c.Value(11) = Replace(c.Value(11), "<Data ss:Type=""String"">&#10;</Data>", _
    "<ss:Data ss:Type=""String"" xmlns=""http://www.w3.org/TR/REC-html40"">" & _
    "<B>Line 1</B>&#10;Line 2&#10;Line 3</ss:Data>")

推荐阅读