Excel VBA将单元格内容复制到InkEdit文本框并保留格式,包括颜色/粗体等

Question

我有一张表格,其中一些单元格有多色文本,并以粗体/下划线/斜体显示.

我需要能够拉出单元格内容并在保持相同格式的表单上显示信息.

我遇到了支持RichText的InkEdit控件,但我无法从单元格复制到此框.

请帮忙

Answer 1

问题似乎是Excel对象模型深深掩盖了单元格内容的RTF格式,并没有提供简单的方法来提取它.

这是一个似乎有点工作的kludge:

Sub CopyRichText(source As Range, target As InkEdit)
    Dim i As Long, n As Long
    target.Text = source.Text
    n = Len(target.Text)
    For i = 1 To n
        target.SelStart = i - 1
        target.SelLength = 1
        target.SelBold = source.Characters(i, 1).Font.Bold
        target.SelColor = source.Characters(i, 1).Font.Color
        target.SelFontName = source.Characters(i, 1).Font.FontStyle
        target.SelFontSize = source.Characters(i, 1).Font.Size
        target.SelItalic = source.Characters(i, 1).Font.Italic
        'target.SelUnderline = source.Characters(i, 1).Font.Underline '-- doesn't work as expected!
    Next i
    target.SelStart = n
    target.SelLength = 0
End Sub

像这样使用:

Private Sub UserForm_Initialize()
    CopyRichText Range("A1"), Me.InkEdit1
End Sub

例如,在A1我有:

然后,当我显示userform时,它看起来像:

墨水的SelUnderline方法似乎有一个彻头彻尾的错误.取消注释该行以查看我的意思.也许有一些解决方法.

我怀疑上面有点脆弱.我还没有测试过这么多.如果它适合你(也许适当调整) - 好.如果没有,我怀疑使用剪贴板有一种深刻的魔法方法.InkEdit控件没有粘贴方法 - 但它确实有一个Hwnd方法,听起来它可以为Window的粘贴提供目标.

Answer 2

InkEdit控件支持粘贴富文本,因此您真正需要做的就是复制Range,然后将其粘贴到控件中.由于控件公开了它.hWnd,您需要做的就是使用SendMessage API函数发送WM_PASTE消息:

'UserForm1
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias _
            "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, _
            ByVal wParam As Long, lParam As Any) As Long

Private Const WM_PASTE = &H302

Private Sub UserForm_Initialize()
    RangeToInkEdit ActiveSheet.Cells(1, 1), InkEdit1
    Application.CutCopyMode = False
End Sub

Sub RangeToInkEdit(source As Range, target As InkEdit)
    source.Copy
    SendMessage InkEdit1.hwnd, WM_PASTE, 0&, 0&
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

请注意,这也有一个类似于@ JohnColeman方法的轻微问题 - 它在拾取颜色时没有做那么好的工作.这似乎是Excel在RTF编码中发送到剪贴板的问题,而不是InkEdit控件本身的问题(您可以通过复制并粘贴到写字板(基本上是RTF编辑器)来确认).有些颜色有效,有些则没有 - 所有颜色的颜色深度都会减少到基本上是RTF支持的最接近的颜色.