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

質問

Excel2007のVBAからShell関数で外部実行プログラムを起動します。
外部実行プログラムは画像データをクリップボードへデータを出力後、自動で終了します。
Shell関数とWin32APIを使用して外部プログラムを実行し、プログラムが終了するまで待つように処理して、
クリップボードから指定する複数の結合したセルへ画像を貼り付ける事は出来たのですが、
画像がセルの左上を基準に貼り付けられます。
この画像を、セルの中央に位置調整したいのですが可能なのでしょうか？
また画像の回転（１度単位）は可能でしょうか？

'指定セルへクリップボードの内容を貼り付け
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("H53")

画像ファイルなどを読み込む訳ではないため、画像データ自体に名前がありません。
手動で位置調整は可能ですが、自動化出来ないかと色々調べ試してみたのですが、思う様に実現できません。
セルの結合は５行、列は結合していません。

どなたか御存知でしたら回答下さい。

回答No.4

onlyrom · ベストアンサー

またまた登場,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
'----------------------------------------

どうですか？
ど真ん中に移動したと思いますが。

補足

>当方は動作確認してから投稿するようにしています。
決して意地悪をしている訳ではありませんので御容赦下さい。
時間を割いて回答頂いています事に感謝しています。

で、新しいブックで実行してみました。
確かにセルの中央に移動しました。
最初はエラーになるので、なぜなのか考えてみたら、
オブジェクトを選択状態にしないと駄目なんですね。

再度、質問になりますが、コード中の
Range("H53").Top - .Height
Range("H53").Left - .Width
「.Height」と「.Width」は挿入したオブジェクトの「高さ」、「幅」でしょうか？

やはり、VBAは難しい(><

回答No.6

okormazd

ANo.1
です。

>説明不足でしたがシートには、画像以外のものもあります。
（コマンドボタンなど）
何があっても関係ありません。

>確かに回転は不可能でした。
どんな画像か知りませんが、普通は回転できます。選択マークが黒四角になっていないでしょうね。

>移動は出来ましたが、微調整が微妙ですね。
私は、移動できることを示しただけで、細かいことは他の人の回答で十分です。onlyromさんでいいでしょう。

>セルのサイズを変更すると問題になりそうです。
セルサイズの変更とは関係ないようにもできます。
図の書式設定―プロパティ

>挿入する順番は決まっていませんので、Indexで指定出来るかどうか・
なぜ指定できないのですか。indexがわかれば指定できるでしょう。indexをとっておけばいいですよ。
また、名前を知ることができますし、気に入った名前につけ変えることもできます。

...Shapes(sn).name="適当な名前"

お礼

>なぜ指定できないのですか
「できない」はプログラムで実現できないではなく、VBA自体を理解できていないのでコードが書けないという意味です。
ＶＢ（ＮＥＴ以前）なら基本的な部分は理解出来るのですが、似た環境といっても、やはり違います。
エクセル自体使う機会が少ないですし。

コード自体は、もう少しのところで完成かな？というところまで進展しました。
名前のつけ変えもトライしてみたいと思います。

ありがとうございました。

回答No.5

end-u

こんにちは。

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で充分だとは思いますが。

お礼

end-uさん、ありがとうございます。
>最後に追加されたShapeになります。
確かにそうなりました。

質問には書いていなかったのですが、画像は複数挿入します。
ただ、挿入する順番は決まっていませんので、Indexで指定出来るかどうか・・・

提示頂いたコードは帰宅後試してみます。

回答No.3

onlyrom

再度の登場、onlyromです。

＞移動は出来ましたが、意図する位置に移動しませんでした。

当方は動作確認してから投稿するようにしています。
提示したコードも動作確認済です。
ちゃんとど真ん中に移動するはずです。

条件、■Ｈ５３～Ｈ５７の５セルが結合してありますか？

意図した動作をしないという質問者のコードをアップしてください。
一緒に解決しませう。

回答No.2

onlyrom

●位置について●

セルの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になるでしょうからそれについてはネット検索してみてください。

以上。

お礼

onlyromさん、確かに回転は不可能でした。
移動は出来ましたが、意図する位置に移動しませんでした。
どちらかといえば右方向に移動したいのですが、左へ移動します。
コードと「にらめっこ」で色々調べてみたのですが・・・
再度方法を思案中です。

ＶＢなら基本的なところは理解できているのですが、
ＶＢＡは「似て非なる」ものですね。

ありがとうございました。

回答No.1

okormazd

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

でどうでしょう。

お礼

okormazdさん、説明不足でしたがシートには、画像以外のものもあります。
（コマンドボタンなど）

コードをそのまま利用させて頂いたのですが、
確かに回転は不可能でした。
移動は出来ましたが、微調整が微妙ですね。
セルのサイズを変更すると問題になりそうです。
再度方法を思案中です。

ありがとうございました。