人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルVBAについて質問です。良回答者にはポイントはずみます。
写真のセンタリング方法についてですが、4列1行に写真を貼りたいです。
Range("A1:D4"), Range("E1:H4"), ...省略

センタリングの計算方法について、Range("A1:D4")の中心に合わせる計算方法を
教えて下さい。よろしくお願いします。

strFileName = Dir(strFilePath & "*.jpg")
Do
Set rngPicture = ActiveSheet.Range(ActiveSheet.Range("H21").Offset(j, i).Address)

Set shapePicture = ActiveSheet.Shapes.addPicture( _
Filename:=strFilePath & strFileName, LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, Width:=0, Height:=0)

With shapePicture
.ScaleHeight 0.5, msoTrue
.ScaleWidth 0.5, msoTrue
'下記は数値を足して無理やりセンタリングしています。
.Left = rngPicture.Left + 3
.Top = rngPicture.Top + 3
End With
i = i + 4
strFileName = Dir()
Loop While strFileName <> ""

●質問者: pochi1234
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● うぃんど
●100ポイント ベストアンサー

関数にしてみました

Sub MyPicList(ByVal picFilename As String, ByVal cellRange As String)
 Dim x, y, w, h As Double
 Dim x2, y2 As Double
 
  ' セル範囲の左上座標(x,y)と
  ' セル範囲の高さと幅(h,w)は次のようなプロパティで得る
 With Range(cellRange)
 x = .Left
 y = .Top
 w = .Width
 h = .Height
 End With
  '中心座標(x2,y2)を計算する
 x2 = x + w / 2
 y2 = y + h / 2
  '画像は左上基準
  '画像サイズから左上座標を計算して配置する
 With ActiveSheet.Pictures.Insert(picFilename)
 .Left = x2 - .Width / 2
 .Top = y2 - .Height / 2
 End With
End Sub

上記関数の呼び出し例

Sub Macro21()
  'ファイル名、貼り付け範囲
 Call MyPicList("ファイル名", "E1:H4")
 Call MyPicList("ファイル名", "D10:D13")
End Sub

以下はテストしてませんが、多分お望みのとおりだと思います

Sub Macro22()
 Dim strFileName As String
 Dim i As Long
 
 strFileName = Dir(strFilePath & "*.jpg")
 i = 1
 Do While strFileName <> ""
 Call MyPicList(strFileName, "E" & i & ":H" & (i + 3))
 i = i + 1
 strFileName = Dir()
 Loop
End Sub

pochi1234さんのコメント
ご回答ありがとうございます。 まだ動作チェックはしていませんが、希望通りの回答だと思います。 ポイント送信すればいいという問題ではなかったです。申し訳ありません。 今後はこういうことがないようにします。 感謝しています。

2 ● きゃづみぃ
●0ポイント
Sub test()
 strFileName = Dir(strFilePath & "*.jpg")
 i = 1
 Do
 
 a = 1
 
 Set shapePicture = ActiveSheet.Shapes.AddPicture( _
 Filename:=strFilePath & strFileName, LinkToFile:=False, SaveWithDocument:=True, _
 Left:=Cells(1, i).Left, Top:=Cells(1, i).Top, Width:=0, Height:=0)
 
 With shapePicture
 .ScaleHeight 0.5, msoTrue
 .ScaleWidth 0.5, msoTrue
 .Left = Cells(1, i).Left + (Range(Cells(1, i), Cells(1, i + 3)).Width - .Width) / 2
 End With
 i = i + 4
 strFileName = Dir()
 Loop While strFileName <> ""
End Sub

質問と趣旨が違う場合は、どこがどのように違うのかを 教えてください。


pochi1234さんのコメント
ご回答ありがとうございます。rangeが結合セルではない範囲ということです。私の説明不足でした。申し訳ありません。

きゃづみぃさんのコメント
結合セルなんですか? でも 結合セルとかは 関係なく動きますけど??? 実行してみて 違うなら ともかく 実行もしないで 違うと言われても困るなぁ・・・。

pochi1234さんのコメント
結合セルではない範囲にということです 結合セルだとoffsetしたときにずれるのでできませんでした。

きゃづみぃさんのコメント
offsetは してません。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ