Сделать скриншот окна приложения - VB

Формулировка задачи:

Добрый день! Как сделать, чтобы при нажатии на кнопку программа делала скриншот самой себя (сама форма не на весь экран), а затем сохраняла бы скрин в том месте, где укажет пользователь.

Решение задачи: «Сделать скриншот окна приложения»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Private Type PicBmp
    size As Long
    Type As Long
    hBmp As Long
    hpal As Long
    Reserved As Long
End Type
 
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Any, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
 
Private Sub Form_Click()
    Dim sDC As Long, dDC As Long, oBmp As Long, Bmp As Long, Pic As PicBmp, GUID(3) As Long, IPic As IPicture
    
    sDC = GetWindowDC(Me.hwnd)
    dDC = CreateCompatibleDC(sDC)
    Bmp = CreateCompatibleBitmap(sDC, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
    oBmp = SelectObject(dDC, Bmp)
    
    BitBlt dDC, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, sDC, 0, 0, vbSrcCopy
    
    SelectObject dDC, oBmp
    DeleteDC dDC
    ReleaseDC Me.hwnd, sDC
    
    GUID(0) = &H7BF80980
    GUID(1) = &H101ABF32
    GUID(2) = &HAA00BB8B
    GUID(3) = &HAB0C3000
    
    Pic.size = Len(Pic)
    Pic.Type = vbPicTypeBitmap
    Pic.hBmp = Bmp
    
    OleCreatePictureIndirect Pic, GUID(0), True, IPic
    
    If Not IPic Is Nothing Then
        SavePicture IPic, App.Path & "\Test.BMP"
    End If
End Sub
                        