• 締切済み

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

Excelの指定したセルの、 (セル左上座標を基準に)座標を指定して GIFやBMPなどの画像を表示させたいのですが、 分からなくて困っています。 セル内での座標指定またはセル内でのセンタリングの方法が分かる方は居ないでしょうか? 今の時点では指定したセルの左上に表示されてしまいます。 ソースはこんな感じなのですが・・・ with sheet .Cells(2,3).Select img="c:\test.gif" .Pictures.Insert(img).Select .Selection.Left =50 end with

みんなの回答

  • hpp
  • ベストアンサー率64% (22/34)
回答No.3

すみません。No.2で回答したhppです。 Cancel = True '既定の右クリックメニューを抑制 の前にEnd Ifが抜けてました。

JJ-TOKYO
質問者

補足

No1、No2(、No3)を参考にしたんですが、なぜか動きませんでした。 でも別の方法で解決しました。 動作確認をしたら、かきます。

  • hpp
  • ベストアンサー率64% (22/34)
回答No.2

右クリックで画像が貼り付けられるようにしたみました。 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

JJ-TOKYO
質問者

補足

回答してくださった方々、ありがとうございました。 結局は別の方法で解決してしまったのですが、 せっかくできたので、残しておきます。 動作確認も行いました。 ちょっと拡張したので、前提条件と動作の説明を加えます。 6行目のセルは、2こずつセルを結合している状態です。 つまり、(6,0)と(6,1)、(6,2)と(6,3)、・・・というふうに結合しています。 動作としては 6行目の左端から順に、8個の画像を表示します。 画像はセルの中央に表示します。 各セルに表示する画像の番号(数値型)は、配列IMG_DATAに格納してあります。 横座標を2回呼び出しているのは、セルを結合しているからです。 なお、体裁の都合により、行頭の空白は全角空白に変換してあります。 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

  • laputart
  • ベストアンサー率34% (288/843)
回答No.1

途中まで作りました。画像を貼付けて移動します。 しかしながら画像のサイズとエクセルのセルの幅の相関関係をちょっと違うような気がして再計算中です。 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

JJ-TOKYO
質問者

お礼

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

関連するQ&A