VBA 复制 Shapes("Textbox 1") 中的所有文本并将其放置在一个范围内

Question

我有一个 "shapes" 文本框 (TextBox 1)，其中包含一个 SQL 查询，如下所示。

Select
*
From
Table1
Union
Select
*
From
Table2

可以编辑此查询，这意味着文本框中的值可以更改。如果我录制一个宏，其中 select 文本框和 select 全部，然后将文本粘贴到 Range("A1")，它看起来如下所示。

Sub Test_1()

    ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
    Application.CutCopyMode = False
    Range("A1").Select
    ActiveSheet.Paste

End Sub

这将输出以下内容

> Row_Column    Text
>     A1           Select
>     A2           *
>     A3          From
>     A4          Table1
>     A5          Union
>     A6          Select
>     A7          *
>     A8          From
>     A9          Table2

但是，如果我将文本更改为以下内容。

Select
    *
    From
    Table1
    Union
    Select
    *
    From
    Table2
Union
Select
    *
    From
    Table3

宏不会复制在文本框中添加的额外代码行。

如何 select 将形状文本框中的所有内容都复制到 A 列中？我不希望所有文本都放在一个单元格中，因为我需要将文本分隔开，如输出示例中所示。

Answer 1

我能够用他下面的代码完成我想要的。

Sub test_2()
'This section uses sendkeys to copy the the text from the shape to the clipboard
Application.SendKeys ("^c~")
InputBox "clipboard", , Sheets("Sheet1").Shapes("textbox 1").TextFrame.Characters.Text

'This section selects the sheet that I want to paste the copied text to and deletes column A and places the new copied text into column A
Sheets("SQL").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveSheet.Paste

End Sub

Answer 2

这是一个替代方法，它在形状内拆分文本，将其分配给一个数组，然后将其传输到您的工作表...

Sub test()

    Dim arrText() As String

    arrText() = Split(ActiveSheet.Shapes("TextBox 1").TextFrame.Characters.Text, vbLf)

    Range("A1").Resize(UBound(arrText) + 1).Value = Application.Transpose(arrText)

End Sub

VBA 复制 Shapes("Textbox 1") 中的所有文本并将其放置在一个范围内

VBA to copy all text from Shapes("Textbox 1") and place it in a range

sql

excel

vba

textbox