如何快速在UserForm控件中显示带格式Excel单元格内容，避免加载延迟

核心思路 #

WebBrowser加载HTML的性能瓶颈在于HTML解析与渲染环节，长内容场景下延迟明显。RichTextBox控件原生支持富文本格式（RTF），渲染速度远快于WebBrowser，同时自带编辑功能，可一次性解决加载慢和编辑需求。

步骤1：替换控件 #

1. 打开VBA编辑器，在UserForm设计界面删除原WebBrowser控件
2. 点击「开发工具」→「附加控件」，勾选Microsoft Rich Textbox Control 6.0并添加到控件库
3. 在UserForm上添加RichTextBox控件，命名为RichTextBox1，调整尺寸适配界面

步骤2：单元格内容转RTF（替代原CellToHTML） #

RTF是RichTextBox的原生格式，转换效率远高于HTML。以下是将Excel单元格带格式内容转为RTF的核心函数：

Function CellToRTF(rng As Range) As String
    Dim tempWB As Workbook
    Dim tempSheet As Worksheet
    Dim rtfPath As String
    
    ' 创建临时工作簿复制目标单元格
    Set tempWB = Workbooks.Add
    Set tempSheet = tempWB.Sheets(1)
    rng.Copy
    tempSheet.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    
    ' 保存为临时RTF文件
    rtfPath = Environ("TEMP") & "\temp_cell.rtf"
    tempWB.SaveAs Filename:=rtfPath, FileFormat:=xlRTF
    tempWB.Close SaveChanges:=False
    
    ' 读取RTF内容
    Dim fileNum As Integer
    fileNum = FreeFile()
    Open rtfPath For Input As #fileNum
    CellToRTF = Input$(LOF(fileNum), fileNum)
    Close #fileNum
    
    ' 清理临时文件
    Kill rtfPath
End Function

步骤3：修改ListView点击事件（无延迟显示） #

替换原WebBrowser加载逻辑，改为RichTextBox加载RTF：

Private Sub ListViewProjects_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Dim ws As Worksheet
    Dim selectedRow As Long
    Dim rng As Range
    Dim rtfContent As String
    
    Set ws = ThisWorkbook.Sheets(WS_PROJEKTE)
    selectedRow = Item.Index + DATA_START_ROW - 1
    Set rng = ws.Cells(selectedRow, COL_COMMENT)
    
    If IsEmpty(rng.Value) Then
        Me.RichTextBox1.Text = ""
        Exit Sub
    End If
    
    ' 转换为RTF并加载到控件
    rtfContent = CellToRTF(rng)
    Me.RichTextBox1.TextRTF = rtfContent
End Sub

步骤4：添加编辑保存功能 #

编辑按钮逻辑 #

直接启用RichTextBox的编辑状态（默认已启用，可按需锁定/解锁）：

Private Sub btnEdit_Click()
    Me.RichTextBox1.Locked = False
    Me.RichTextBox1.SetFocus
End Sub

保存按钮逻辑 #

将RichTextBox的带格式内容写回Excel单元格：

Private Sub btnSave_Click()
    Dim ws As Worksheet
    Dim selectedRow As Long
    Dim rng As Range
    Dim tempWB As Workbook
    Dim rtfPath As String
    
    ' 检查是否有选中项
    If ListViewProjects.SelectedItem Is Nothing Then Exit Sub
    
    Set ws = ThisWorkbook.Sheets(WS_PROJEKTE)
    selectedRow = ListViewProjects.SelectedItem.Index + DATA_START_ROW - 1
    Set rng = ws.Cells(selectedRow, COL_COMMENT)
    
    ' 将RichTextBox内容保存为临时RTF
    rtfPath = Environ("TEMP") & "\save_cell.rtf"
    Open rtfPath For Output As #1
    Print #1, Me.RichTextBox1.TextRTF
    Close #1
    
    ' 从RTF文件导入格式到单元格
    Set tempWB = Workbooks.Open(rtfPath)
    tempWB.Sheets(1).UsedRange.Copy
    rng.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    tempWB.Close SaveChanges:=False
    
    ' 清理临时文件
    Kill rtfPath
    
    ' 锁定编辑状态
    Me.RichTextBox1.Locked = True
    MsgBox "内容已保存", vbInformation
End Sub

额外优化点 #

• 若无需完全还原复杂Excel格式（如条件格式、公式样式），可简化CellToRTF函数，直接提取文本、字体、颜色、换行等基础格式生成RTF，速度更快
• 提前预加载高频访问单元格的RTF内容到内存，进一步减少点击后的响应时间

内容的提问来源于stack exchange，提问作者vbahuman