it-roy-ru.com

Код Excel VBA для копирования определенной строки в буфер обмена

Я пытаюсь добавить кнопку в электронную таблицу, которая при нажатии копирует определенный URL в мой буфер обмена.

Я немного разбирался в Excel VBA, но это было давно, и я изо всех сил.

39
user1958738

Этот макрос использует позднюю привязку для копирования текста в буфер обмена без необходимости устанавливать ссылки. Вы должны быть в состоянии просто вставить и перейти:

Sub CopyText(Text As String)
    'VBA Macro using late binding to copy text to clipboard.
    'By Justin Kay, 8/15/2014
    Dim MSForms_DataObject As Object
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    MSForms_DataObject.SetText Text
    MSForms_DataObject.PutInClipboard
    Set MSForms_DataObject = Nothing
End Sub

Использование:

Sub CopySelection()
    CopyText Selection.Text
End Sub
79
Jroonk

Самый простой (не Win32) способ - это добавить пользовательскую форму в ваш проект VBA (если у вас ее еще нет) или альтернативно добавить ссылку на Microsoft Forms 2 Object Library , затем из листа/модуля вы можете просто:

With New MSForms.DataObject
    .SetText "http://zombo.com"
    .PutInClipboard
End With
20
Alex K.

Если URL находится в ячейке вашей рабочей книги, вы можете просто скопировать значение из этой ячейки:

Private Sub CommandButton1_Click()
    Sheets("Sheet1").Range("A1").Copy
End Sub

(Добавьте кнопку с помощью вкладки разработчика. Настройте ленту, если она не отображается.)

Если URL-адрес отсутствует в книге, вы можете использовать Windows API. Следующий код можно найти здесь: http://support.Microsoft.com/kb/210216

После того, как вы добавили вызовы API ниже, измените код за кнопкой, чтобы скопировать в буфер обмена:

Private Sub CommandButton1_Click()
    ClipBoard_SetData ("http:\\stackoverflow.com")
End Sub

Добавьте новый модуль в вашу книгу и вставьте следующий код:

Option Explicit

Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
   As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
   ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
   As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
   ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
   As Long, ByVal hMem As Long) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Function ClipBoard_SetData(MyString As String)
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long

   ' Allocate moveable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

   ' Lock the block to get a far pointer
   ' to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)

   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted."
      GoTo OutOfHere2
   End If

   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Function
   End If

   ' Clear the Clipboard.
   X = EmptyClipboard()

   ' Copy the data to the Clipboard.
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard."
   End If

End Function
8
Jon Crowell

Добавьте ссылку на библиотеку объектов Microsoft Forms 2.0 и попробуйте этот код. Он работает только с текстом, но не с другими типами данных.

Dim DataObj As New MSForms.DataObject

'Put a string in the clipboard
DataObj.SetText "Hello!"
DataObj.PutInClipboard

'Get a string from the clipboard
DataObj.GetFromClipboard
Debug.Print DataObj.GetText

Здесь вы можете найти более подробную информацию о том, как использовать буфер обмена с VBA.

6
stenci

Если вы хотите поместить значение переменной в буфер обмена с помощью окна Immediate, вы можете использовать эту единственную строку, чтобы легко установить точку останова в вашем коде:

Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): MSForms_DataObject.SetText VARIABLENAME: MSForms_DataObject.PutInClipboard: Set MSForms_DataObject = Nothing
4
F_Face

Если место, которое вы собираетесь вставить, не имеет проблем с вставкой форматирования таблицы (например, строки URL браузера), я думаю, что самый простой способ это:

Sheets(1).Range("A1000").Value = string
Sheets(1).Range("A1000").Copy
MsgBox "Paste before closing this dialog."
Sheets(1).Range("A1000").Value = ""
0
Maycow Moura