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

时间:2016-07-05 17:48:10

标签: excel vba excel-vba

我想做什么

我在单元格中有一些格式化文本。例如,在单元格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粘贴到文本框中。

3 个答案:

答案 0 :(得分:1)

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

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

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

答案 1 :(得分:0)

您将需要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 TextBoxPaste from clipboard VBA

答案 2 :(得分:0)

这是一个解决方案......我在示例中使用了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