Работа с буфером обмена в VBA Excel: копирование и вставка ячеек, копирование текста из переменной, очистка буфера обмена. Объект DataObject. Примеры.
Копирование и вставка ячеек
Копирование содержимого и форматов ячеек (диапазона) в буфер обмена осуществляется методом Range.Copy, а вставка – методом Worksheet.Paste:
|
1 2 3 4 5 6 7 8 9 10 11 |
'Копирование одной ячейки в буфер обмена Range("A10").Copy Cells(10, 1).Copy 'Копирование диапазона ячеек в буфер обмена Range("B8:H12").Copy Range(Cells(8, 2), Cells(12, 8)).Copy 'Вставка ячейки (диапазона) из буфера обмена на рабочий лист ActiveSheet.Paste Range("A20") ActiveSheet.Paste Cells(20, 1) |
При вставке диапазона ячеек из буфера обмена на рабочий лист достаточно указать верхнюю левую ячейку места (диапазона) вставки.
Для вставки из буфера обмена отдельных компонентов скопированных ячеек (значения, формулы, примечания и т.д.), а также применения к диапазону транспонирования или вычислений, используется метод Range.PasteSpecial (специальная вставка).
Буфер обмена и переменная
Передача текста между переменной и буфером обмена в VBA Excel осуществляется с помощью объекта DataObject. Стоит иметь в виду, что на некоторых компьютерах DataObject может некорректно работать при открытом окне проводника.
Объект DataObject
Подробнее об элементе DataObject вы можете прочитать на сайте разработчиков.
Методы объекта DataObject:
| Метод | Описание |
|---|---|
| GetFromClipboard | Копирует данные из буфера обмена в DataObject |
| GetText | Извлекает текстовую строку из объекта DataObject в указанном формате |
| PutInClipboard | Перемещает данные из DataObject в буфер обмена |
| SetText | Копирует текстовую строку в DataObject, используя указанный формат |
Копирование текста из переменной в буфер обмена
|
1 2 3 4 5 6 7 8 9 10 |
Sub Primer2() Dim s As String, myData As New DataObject s = "Копирование текста из переменной в буфер обмена" 'Копируем текст из переменной в DataObject myData.SetText (s) 'Перемещаем текст из DataObject в буфер обмена myData.PutInClipboard 'Проверяем содержимое буфера обмена ActiveSheet.Paste Range("A1") End Sub |
Копирование текста из буфера обмена в переменную
|
1 2 3 4 5 6 7 8 9 10 11 12 |
Sub Primer3() Dim s As String, myData As New DataObject Range("A1") = "Копирование текста из буфера обмена в переменную" 'Копируем данные из ячейки в буфер обмена Range("A1").Copy 'Копируем данные из буфера обмена в DataObject myData.GetFromClipboard 'Извлекаем текст из объекта DataObject и присваиваем переменной s s = myData.GetText 'Проверяем содержимое переменной s MsgBox s End Sub |
Очистка буфера обмена
Специального метода для очистки буфера обмена в VBA Excel нет. Для решения этой задачи можно использовать выход из режима вырезания-копирования:
|
1 |
Application.CutCopyMode = False |
Следующий пример демонстрирует вставку скопированной ячейки "A1" в ячейки "A2" и "A3" и отсутствие вставки в ячейки "A4" и "A5" после строки Application.CutCopyMode = False:
|
1 2 3 4 5 6 7 8 9 10 |
Sub Primer4() Range("A1") = "Очистка буфера обмена" Range("A1").Copy ActiveSheet.Paste Range("A2") ActiveSheet.Paste Range("A3") Application.CutCopyMode = False On Error Resume Next ActiveSheet.Paste Range("A4") ActiveSheet.Paste Range("A5") End Sub |
Оператор On Error Resume Next необходим для обработки (пропуска) ошибки, возникающей при вставке из пустого буфера обмена.
Функции для работы с буфером обмена
В некоторых системах, начиная с Windows 8, метод DataObject.PutInClipboard не работает правильно: если открыт хотя бы один экземпляр Проводника (папка), в буфер обмена записываются два квадратика. Следующие функции должны решить эту проблему:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
'Функция записи текста в буфер обмена Function SetClipBoardText(ByVal Text As Variant) As Boolean SetClipBoardText = CreateObject("htmlfile").parentWindow.clipboardData.SetData("Text", Text) End Function 'Функция вставки текста из буфера обмена Function GetClipBoardText() As String On Error Resume Next GetClipBoardText = CreateObject("htmlfile").parentWindow.clipboardData.GetData("Text") End Function 'Функция очистки буфера обмена Function ClearClipBoardText() As Boolean ClearClipBoardText = CreateObject("htmlfile").parentWindow.clipboardData.clearData("Text") End Function |
Пример использования функций для работы с буфером обмена:
|
1 2 3 4 5 6 7 8 9 10 |
Sub Primer() Dim s As String s = "Копирование текста из переменной в буфер обмена" 'Копируем текст в буфер обмена SetClipBoardText (s) 'Вставляем текс из буфера обмена в ячейку "A1" Range("A1") = GetClipBoardText 'Очищаем буфер обмена, если это необходимо ClearClipBoardText End Sub |
Код — не работает ▼
В А1 вставляется какой-то непечатаемый символ и всё. При переходе к другому приложению и попытке вставить содержимое буфера — фиаско.
Добрый день, Михаил!
Такое встречается, начиная с Windows 8, когда открыта хотя бы одна папка в Проводнике. Я добавил в статью функции для работы с буфером обмена, они должны работать.
В Win 8.1 такой проблемы не наблюдаю, уж по всякому погонял, пытаясь вызвать ошибку — всегда правильно отрабатывает ))
А за статью большое спасибо!
Нашёл такую информацию на случай получения ошибки относительно типа данных DataObject.
Чтобы заработал тип данных «DataObject» нужно подключить инструмент «Microsoft Forms Object Libraries». Для этого необходимо выполнить действия в редакторе макросов Эксель:
1. Открыть Tools/References;
2. Через кнопку Browse открыть файл C:\WINDOWS\SYSTEM32\FM20.DLL. Файл «FM20.DLL» может оказаться в другой подпапке Windows, поискать по названию. Может быть в «SysWOW64» или в «System».
Добрый день. Подскажите пожалуйста в чем ошибка? Как только открывается вторая табличка, то файлы скопированные пропадают из буфера и пишет ошибку 424 Objekt required.
Sub Макрос1()
'
' Макрос1 Макрос
'
' Сочетание клавиш: Ctrl+й
'
ActiveSheet.Range("$A$11:$AD$182").AutoFilter Field:=1, Criteria1:= _
xlFilterToday, Operator:=xlFilterDynamic
Range("D11:D247").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
Dim fn As String: wb = ThisWorkbook.Path & "\ПВКоборудование.xlsm"
With Application
.EnableEvents = True
.Calculation = xlCalculationManual
.ScreenUpdating = True
.Visible = True
Workbooks.Open Filename:=wb
Sheets("наименования").Select
Range("C1").Select
AktiveSheet.Paste
End With
End Sub
Здравствуйте, Иван!
Попробуйте заменить строку
AktiveSheet.Pasteна
ActiveSheet.Paste Range("C1")Спасибо. Помогло
Проблема на виндовс 10 осталась только вместо 2-х квадратов пустоту переносит при открытой одной вкладке.
Dim longString As String'Dim sel As Object
''Dim obj3ADes As New DataObject
'Dim obj3ADes As String
strFile = Intersect(listobjTechs.ListRows(1).Range, listobjTechs.ListColumns("Value").DataBodyRange)
Set objWordApp = CreateObject("Word.Application") 'Word session creation Word.Application
objWordApp.Visible = True
Set objWordDoc = objWordApp.Documents.Open(strFile) 'open the .doc file
Dim listrowRowChecked As ListRow
Dim listcolumnColumnChecked As ListColumn
For Each listrowRowChecked In listobjectData.ListRows
Set objWordDoc = objWordApp.Documents.Open(strFile)
For Each listcolumnColumnChecked In listobjectData.ListColumns
If listcolumnColumnChecked.Name Like "" Then
'REPLACEMENTS
'Debug.Print listcolumnColumnChecked.Name, "is a placeholder" 'TEST
objWordApp.Selection.Find.ClearFormatting
objWordApp.Selection.Find.Replacement.ClearFormatting
longString = Intersect(listcolumnColumnChecked.DataBodyRange, listrowRowChecked.Range).Value
'obj3ADes.SetText longString
SetClipBoardText longString
'obj3ADes.PutInClipboard
With objWordApp.Selection.Find
.ClearFormatting
.Text = listcolumnColumnChecked.Name
.Replacement.ClearFormatting
.Replacement.Text = "^c"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
'objWordApp.Selection.Find.Execute Replace:=wdReplaceAll
Else:
'Debug.Print listcolumnColumnChecked.Name, "is no placeholder" 'Test
End If
ClearClipBoardText
Next listcolumnColumnChecked
Обсуждение закрыто.