クリップボードに渡す前に、ピクチャボックスを利用すると簡単です。
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Command1_Click()
Dim picWk As PictureBox
Dim bytScale As Byte
Dim blnRedraw As Boolean
'フォームのスケールを一時記憶
bytScale = Me.ScaleMode
'AutoRedrawを一時記憶
blnRedraw = Me.AutoRedraw
'フォームのスケールをピクセルにセット
Me.ScaleMode = vbPixels
'AutoRedrawをFalseにセット
Me.AutoRedraw = blnRedraw
'ピクチャボックスを作る
Set picWk = Me.Controls.Add("VB.PictureBox", "picDmy")
With picWk
'初期設定
.ScaleMode = vbPixels
.Move 0, 0, Frame1.Width, Frame1.Height
.Cls
.AutoRedraw = True
'絵を張る
Call StretchBlt(.hdc, 0, 0, picWk.Width, picWk.Height, Me.hdc, Frame1.Left, Frame1.Top, Frame1.Width, Frame1.Height, vbSrcCopy)
End With
'クリップボードにセット
Clipboard.Clear
Clipboard.SetData picWk.Image
'ピクチャボックスを破棄
Me.Controls.Remove picWk
Set picWk = Nothing
'フォームを元の状態に戻す
Me.ScaleMode = bytScale
Me.AutoRedraw = blnRedraw
'適当な色つけ
Call Form_Load
End Sub
Private Sub Form_Load()
Me.Frame1.BackColor = RGB(Int(&HFF * Rnd), Int(&HFF * Rnd), Int(&HFF * Rnd))
End Sub
お礼
できました。完璧です。 ありがとうございました。