[[20250806084458]]　『画像をセル中央に配置』（初心者）　ページの最後に飛ぶ

『画像をセル中央に配置』（初心者）

　ネットから画像貼り付けを参照にしたのですが、
このままではセルトップ配置なのですが、画像をセル中央に配置する場合、
「Top = 」「Left =」をどのように修正すれば良いのでしょうか、
マクロ初心者ですよろしくお願いいたします。

Sub セル値の画像を貼り付ける()

Dim Tate, Yoko
Dim Top, Left
Dim Picdata As Object
Dim Gyou As Long
Dim Path As String
Dim Filename As String
Dim s As Integer

Path = Range("b3").Value
If Right(Path, 1) = "\" Then
Else
Path = Path & "\"
End If

Gyou = 6

Do While Range("a" & Gyou) <> ""
Filename = Range("a" & Gyou).Value & ".jpg"
Range("b" & Gyou).Select
Top = ActiveCell.Top
Left = ActiveCell.Left

On Error Resume Next
Set Picdata = ActiveSheet.Shapes.AddPicture(Path & Filename, True, True, Left, Top, -1, -1)

If s = 1 Then

Yoko = ActiveCell.MergeArea.width
Picdata.height = Picdata.height * (Yoko / Picdata.width)
Picdata.width = Yoko
Else

Tate = ActiveCell.MergeArea.height '* 0.93
Picdata.width = Picdata.width * (Tate / Picdata.height)
Picdata.height = Tate
End If

ActiveSheet.Hyperlinks.Add Anchor:=Picdata, Address:=Path & Filename

Set Picdata = Nothing
Gyou = Gyou + 1

Loop

MsgBox "同名の画像がない場合は、無視されます。"
End Sub

＜使用 Excel：Excel2013、使用 OS：Windows11 ＞

セルの中心座標を計算して
図形のLeftを、「横方向のセルの中心」-(「図形の横の長さ」÷2)
図形のTopを、セルの中心「縦方向のセルの中心」-(「図形の縦方向の長さ」÷2)
してあげればよいと思います。

（匿名） 2025/08/06(水) 10:38:16

 PicData.IncrementLeft (ActiveCell.MergeArea.Width - PicData.Width) / 2
 PicData.IncrementTop (ActiveCell.MergeArea.Height - PicData.Height) / 2
（´・ω・`） 2025/08/06(水) 10:41:23

参考 URL です。
https://ja.extendoffice.com/documents/excel/4924-excel-picture-center-cell.html
（?） 2025/08/06(水) 16:05:14

コメント返信：

[ 一覧(最新更新順) ]

[[20250806084458]] 『画像をセル中央に配置』（初心者） ページの最後に飛ぶ

[[20250806084458]]　『画像をセル中央に配置』（初心者）　ページの最後に飛ぶ