Question

我在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"

Answer 1

HTML替代（参考Excel-friendly html: keeping a list inside a single cell）：

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>")

Answer 2

我认为问题在于您正在使用HTML进行格式设置，而Excel总是会粘贴HTML，以便将块级元素放入不同的单元格中。

另一种方法是使用Excel的内置格式而不是使用HTML标签。这也将使您避免使用Clipboard对象。这是一个向范围中添加一些文本，然后对某些文本进行不同格式设置（例如加粗）的示例：

    Public Sub PopulateHtmlData()
        Dim cell As Excel.Range

        Dim s1 As String, s2 As String
        s1 = "Item 1"
        s2 = "Item 2"

        Set cell = Excel.Range("$A$1")
        ' use Chr(10) to add a new line in the cell
        cell.Value = s1 & Chr(10) & s2

        cell.Characters(0, Len(s1) - 1).Font.Bold = True
    End Sub

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

2 个答案: