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

Question

如何在Excel vba中将文本逐行（可能还有格式）从形状复制到单元格？

结果应该类似于：

非常感谢提前

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") 

只需更改＆＃34;矩形1＆＃34;无论你调整什么样的形状，都要将它写出来的范围改为你希望它去的地方。