VB6での画像のサイズ変更に関して

お世話になります

VB6での画像のサイズ変更に関して教えていただけないでしょうか

機能としては、画像を読み込み、指定サイズ枠内のサイズで一旦フォームに表示して画像を確認
問題なければ、エクセルに保存なのですが
フォーム表示時にサイズを変更したにも関わらず、
エクセルに保存すると、元画像のサイズで保存されてしまいます。
表示と保存を同じtwip幅にするにはどのようにしたらよろしいでしょうか

******** 画像読み込み＆リサイズ抜粋
Me.CDialog.CancelError = True
Me.CDialog.Flags = cdlOFNExplorer + cdlOFNLongNames + cdlOFNHideReadOnly + cdlOFNNoChangeDir + cdlOFNFileMustExist
Me.CDialog.Filter = strMessage(33) & "(*.jpg;*.bmp)|*.jpg;*.bmp"
Me.CDialog.Filename = ""
Me.CDialog.ShowOpen
Me.CDialog.Flags = 0
If Err Then
Err.Clear
On Error GoTo 0
Exit Sub
End If
If Trim(Me.CDialog.Filename) = "" Then
On Error GoTo 0
Exit Sub
End If

' 画像の比率を保って、画像をセットする
Me.PImage(Index).Stretch = False ' 一旦元の大きさで読み込み指定
Me.PImage(Index).Visible = False ' 一旦非表示にする

Me.PImage(Index).Picture = LoadPicture(Me.CDialog.Filename)
' 縦方向基準縮尺変更
If Me.PImage(Index).Height > Report_PImageHei Then
Me.PImage(Index).Stretch = True
HWTemp = Me.PImage(Index).Height
Me.PImage(Index).Height = Report_PImageHei
Me.PImage(Index).Width = Me.PImage(Index).Width * Me.PImage(Index).Height / HWTemp
End If
' 横方向基準縮尺変更
If Me.PImage(Index).Width > Report_PImageWid Then
HWTemp = Me.PImage(Index).Width
Me.PImage(Index).Stretch = True
Me.PImage(Index).Width = Report_PImageWid
Me.PImage(Index).Height = Me.PImage(Index).Height * Me.PImage(Index).Width / HWTemp
End If


********* エクセルへの出力抜粋(上記と別関数)
Clipboard.Clear
Clipboard.SetData Me.PImage(i).Picture
WB.ActiveSheet.Cells(YY1, XX1).Select
WB.ActiveSheet.Paste
pict = Selection.Name
Clipboard.Clear

No.1 ベストアンサー 回答者： ghost305jp 回答日時： 2013/10/02 00:11

私のPCにVB６の環境が無い為、以下では動かないかもしれませんが、参考になればと思います。

'PictureMotoに読み取る
PictureMoto.Picture = LoadPicture(Me.CDialog.Filename)

Me.PImage(Index).Stretch = FALSE
Me.PImage(Index).Width = intDrawPictureWidth
Me.PImage(Index).Height = intDrawPictureHeight
'縮小して画像描画
Me.PImage(Index).PaintPicture PictureMoto.Picture, 0, 0, intDrawPictureWidth, intDrawPictureHeight


Ｐ．Ｓ．
Stretchは表示サイズを変更しているだけで、元の画像はサイズ変更していないと認識しております。

この回答へのお礼

回答ありがとうございます
現在はImageBoxで作成しているので、これからPictureBoxで作り直して試してみます。

お礼日時：2013/10/02 08:48