Excelで挿入した図をセルの中央に配置したいです

質問

よろしくお願いします
以前の質問を見ましたが
接合したセルの中央に配置したいので参考になりませんでした
EXCEL2000を利用しています
OSはXPです
16行4列を接合(左上がA26)しています
その位置に写真ファイルを挿入するのですが
中央に配置することができません
100シート近く挿入するので
簡単に出来ると助かります
よろしくお願いします

回答No.1

zap35 · ベストアンサー

マクロのサンプルを２つ書きました
picCenterは処理対象のセルを固定しています（この例ではアクティブなシートのA26セル）。
またselCenterは、シート上で選択されたセルを処理対象とします。（ただし選択されているのが結合セルでない場合は、先頭の１セルだけを処理対象範囲とします）

いずれも対象セル範囲にある画像を「対象セル範囲の中央」に配置します。ただし画像がセル範囲より大きいときは何もしません。

マクロはALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

とりあえず「16行4列を接合(左上がA26)しています」の中に画像を貼り付けてマクロを動かしてみてください

Sub picCenter()
Dim p As Object
Dim rng, trg As Range
Const adr As String = "A26"　'処理対象セルの左上のアドレス
　　If Range(adr).MergeCells Then
　　　　Set rng = Range(adr).MergeArea
　　Else
　　　　Set rng = Range(adr)
　　End If
　　For Each p In ActiveSheet.Pictures
　　　　Set trg = Intersect(rng, p.TopLeftCell)
　　　　If Not trg Is Nothing Then
　　　　　　If p.Width < rng.Width Then
　　　　　　　　p.Left = rng.Left + (rng.Width - p.Width) / 2
　　　　　　End If
　　　　　　If p.Height < rng.Height Then
　　　　　　　　p.Top = rng.Top + (rng.Height - p.Height) / 2
　　　　　　End If
　　　　End If
　　Next p
End Sub

Sub selCenter()
Dim p As Object
Dim rng, trg As Range
　　If TypeName(Selection) = "Range" Then
　　　　If Selection.MergeCells Then
　　　　　　Set rng = Selection.Cells(1, 1).MergeArea
　　　　Else
　　　　　　Set rng = Selection.Cells(1, 1)
　　　　End If
　　End If
　　For Each p In ActiveSheet.Pictures
　　　　Set trg = Intersect(rng, p.TopLeftCell)
　　　　If Not trg Is Nothing Then
　　　　　　If p.Width < rng.Width Then
　　　　　　　　p.Left = rng.Left + (rng.Width - p.Width) / 2
　　　　　　End If
　　　　　　If p.Height < rng.Height Then
　　　　　　　　p.Top = rng.Top + (rng.Height - p.Height) / 2
　　　　　　End If
　　　　End If
　　Next p
End Sub

お礼

ありがとうございます
おかげさまで出来ました
助かりました
またよろしくお願いします。

回答No.2

imogasi

>接合(
セル結合の誤り？
＞16行4列を接合(左上がA26)
１つの図（写真）はそうだとして、第２、第３の写真の置くシートと位置はどうなるの。
＞エクセルには「シート」というものがあります。
１シートに１写真にするのですか。
＞Excelで挿入した図を
図といっても、写真らしいから、「Excelで挿入した写真を」と質問したら。
ーー
読み込まれた写真は、シート上に浮いたようなもので、かろうじてエクセルでは、セルのＴＯＰ，ＬＥＦＴなどに関連づけ（アンカー係留的に）て位置づけ出来ます。するとセルの幅の変動などに影響を受けるわけです。
ーー
私はＢ３：Ｄ１３をセル結合してやってみました。
Sub test01()
MsgBox Range("B3").MergeArea.Address
t = Range("B3").MergeArea.Top
MsgBox t
l = Range("B3").MergeArea.Left
MsgBox l
h = Range("B3").MergeArea.Height
MsgBox h
w = Range("B3").MergeArea.Width
MsgBox w
End Sub
でセル結合後のセルのＴｏｐ，・・などの値が取れます
ーー
＞セルの中央に配置とは書いてあるが
余白をどうするか書いてない。書くべきです。１０と仮定。
（セル幅、行高で１０でも見た目違う。）
写真のトップなどの位置は
s_top=top+10
s_left=left+10
s_height=height-20
s_width=width-20
--
それでマクロの記録を修正して
Sub Macro1()
t = Range("B3").MergeArea.Top
l = Range("B3").MergeArea.Left
h = Range("B3").MergeArea.Height
W = Range("B3").MergeArea.Width

ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\xxx\My Documents\My Pictures\P1010038.JPG").Select
Selection.ShapeRange.Top = t + 10
Selection.ShapeRange.Left = l + 10
Selection.ShapeRange.Height = h - 20
Selection.ShapeRange.Width = W - 20
End Sub
xxxはユーザー。
ーー
写真１００枚の繰り返しは、アクチブシートを順次移動して、そのアクチブシートに対し上記を行う。その前に各・毎シートで下記を行う
Sub test01()
ActiveSheet.Range("B3:D13").MergeCells = True
End Sub
ーー
写真の数の捉え方
写真が増えたときｎ増えた分の処理
など難しいことが未考察ですが。

お礼

ありがとうございます
おかげさまで出来ました
書き込む情報が足りずにすみませんでした
それなのに、いろいろわかりやすくありがとうございます。