매크로/모듈(Module)

클립보드의 사진을 시트에 붙이기

고추탄 2023. 6. 10. 18:45

Option Explicit
Option Base 1


#If VBA7 Then
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

#Else
    Declare Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function EmptyClipboard Lib "user32" () As Long

#End If


Sub MyxlPaste_ShortKey()
  
  
  If IsEmptyClipboard = True Then
  
    'In Copy mode"
     ActiveSheet.Paste
      
    '윈도우 클립보드 비우기
     ClearClipboard
  
  Else
     
    'Not in Cut or Copy mode
     MsgBox "클립보드에 사진이 복사되지 않았습니다" & Chr(13) & Chr(13) & _
            "클립보드를 확인하려면 윈도우키+V"
              
  End If
   
   
End Sub


Function ClearClipboard() As Boolean

  On Error GoTo e1
  OpenClipboard (0&)
  EmptyClipboard
  CloseClipboard
  ClearClipboard = True
  Exit Function

e1:

End Function


Function IsEmptyClipboard() As Boolean
  
  Dim fmt
 
  For Each fmt In Application.ClipboardFormats
      
      If fmt = xlClipboardFormatRTF Then
         
         MsgBox "Clipboard contains rich text or 7"
      
      ElseIf fmt = xlClipboardFormatPICT Then
            
         MsgBox "Clipboard contains Picture or 2"
         
      ElseIf fmt = xlClipboardFormatScreenPICT Then
            
         MsgBox "Clipboard contains Screen Picture or 29"
      
      ElseIf fmt = xlClipboardFormatBitmap Then
            
         MsgBox "Clipboard contains Bitmap or 9"
         
         IsEmptyClipboard = True
         
         Exit For
      
      End If
      
      IsEmptyClipboard = False
      
  Next
 
End Function

LIST