|
==============[Hide님 글에 대한 답변입니다]==============
안녕하세요 Hide님^^
아래코드를 참고하세요.
Option Explicit
Private Declare Function OpenClipboard Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Sub Example()
If IsClipboardFormatAvailable(1) = 0 Then
MsgBox "클립보드에 Text가 없습니다."
Else
Dim bufPtr As Long, bufMem As Long, bufSize As Long
Dim strBuf() As Byte
OpenClipboard 0
bufMem = GetClipboardData(1)
bufSize = GlobalSize(bufMem)
bufPtr = GlobalLock(bufMem)
ReDim strBuf(0 To bufSize - 1) As Byte
CopyMemory strBuf(0), ByVal bufPtr, bufSize
GlobalUnlock bufMem
CloseClipboard
With ActiveWindow.Selection.ShapeRange.ActionSettings(ppMouseClick)
.Hyperlink.Address = "http://edm.gsconst.co.kr:8000/ikep/doc/dept/DocViewFrame.jsp?kid=" & StrConv(strBuf, vbUnicode)
.SoundEffect.Type = ppSoundNone
.AnimateAction = msoTrue
End With
With ActiveWindow.Selection.ShapeRange.ActionSettings(ppMouseOver)
.Action = ppActionNone
.SoundEffect.Type = ppSoundNone
.AnimateAction = msoFalse
End With
End If
End Sub
API함수를 조금 이용해야하니 ^^;
아무튼 좋은 하루되세요. |
|