ここから本文です

【VBA】ワークシートのクリックイベント(図の挿入)について教えて下さい。

ste********さん

2010/3/1813:39:31

【VBA】ワークシートのクリックイベント(図の挿入)について教えて下さい。

ワークシートへの図の挿入について教えて下さい。
以下のコードで図の挿入を行っているのですが、縦横比を無視してセルの幅に合わせて図を挿入させるにはどのように書き換えればいいのでしょうか。
ご教授宜しくお願いいたします。



Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)

Cancel = True

'===============画像選択
myF = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF = False Then
MsgBox "画像を選択してください(終了)"
Exit Sub
End If

'===============画像の掃除
For Each mySP In ActiveSheet.Shapes
myAD1 = mySP.TopLeftCell.MergeArea.Address
myAD2 = Target.Address
If myAD1 = myAD2 Then mySP.Delete
Next

'===============画像の貼り付け
Set mySP = ActiveSheet.Pictures.Insert(myF)

'===============タテヨコの縮尺を保持
myHH = Target.Height / mySP.Height
myWW = Target.Width / mySP.Width
If myHH > myWW Then
mySP.Height = mySP.Height * myWW
mySP.Width = Target.Width
Else
mySP.Height = Target.Height
mySP.Width = mySP.Width * myHH
End If

'===============中央へ調整
myHH2 = (Target.Height / 2) - (mySP.Height / 2)
myWW2 = (Target.Width / 2) - (mySP.Width / 2)
mySP.Top = Target.Top + myHH2
mySP.Left = Target.Left + myWW2

Set mySP = Nothing

End Sub



※現状貼り付けると「緑」のようになりますが、これを「赤」のようにさせたいのです。
宜しくお願いします。

mySP.Height,mySP.Width,Target.Height,Target.Width,Set mySP,stepperser,msoFalse

閲覧数:
1,441
回答数:
1
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

fre********さん

2010/3/1816:14:38

stepperserさん、こんにちは

縦横比を無視して、セルの幅高さに合わせたいとのこと。
単純に、ActiveSheet.Pictures.Insertではなくて、
ActiveSheet.Shapes.AddPictureを使用する。

変更後(画像の貼り付け処理以降から)
'===============画像の貼り付け
With Target
ActiveSheet.Shapes.AddPicture myF, msoFalse, msoTrue, _
.Left, .Top, .Width, .Height
End With
End Sub

質問した人からのコメント

2010/3/19 09:34:26

降参 思っていたように配置されました!ありがとうございました!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる