IMAGEM DO FORMULARIO EM UM PICTURE BOX

Private Declare Function SendMessage Lib "user32" Alias _
   "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317
Private Const PRF_NONCLIENT = &H2&
Private Const PRF_CLIENT = &H4&
Private Const PRF_CHILDREN = &H10&
Private Const PRF_OWNED = &H20&
Private Sub cmdSnapShot_Click()
SnapShot Form1, Picture1
End Sub

Private Sub SnapShot(ByRef Source As Form, ByRef Dest As PictureBox)
Dim rv As Long
Dim sm As Integer
Dim ar As Boolean
Const BorderWidth = 60

On Error GoTo Exit_Sub
Me.ScaleMode = vbTwips

With Dest
.AutoRedraw = True
.ScaleMode = vbTwips
.Move .Left, .Top, Source.Width + BorderWidth, Source.Height + BorderWidth
End With

With Source
ar = .AutoRedraw
sm = .ScaleMode
.AutoRedraw = True
.ScaleMode = vbTwips

rv = SendMessage(.hwnd, WM_PAINT, .hDC, 0)
.Picture = .Image
Dest.PaintPicture .Picture, BorderWidth, .Height - .ScaleHeight - BorderWidth
rv = SendMessage(.hwnd, WM_PRINT, Dest.hDC, _
PRF_CHILDREN Or PRF_CLIENT Or PRF_OWNED Or PRF_NONCLIENT)
.AutoRedraw = ar
.ScaleMode = sm
End With

Exit_Sub:
If Err.Number Then MsgBox Err.Description, vbOKOnly
Dest.Picture = Dest.Image
Dest.Visible = True
End Sub