Excelセル内の特定座標に画像を表示させたいのですが。

Excelの指定したセルの、
（セル左上座標を基準に）座標を指定して
GIFやBMPなどの画像を表示させたいのですが、
分からなくて困っています。
セル内での座標指定またはセル内でのセンタリングの方法が分かる方は居ないでしょうか？

今の時点では指定したセルの左上に表示されてしまいます。
ソースはこんな感じなのですが・・・

with sheet
.Cells(2,3).Select
img="c:\test.gif"
.Pictures.Insert(img).Select
.Selection.Left =50
end with

No.3 回答者： hpp 回答日時： 2004/10/01 14:34

すみません。

No.2で回答したhppです。

Cancel = True '既定の右クリックメニューを抑制

の前にEnd Ifが抜けてました。

この回答への補足

No１、No２(、No３）を参考にしたんですが、なぜか動きませんでした。
でも別の方法で解決しました。
動作確認をしたら、かきます。

補足日時：2004/10/01 17:39

No.2 回答者： hpp 回答日時： 2004/10/01 14:27

右クリックで画像が貼り付けられるようにしたみました。

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim picFilenmn As Variant '画像ファイル
Dim compwk1 As Double
Dim compwk2 As Double

picFilenmn = Application.GetOpenFilename( _
"jpgファイル (*.jpg), *.jpg, bmpファイル (*.bmp), *.bmp", , "ファイルの選択", , False)

If picFilenmn <> False Then
ActiveSheet.Pictures.Insert(picFilenmn).Select

compwk1 = (Target.Height - Selection.ShapeRange.Height) / 2
compwk2 = (Target.Width - Selection.ShapeRange.Width) / 2

Selection.ShapeRange.IncrementTop compwk1
Selection.ShapeRange.IncrementLeft compwk2

Cancel = True '既定の右クリックメニューを抑制

End Sub

この回答への補足

回答してくださった方々、ありがとうございました。
結局は別の方法で解決してしまったのですが、
せっかくできたので、残しておきます。
動作確認も行いました。


ちょっと拡張したので、前提条件と動作の説明を加えます。

６行目のセルは、２こずつセルを結合している状態です。
つまり、(6,0)と(6,1)、(6,2)と(6,3)、・・・というふうに結合しています。

動作としては
６行目の左端から順に、８個の画像を表示します。
画像はセルの中央に表示します。
各セルに表示する画像の番号(数値型)は、配列IMG_DATAに格納してあります。

横座標を２回呼び出しているのは、セルを結合しているからです。

なお、体裁の都合により、行頭の空白は全角空白に変換してあります。

with sheet

　<% For int_cnt=0 To 8 %>
　　img = "c:\/img/" + "<%=IMG_DATA(int_cnt)%>" + ".gif"
　　'アクティブセル指定
　　.cells(6,<%=int_cnt%>*2+1).Select
　　'画像貼り付け
　　.Pictures.Insert(img).Select
　　'左のセルの横座標
　　selw1 = .Cells(6,<%=int_cnt%>*2+1).Width
　　'右のセルの横座標
　　selw2 = .Cells(6,<%=int_cnt%>*2+2).Width
　　'左右のセルの横座標の合計
　　selw = selw1 + selw2
　　'セルの縦座標
　　shph = objExcelApp.Selection.ShapeRange.Height
　　'アクティブセルの座標(単位：ポイント)
　　selh = .Cells(6,<%=int_cnt%>*2+1).Height
　　shpw = objExcelApp.Selection.ShapeRange.Width
　　'画像を最初にセットした位置から移動させる
　　objExcelApp.Selection.ShapeRange.IncrementTop (selh - shph) / 2
　　objExcelApp.Selection.ShapeRange.IncrementLeft (selw - shpw) / 2
　<% Next %>

'アクティブセルを左上端にもどす
.cells( 1, 1).Select
end with

補足日時：2004/10/01 18:17

No.1 回答者： laputart 回答日時： 2004/10/01 12:26

途中まで作りました。

画像を貼付けて移動します。
しかしながら画像のサイズとエクセルのセルの幅の相関関係をちょっと違うような気がして再計算中です。
Dim x, y, xx, yy, x1, y1 As Single

'セルの幅指定
x = 32
'セルの高さ指定
y = 32

'幅の設定
Columns("B:B").Select
Selection.ColumnWidth = x

Rows("2:2").Select
Selection.ColumnWidth = y

img = "c:\test.gif" '
Range("B2").Select
ActiveSheet.Pictures.Insert(img).Select

'xx = imgの幅
xx = Selection.ShapeRange.Width
' yy= imgの高さ
yy = Selection.ShapeRange.Height
xx = xx * 2.54 / 72
yy = yy * 2.54 / 72

'センタリングの位置
'移動距離の計算
x1 = (x - xx) / 2
y1 = (y - yy) / 2
x1 = x1 * 2.54
y1 = y1 * 2.54

Selection.ShapeRange.IncrementLeft x1
Selection.ShapeRange.IncrementTop y1

この回答へのお礼

質問文に言葉がたりませんでした。
セルの座標は不定です。
セル座標さえわかればできるのですが。。。

お礼日時：2004/10/01 12:59