VBA, чтобы скопировать весь текст из фигур («Текстовое поле 1») и поместить его в диапазон

У меня есть текстовое поле «формы» (TextBox 1), содержащее SQL-запрос, как показано ниже.

Select
*
From
Table1
Union
Select
*
From
Table2

Этот запрос можно редактировать, что означает, что значения в текстовом поле могут изменяться. Если я записываю макрос, в котором я выбираю текстовое поле и выбираю все, а затем вставляю текст в 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

Макрос не будет копировать дополнительные строки кода, добавленные в текстовое поле.

Как выбрать все из текстового поля фигур и поместить скопированный текст в столбец A? Я не хочу, чтобы весь текст помещался в одну ячейку, поскольку мне нужен текст, разделенный, как показано в примере вывода.

ReactJs | Supabase | Добавление данных в базу данных
ReactJs | Supabase | Добавление данных в базу данных
Это и есть ваш редактор таблиц в supabase.👇
Понимание Python и переход к SQL
Понимание Python и переход к SQL
Перед нами лабораторная работа по BloodOath:
0
0
2 157
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Я смог выполнить то, что искал, с помощью следующего кода.

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
Ответ принят как подходящий

Вот альтернатива, которая разделяет текст внутри фигуры, назначает его массиву, а затем передает его на ваш рабочий лист ...

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

Другие вопросы по теме