Question

我想做什么

我在单元格中有一些格式化文本。例如，在单元格A1中，我可以： aaa bbb ccc

我想将此文本及其格式发送到文本框（不在用户表单中）。

宏录制器只是复制文本，然后调整格式：

Range("A3").Select
    Selection.Copy
    ActiveSheet.Shapes.Range(Array("txt_1")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "aaa bbb ccc "
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 8).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).Font
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0

          etc etc

我读到了关于复制单元格并粘贴到文本框中的内容，但似乎没有什么可以保存文本格式。像

这样的东西

ActiveSheet.Paste Destination:=Feuil1.Shapes.Range(Array("txt_1"))

会很棒，但显然不是如何使用VBA粘贴到文本框中。

Answer 1

据我所知，你需要自己为每个角色做特殊的格式化。这样您就可以遍历它们来设置.Bolt / .Italic ....值。或者像这样作弊：

Sub Macro()
  Range("A3").Copy
  ActiveSheet.Shapes.Range(Array("txt_1")).ShapeRange(1).Select
  Application.SendKeys ("^v")
End Sub

虽然这是一种肮脏的方式......它应该起作用......至少：/

Answer 2

您将需要Microsoft Forms 2.0对象库。

Dim x As New MSForms.DataObject
Set x = New MSForms.DataObject
Selection.Copy
x.GetFromClipboard
ActiveSheet.Shapes.Range(Array("txt_1")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = x.getText(1)

这应该保持格式，同时允许您粘贴到用户控件。如果这可以解决您的问题，请告诉我。

来源：Paste to TextBox， Paste from clipboard VBA

Answer 3

这是一个解决方案......我在示例中使用了ActiveCell值，但您可以使用A3的值。这将ActiveCell值设置为Textbox 1，然后遍历ActiveCell字符以查看它们是粗体还是斜体，然后相应地设置文本框1中单个字符的格式：

Sub passCharToTextbox()

    'select Textbox 1:
    ActiveSheet.Shapes.Range(Array("Textbox 1")).Select

    'set text:
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ActiveCell.Value

    'loop through characters in original cell:
    For i = 1 To Len(ActiveCell.Value)

        'add bold/italic to the new character if necessary:
        If ActiveCell.Characters(i, 1).Font.Bold = True Then
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Bold = True
        Else
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Bold = False
        End If
        If ActiveCell.Characters(i, 1).Font.Italic = True Then
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Italic = True
        Else
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Italic = False
        End If

    Next i

End Sub

将单元格内容粘贴到包含文本格式的文本框中

3 个答案: