Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/26.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 如何在vba中从形状逐行复制文本?_Excel_Vba - Fatal编程技术网

Excel 如何在vba中从形状逐行复制文本?

Excel 如何在vba中从形状逐行复制文本?,excel,vba,Excel,Vba,如何在Excel vba中将文字逐行(可能带有格式)从形状复制到单元格 结果应该与此类似: 提前非常感谢以下内容应该会让你大致了解: 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)

如何在Excel vba中将文字逐行(可能带有格式)从形状复制到单元格

结果应该与此类似:


提前非常感谢

以下内容应该会让你大致了解:

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”更改为您所调用的形状,并将其写入的范围更改为您希望它进入的任何位置