粘貼單元格內容，包括文本格式

在單元格中我有些格式的文本是什麼一個文本框。例如，在單元格A1我可以有： AAABBBCCC

我想發送這條短信，其格式爲文本框（而不是在一個窗體）。

宏錄製簡單的拷貝文本，然後調整格式，例如：

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的文本框。

來源

2016-07-05 David G

你可以用'Selection.Value'其中「aaa bbb ccc」是爲了獲得你想要的數據，但不一定是格式。將進一步研究這個 –

您將需要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

來源

2016-07-05 18:10:39

DataObjects無法識別，你知道我需要激活哪個庫嗎？ –

對不起，正在做VB6的方式。如果它不起作用，我會嘗試'x.getText'。或者，您可能需要使用複製到剪貼板方法在第二個鏈接 –

我upvoted，因爲我知道它可以工作，但它不會在我的情況下工作，因爲我需要搜索Windows202的FM20.DLL，因爲從Excel 2010並且稍後，Microsoft Forms 2.0 Object庫不在參考列表中，我無法爲每臺將使用我正在執行的代碼的計算機執行此操作。 –

據我所知，你需要做特殊的格式通過自己的每個字符。這樣你可以遍歷它們來設置.Bolt/.Italic ....值。或欺騙這樣的：

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

雖然這是一個骯髒的方式做到這一點...它應該工作...至少：/

來源

2016-07-05 18:42:43

這裏有一個解決方案...我用ActiveCell值這個例子，但你可以使用A3的值。這臺ActiveCell值到文本框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

來源

2016-07-05 19:49:50 David

這個工作對你來說是否合適？ – David

粘貼單元格內容，包括文本格式

回答

相關問題