SavePictureで保存できない

質問

VB6での開発で
ピクチャボックス(大)の中にピクチャボックス(小)を何個か入れ
全てのピクチャイメージを保存したいのですが「SavePicture　ピクチャボックス(大), ファイル名」
を実行してもピクチャボックス(大)のみしか保存できません。
すべてのピクチャにAutoRedraw=Trueを設定しています。

どなたか分かる方がいらっしゃいましたら教えてください。
宜しくお願いします。

回答No.5

1050 円（@1050YEN） · ベストアンサー

ループの中の
.Picture3.Picture = LoadPicture(wkAry(i))
に続いて
.Picture3.Line (50, 50)-(2400, 150), , BF
ですよね？

問題ないままに動いております。
こちらではエラーが出ておりません。

Command1_Clickイベントを張っておきます。
-----------------------------------------------------
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 wkAry　 As Variant
　　Dim i　　　 As Long
　　Dim lngCntPic　 As Long

　　'絵の情報
　　wkAry = Array( _
　　　　　　　　"C:\windows\しゃくなげ.bmp" _
　　　　　　　, "C:\windows\グリーン ストーン.bmp" _
　　　　　　　, "C:\windows\サポテック織り.bmp" _
　　　　　　　, "C:\windows\サンタフェ.bmp" _
　　　　　　　, "C:\windows\シャボン.bmp" _
　　　　　　　)

　　'ピクチャの数
　　lngCntPic = UBound(wkAry) + 1

　　'スクロールピクチャの高さ取得
　　lngScrollPicH = (lngCntPic + 1) * lngPicH

　　With Me
　　　　.Command1.Enabled = False
　　　　.Command2.Enabled = True

　　　　With .Picture1
　　　　　　.Visible = True
　　　　End With

　　　　With .Picture2
　　　　　　.Visible = True

　　　　　　.Width = lngPicW
　　　　　　.Height = lngScrollPicH
　　　　　　.Left = 0
　　　　　　.Top = lngPicH - lngScrollPicH
　　　　End With

　　　　For i = 0 To lngCntPic - 1
　　　　　　.Picture3.Picture = LoadPicture(wkAry(i))
　　　　　　.Picture3.Line (50, 50)-(2400, 150), , BF
　　　　　　'イメージを取得したいので、ペイントピクチャは使用しない
　　　　　　'Call .Picture2.PaintPicture(.Picture3.Picture, 0, (lngCntPic - i) * lngPicH, lngPicW, lngPicH, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy)
　　　　　　'イメージを取得したいので、ストレッチぶりっとを使用する
　　　　　　Call StretchBlt(.Picture2.hdc, 0, (lngCntPic - i) * lngPicH, lngPicW, lngPicH, Picture3.hdc, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy)
　　　　　　If i = 0 Then
　　　　　　　　'Call .Picture2.PaintPicture(.Picture3.Picture, 0, 0, lngPicW, lngPicH, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy)
　　　　　　　　Call StretchBlt(.Picture2.hdc, 0, 0, lngPicW, lngPicH, Picture3.hdc, 0, 0, .Picture3.ScaleWidth, .Picture3.ScaleHeight, vbSrcCopy)
　　　　　　End If
　　　　Next i

　　End With

End Sub

補足

何度も回答ありがとうございますm(__)m

'.Picture3.Picture = LoadPicture(wkAry(i))

上記文はコメント(')にしています。