특정 문자열을 클립보드에 복사하기 위한 Excel VBA 코드

특정 문자열을 클립보드에 복사하기 위한 Excel VBA 코드

스프레드시트에 특정 URL을 클릭하면 클립보드에 복사되는 버튼을 추가하려고 합니다.

엑셀 VBA에 대해 조금 알고 있었지만, 오랜만이여서 곤란합니다.

편집 - MSForms는 더 이상 사용되지 않으므로 내 답변을 사용하지 마십시오.대신 다음 답변을 사용합니다.https://stackoverflow.com/a/60896244/692098

참고용으로만 여기에 답변을 남깁니다.

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

Windows 클립보드에 텍스트를 쓰거나 읽으려면 다음 VBA 기능을 사용합니다.

Function Clipboard$(Optional s$)
    Dim v: v = s  'Cast to variant for 64-bit VBA support
    With CreateObject("htmlfile")
    With .parentWindow.clipboardData
        Select Case True
            Case Len(s): .setData "text", v
            Case Else:   Clipboard = .getData("text")
        End Select
    End With
    End With
End Function

---

'Three examples of copying text to the clipboard:
Clipboard "Excel Hero was here."
Clipboard var1 & vbLF & var2
Clipboard 123

'To read text from the clipboard:
MsgBox Clipboard

이는 MS Forms나 Win32 API를 사용하지 않는 솔루션입니다.대신 Microsoft HTML Object Library를 사용합니다.이것은 빠르고 유비쿼터스하며 MS Forms와 같이 Microsoft에 의해 권장되지 않습니다.이 솔루션은 회선 피드를 존중합니다.이 솔루션은 64비트 Office에서도 작동합니다.마지막으로 이 솔루션은 Windows 클립보드에 쓰기와 읽기를 모두 허용합니다.이 페이지의 다른 솔루션에는 이러한 이점이 없습니다.

가장 간단한 방법(Win32)은 사용자 폼을 VBA 프로젝트에 추가하거나(아직 사용자 폼이 없는 경우), 또는 Microsoft Forms 2 Object Library에 대한 참조를 추가하는 것입니다.그 후 시트/모듈에서 간단히 다음을 수행할 수 있습니다.

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

URL이 워크북의 셀에 있는 경우 해당 셀에서 값을 복사할 수 있습니다.

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

(developer 탭을 사용하여 버튼을 추가합니다.리본이 표시되지 않는 경우는, 커스터마이즈 합니다).

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

Microsoft Forms 2.0 Object Library에 대한 참조를 추가하고 이 코드를 사용해 보십시오.텍스트에서만 작동하며 다른 데이터 유형에서는 작동하지 않습니다.

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에서 클립보드를 사용하는 방법에 대한 자세한 내용은 여기에서 확인할 수 있습니다.

Immediate 창을 사용하여 변수 값을 클립보드에 넣으려면 다음 한 줄을 사용하여 코드에 중단점을 쉽게 넣을 수 있습니다.

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

붙여넣는 장소가 테이블 형성에 문제가 없다면(브라우저 URL 바 등) 가장 쉬운 방법은 다음과 같습니다.

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

나는 이 코드를 엑셀 365로 테스트했고 작동했다.

Dim str as String
str = "Hello Copied"
Windows.Parent.Clipboard str

참고: 코드가 문자열 연결을 처리하지 않기 때문에 변수를 만들었습니다.

Microsoft 사이트에서 제공되는 코드는 Access VBA에 있지만 Excel에서도 작동합니다.64비트 Windows 10에서 Excel 365로 사용해 보았습니다.

Microsoft 사이트 링크: https://learn.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard

답변의 완전성을 위해 여기에 복사하고 있습니다.

Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

Public Sub SetClipboard(sUniText As String)
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Dim sUniText As String
    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If
    CloseClipboard
End Function

위의 코드는 다음과 같이 커스텀 매크로에서 호출할 수 있습니다.

Sub TestClipboard()
    Dim Val1 As String: Val1 = "Hello Clipboard " & vbLf & "World!"
    SetClipboard Val1
    MsgBox GetClipboard
End Sub

양식에 단추를 표시하려면 빠른 검색을 통해 좋은 예를 찾을 수 있습니다.Excel 커스텀 리본(현재 Excel 워크북에만 표시되는 버튼)에 커스텀을 사용할 수 있습니다.UI.

CustomUI 링크:

https://bettersolutions.com/vba/ribbon/custom-ui-editor.htm

https://learn.microsoft.com/en-us/office/open-xml/how-to-add-custom-ui-to-a-spreadsheet-document

아이콘이 있는 imageMSO 목록(커스텀에서 사용)UI):

https://bert-toolkit.com/imagemso-list.html

감사해요.

언급URL : https://stackoverflow.com/questions/14219455/excel-vba-code-to-copy-a-specific-string-to-clipboard