Attribute VB_Name = "modMemoImage"
Option Explicit
'=======================================
' Windows API ¼±¾ð
'=======================================
#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, ByVal bScan As Byte, _
        ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" ( _
        ByVal wFormat As Long) As Long
#Else
    Private Declare Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, ByVal bScan As Byte, _
        ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
    Private Declare Function IsClipboardFormatAvailable Lib "user32" ( _
        ByVal wFormat As Long) As Long
#End If

'=======================================
' »ó¼ö Á¤ÀÇ
'=======================================
Private Const VK_LWIN As Byte = &H5B
Private Const VK_SHIFT As Byte = &H10
Private Const VK_S As Byte = &H53
Private Const KEYEVENTF_KEYDOWN As Long = 0
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const CF_BITMAP As Long = 2

'=======================================
' PowerShell·Î Ŭ¸³º¸µå ¡æ PNG Á÷Á¢ ÀúÀå (Â÷Æ® Export ¿ìȸ)
'=======================================
Private Function SaveClipboardToPNG(ByVal savePath As String) As Boolean
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    ' PowerShell ¸í·É: Ŭ¸³º¸µå ºñÆ®¸ÊÀ» PNG·Î Á÷Á¢ ÀúÀå
    Dim psCmd As String
    psCmd = "powershell -ExecutionPolicy Bypass -Command """ & _
            "Add-Type -AssemblyName System.Windows.Forms;" & _
            "$img = [System.Windows.Forms.Clipboard]::GetImage();" & _
            "if($img -ne $null){" & _
            "$img.Save('" & savePath & "', [System.Drawing.Imaging.ImageFormat]::Png);" & _
            "$img.Dispose()}" & _
            """"
    
    ' µ¿±â ½ÇÇà (¿Ï·áµÉ ¶§±îÁö ´ë±â), â ¼û±è
    wsh.run psCmd, 0, True
    
    Set wsh = Nothing
    
    ' ÀúÀå È®ÀÎ
    SaveClipboardToPNG = (dir(savePath) <> "")
End Function

'=======================================
' PowerShell·Î Ŭ¸³º¸µå À̹ÌÁö Å©±â Á¶È¸
'=======================================
Private Function GetClipboardImageSize(ByRef outWidth As Long, ByRef outHeight As Long) As Boolean
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    ' Àӽà ÆÄÀÏ¿¡ Å©±â Á¤º¸ ±â·Ï
    Dim tmpFile As String
    tmpFile = Environ("TEMP") & "\clipsize_" & Format(Now, "HHmmss") & ".txt"
    
    Dim psCmd As String
    psCmd = "powershell -ExecutionPolicy Bypass -Command """ & _
            "Add-Type -AssemblyName System.Windows.Forms;" & _
            "$img = [System.Windows.Forms.Clipboard]::GetImage();" & _
            "if($img -ne $null){" & _
            "[System.IO.File]::WriteAllText('" & tmpFile & "', " & _
            "($img.Width.ToString() + ',' + $img.Height.ToString()));" & _
            "$img.Dispose()}" & _
            """"
    
    wsh.run psCmd, 0, True
    Set wsh = Nothing
    
    GetClipboardImageSize = False
    
    If dir(tmpFile) <> "" Then
        Dim ff As Integer
        ff = FreeFile
        Dim sData As String
        Open tmpFile For Input As #ff
        Line Input #ff, sData
        Close #ff
        Kill tmpFile
        
        Dim parts() As String
        parts = Split(sData, ",")
        If UBound(parts) >= 1 Then
            outWidth = CLng(parts(0))
            outHeight = CLng(parts(1))
            GetClipboardImageSize = True
        End If
    End If
End Function

'=======================================
' ¸ÞÀÎ ¸ÅÅ©·Î (¸®º» Äݹé)
'=======================================
Sub ¸Þ¸ð¿¡À̹ÌÁö³Ö±â(control As IRibbonControl)
    ' ¸®º» Ŭ¸¯(Äݹé) ¾È¿¡¼­´Â ¼¿ ¼±Åà â(Application.InputBox Type:=8)ÀÌ ¹Ù·Î Ãë¼ÒµÇ¹Ç·Î, ÄݹéÀÌ ³¡³­ µÚ ½ÇÇàµÇµµ·Ï ¿¹¾àÇÑ´Ù
    If control Is Nothing Then
        MemoImage_Run
    Else
        Application.OnTime Now, "'" & ThisWorkbook.name & "'!MemoImage_Run"
    End If
End Sub

Public Sub MemoImage_Run()
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    '-------------------------------------------------------
    ' 1´Ü°è: Win + Shift + S ·Î ½ºÅ©¸° ĸó ½ÇÇà
    '-------------------------------------------------------
    ' [¼öÁ¤] ÀÌ¹Ì º¹»çÇØ µÐ À̹ÌÁö°¡ ÀÖÀ¸¸é ±×°ÍÀ» ¾µÁö ¹°¾îº¸°í, ¾øÀ» ¶§¸¸ È­¸é ĸó(Win+Shift+S)¸¦ ¶ç¿î´Ù
    Dim choice As Long, needCapture As Boolean
    needCapture = True
    If IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then
        choice = UI_Choose("¸Þ¸ð¹è°æ³Ö±â", "Ŭ¸³º¸µå¿¡ º¹»çµÈ À̹ÌÁö°¡ ÀÖ½À´Ï´Ù. ¾î¶² À̹ÌÁö¸¦ ¸Þ¸ð ¹è°æÀ¸·Î ³ÖÀ»±î¿ä?", _
                           Array("Ŭ¸³º¸µåÀÇ À̹ÌÁö »ç¿ë", "»õ·Î È­¸é ĸó (Win+Shift+S)"))
        If choice = 0 Then Exit Sub
        needCapture = (choice = 2)
    End If
    If needCapture Then
        keybd_event VK_LWIN, 0, KEYEVENTF_KEYDOWN, 0
        keybd_event VK_SHIFT, 0, KEYEVENTF_KEYDOWN, 0
        keybd_event VK_S, 0, KEYEVENTF_KEYDOWN, 0
        Sleep 50
        keybd_event VK_S, 0, KEYEVENTF_KEYUP, 0
        keybd_event VK_SHIFT, 0, KEYEVENTF_KEYUP, 0
        keybd_event VK_LWIN, 0, KEYEVENTF_KEYUP, 0
        MsgBox "È­¸é ¿µ¿ªÀ» µå·¡±×ÇÏ¿© ĸóÇÑ ÈÄ" & vbNewLine & _
               "ÀÌ Ã¢¿¡¼­ [È®ÀÎ] ¹öÆ°À» ´©¸£¼¼¿ä.", vbInformation, "½ºÅ©¸° ĸó ´ë±â"
        Sleep 500
    End If
    If IsClipboardFormatAvailable(CF_BITMAP) = 0 Then
        MsgBox "Ŭ¸³º¸µå¿¡ À̹ÌÁö°¡ ¾ø½À´Ï´Ù." & vbNewLine & _
               "ĸó°¡ Á¤»óÀûÀ¸·Î µÇ¾ú´ÂÁö È®ÀÎÇØÁÖ¼¼¿ä.", _
               vbExclamation, "¿À·ù"
        Exit Sub
    End If
    
    '-------------------------------------------------------
    ' 2´Ü°è: Ŭ¸³º¸µå À̹ÌÁö Å©±â Á¶È¸
    '-------------------------------------------------------
    Dim pxWidth As Long, pxHeight As Long
    If Not GetClipboardImageSize(pxWidth, pxHeight) Then
        MsgBox "Ŭ¸³º¸µå À̹ÌÁö Å©±â¸¦ ÀÐÀ» ¼ö ¾ø½À´Ï´Ù.", vbExclamation, "¿À·ù"
        Exit Sub
    End If
    
    '-------------------------------------------------------
    ' 3´Ü°è: PowerShell·Î Ŭ¸³º¸µå ¡æ PNG Á÷Á¢ ÀúÀå
    '        ¡Ú ÇÙ½É: Chart.Export ´ë½Å .NETÀ¸·Î ¿øº» ±×´ë·Î ÀúÀå
    '-------------------------------------------------------
    ' ÀÓ½ÃÆú´õ¿¡ ÀúÀå (¸Þ¸ð ¹è°æ¿ë)
    Dim tempPath As String
    tempPath = Environ("TEMP") & "\ExcelCapture_" & Format(Now, "yyyyMMdd_HHmmss") & ".png"
    
    If Not SaveClipboardToPNG(tempPath) Then
        MsgBox "À̹ÌÁö ÀúÀå¿¡ ½ÇÆÐÇß½À´Ï´Ù.", vbExclamation, "¿À·ù"
        Exit Sub
    End If
    
    ' ¹ÙÅÁÈ­¸é¿¡µµ ÀúÀå (¼±ÅûçÇ× - ºÒÇÊ¿äÇÏ¸é ¾Æ·¡ 3ÁÙ »èÁ¦)
    ' (¹ÙÅÁÈ­¸é¿¡ »çº»À» ÀúÀåÇÏ´ø µ¿ÀÛ Á¦°Å - »ç¿ëÇÒ ¶§¸¶´Ù ¹ÙÅÁÈ­¸é¿¡ PNG °¡ ½×ÀÌ´ø ¹®Á¦)
    
    '-------------------------------------------------------
    ' 4´Ü°è: ¼¿ ¼±Åà ´ÙÀ̾ó·Î±× Ç¥½Ã
    '-------------------------------------------------------
    Dim rng As Range
    On Error Resume Next
    AppActivate Application.caption          ' ¿ÜºÎ ÇÁ·Î¼¼½º(PowerShell) ½ÇÇà µÚ Æ÷Ä¿½º¸¦ ¿¢¼¿·Î
    ActiveWindow.Activate
    Application.GoTo ActiveCell
    DoEvents
    Set rng = Application.InputBox( _
        prompt:="¸Þ¸ð(±×¸² ¹è°æ)¸¦ Ãß°¡ÇÒ ¼¿À» ¼±ÅÃÇϼ¼¿ä.", _
        title:="¼¿ ¼±ÅÃ", _
        Default:=ActiveCell.Address, _
        Type:=8)
    On Error GoTo 0
    
    If rng Is Nothing Then
        MsgBox "¼¿ ¼±ÅÃÀÌ Ãë¼ÒµÇ¾ú½À´Ï´Ù.", vbExclamation, "Ãë¼Ò"
        On Error Resume Next
        Kill tempPath
        On Error GoTo 0
        Exit Sub
    End If
    
    Set rng = rng.cells(1, 1)
    
    '-------------------------------------------------------
    ' 5´Ü°è: ¸Þ¸ð Ãß°¡ ¡æ ±×¸² ¹è°æ ¼³Á¤
    '-------------------------------------------------------
    If Not rng.Comment Is Nothing Then
        rng.Comment.Delete
    End If
    
    rng.AddComment text:=" "
    
    ' Çȼ¿ ¡æ Æ÷ÀÎÆ® º¯È¯ (96dpi ±âÁØ)
    Dim ptWidth As Single, ptHeight As Single
    ptWidth = pxWidth * 72# / 96#
    ptHeight = pxHeight * 72# / 96#
    
    With rng.Comment.Shape
        ' ¸Þ¸ð Å©±â¸¦ À̹ÌÁö ºñÀ²¿¡ ¸ÂÃã
        .Width = ptWidth
        .Height = ptHeight
        
        ' ÃÖ¼Ò/ÃÖ´ë Å©±â Á¦ÇÑ
        If .Width < 150 Then
            Dim scaleUp As Single
            scaleUp = 150 / .Width
            .Width = 150
            .Height = .Height * scaleUp
        End If
        If .Height < 100 Then
            Dim scaleUp2 As Single
            scaleUp2 = 100 / .Height
            .Height = 100
            .Width = .Width * scaleUp2
        End If
        If .Width > 600 Then
            Dim scaleDown As Single
            scaleDown = 600 / .Width
            .Width = 600
            .Height = .Height * scaleDown
        End If
        
        ' ±×¸² ¹è°æ ¼³Á¤
        .Fill.Visible = msoTrue
        .Fill.UserPicture tempPath
        
        ' ¸Þ¸ð ÅؽºÆ® ¼û±è ó¸®
        .TextFrame.Characters.Font.color = RGB(255, 255, 255)
        .TextFrame.Characters.Font.Size = 1
    End With
    
    rng.Comment.Visible = False
    
    '-------------------------------------------------------
    ' 6´Ü°è: ÀÓ½ÃÆÄÀÏ »èÁ¦ (¸Þ¸ð¿¡ ÀÌ¹Ì ÀÓº£µåµÊ)
    '-------------------------------------------------------
    On Error Resume Next
    Kill tempPath
    On Error GoTo 0
    
    '-------------------------------------------------------
    ' 7´Ü°è: ¿Ï·á ¸Þ½ÃÁö
    '-------------------------------------------------------
    rng.Select
    
    Dim msg As String
    msg = "¿Ï·á!" & vbNewLine & vbNewLine & _
          "  ¸Þ¸ð ¼¿: " & rng.Address & vbNewLine & _
          "  À̹ÌÁö Å©±â: " & pxWidth & " x " & pxHeight & " px" & vbNewLine
    
    
    msg = msg & vbNewLine & "¡Ø ¼¿¿¡ ¸¶¿ì½º¸¦ ¿Ã¸®¸é ĸó À̹ÌÁö°¡ Ç¥½ÃµË´Ï´Ù."
    
    MsgBox msg, vbInformation, "¿Ï·á"

End Sub