如何从vba中的形状逐行复制文本？

Question

我怎样才能从一个形状复制文本行（可能与格式）从Excel中的形状单元格？

的结果应该与此类似：

许多在此先感谢

Answer 1

类似下面应该让你在球场：

Sub WriteOutShapeText(shapeName As String) 

    'get the values from the shape called whatever is stored in shapeName 
    'and split the text into an array using chr(11) (line feed) 
    Dim textArray As Variant 
    textArray = Split(Sheet1.Shapes(shapeName).TextFrame2.TextRange.Characters.Text, Chr(11)) 


    'Set up the row to which we will start writing 
    Dim writeRow As Integer 
    writeRow = 1 

    'Loop through the array assigning each element in textArray to the variable textline 
    For Each textLine In textArray 

     'write out to sheet1 column 1 starting at writeRow 
     Sheet1.Cells(writeRow, 1).Value = textLine 

     'increment to the next row to which we will write 
     writeRow = writeRow + 1 
    Next 

End Sub 

您可以在VBA中使用它如：

Call WriteOutShapeText("Rectangle 1") 

只需将“矩形1”更改为您调用的任何形状，并将其写入的范围更改为所需的位置。