VBAによるセル内の画像の位置調整

Question

Excel2007のVBAからShell関数で外部実行プログラムを起動します。
外部実行プログラムは画像データをクリップボードへデータを出力後、自動で終了します。
Shell関数とWin32APIを使用して外部プログラムを実行し、プログラムが終了するまで待つように処理して、
クリップボードから指定する複数の結合したセルへ画像を貼り付ける事は出来たのですが、
画像がセルの左上を基準に貼り付けられます。
この画像を、セルの中央に位置調整したいのですが可能なのでしょうか？
また画像の回転（１度単位）は可能でしょうか？

'指定セルへクリップボードの内容を貼り付け
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("H53")

画像ファイルなどを読み込む訳ではないため、画像データ自体に名前がありません。
手動で位置調整は可能ですが、自動化出来ないかと色々調べ試してみたのですが、思う様に実現できません。
セルの結合は５行、列は結合していません。

どなたか御存知でしたら回答下さい。

onlyrom · Accepted Answer

またまた登場,onlyromです。

百聞は一見に如かず、ということで新しいブックのSheet1で以下を実行してください。


　Ｈ５３～Ｈ５７　を結合して（画像より大分大きめに幅、高さを広げておく）

任意の場所に画像を貼り付け、又は　挿入

その後、下記コードをコピペして実行


'---------------------------------------
Sub test()
　With Selection
　　.Top = (Range("H58").Top - Range("H53").Top - .Height) / 2 + Range("H53").Top
　　.Left = (Range("I53").Left - Range("H53").Left - .Width) / 2 + Range("H53").Left
　End With
End Sub
'----------------------------------------

どうですか？
ど真ん中に移動したと思いますが。

okormazd · Answer

ANo.1
です。

>説明不足でしたがシートには、画像以外のものもあります。
（コマンドボタンなど）
何があっても関係ありません。

>確かに回転は不可能でした。
どんな画像か知りませんが、普通は回転できます。選択マークが黒四角になっていないでしょうね。

>移動は出来ましたが、微調整が微妙ですね。
私は、移動できることを示しただけで、細かいことは他の人の回答で十分です。onlyromさんでいいでしょう。

>セルのサイズを変更すると問題になりそうです。
セルサイズの変更とは関係ないようにもできます。
図の書式設定―プロパティ

>挿入する順番は決まっていませんので、Indexで指定出来るかどうか・
なぜ指定できないのですか。indexがわかれば指定できるでしょう。indexをとっておけばいいですよ。
また、名前を知ることができますし、気に入った名前につけ変えることもできます。

...Shapes(sn).name="適当な名前"

end-u · Answer

こんにちは。

Sub try()
　　Const n As Long = 4　　'margin
　　Dim r　 As Range
　　Dim x　 As Double

　　With Worksheets("Sheet1")
　　　　Set r = .Range("H53").MergeArea
　　　　.Activate
　　　　.PasteSpecial Format:="図 (拡張メタファイル)"
　　End With
　　With Selection.ShapeRange
　　　　x = Application.Min((r.Width - n) / .Width, (r.Height - n) / .Height)
　　　　.LockAspectRatio = msoTrue
　　　　If x < 1 Then .Width = .Width * x
　　　　.Left = r.Left + (r.Width - .Width) / 2
　　　　.Top = r.Top + (r.Height - .Height) / 2
　　End With
　　ActiveCell.Select
　　Set r = Nothing
End Sub

こんな感じでどうでしょう。

>確かに回転は不可能でした。
との記述から、Paste後、その画像はObjectとして貼り付けられていませんか？
選択して[名前BOX]で確認してみてください。
回転させるなら、Shapeとして貼り付けるのが手っ取り早いです。
その場合は [Rotationプロパティ]や[IncrementRotationメソッド]が使えます。

Selectionを使いたくなければokormazdさんが書かれている
...Shapes(Sheet.Shapes.Count) で指定できますよ。
コマンドボタンなどの画像以外のものがあっても判定できます。
Shapes.Count、つまりShapesの最大値のIndexでShapeを指定しますから
最後に追加されたShapeになります。

#PasteSpecialの場合、たぶんSheet.Activateが必要なのでSelectionで充分だとは思いますが。

onlyrom · Answer

再度の登場、onlyromです。

＞移動は出来ましたが、意図する位置に移動しませんでした。

当方は動作確認してから投稿するようにしています。
提示したコードも動作確認済です。
ちゃんとど真ん中に移動するはずです。

条件、■Ｈ５３～Ｈ５７の５セルが結合してありますか？

意図した動作をしないという質問者のコードをアップしてください。
一緒に解決しませう。

onlyrom · Answer

●位置について●

セルのTop,Leftプロパティと
画像のTop,Left,Height,Widthプロパティから位置を計算する。

■Ｈ５３～Ｈ５７の５セルが結合してある場合

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("H53")

に続けて以下のコードを。。

With Selection
　.Top = (Range("H58").Top - Range("H53").Top - .Height) / 2 + Range("H53").Top
　.Left = (Range("I53").Left - Range("H53").Left - .Width) / 2 + Range("H53").Left
End With

'----------------------------------------------------


●回転について●

図形(オートシェイプ)やグラフならIncrementRotationメソッドで回転できますが
貼り付けた（あるいは挿入した）画像(jpg,gif等)を回転させるメソッドはありませんので出来ません。

ただその貼り付けた画像はオートシェイプと同じく、Shapesコレクションに組み込まれますのでShapeオブジェクトで参照できます。

ということで回転はAPIになるでしょうからそれについてはネット検索してみてください。

以上。

okormazd · Answer

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("H53")
sn = ActiveSheet.Shapes.Count 
With ActiveSheet.Shapes(sn)      
.Top = 200 '画像の行 1上端からの距離(pixel)
.Left = 200 '画像の列1左端からの距離(pixel)
.Rotation = 5 '回転角
End With

でどうでしょう。

VBAによるセル内の画像の位置調整

またまた登場,onlyromです。

この回答への補足

ANo.1

こんにちは。

再度の登場、onlyromです。

●位置について●

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("H53")

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング