Excel VBA オートシェイプ座標の微妙なズレ

Question

急ぎのため端的に質問させていただきます。ご了承ください。

同じBOOK内のExcelシートに「旧シート」と「新シート」があります。
「旧シート」にオートシェイプを複数配置してあるのを、新シートにVBAでコピー＆ペーストしているのですが、ペースト後座標反映の際「旧シート座標（single型）」から「新シート座標（Double型）」になってしまい、新シートで座標にズレが生じます。
どのように解決したら良いでしょうか。
※旧シートのオートシェイプはループで全て読取り、１つずつコピペ処理しています。
以下、ほんの一部実装部分（大文字小文字の違いは見逃してください）

Dim wkOldSht As workSheet '旧シート
Dim wkNewSht As workSheet '新シート

'以下ループ内の記述（大幅省略）

wkOldSht.Shapes(li).Copy
wkNewSht.Paste
'以下座標取得にてdouble/Variant=single の状態になり座標がずれてしまう
Selection.Top = wkOldSht.Shapes(li).Top
Selection.Left = wkOldSht.Shapes(li).Left

【追記】
ケータイからなので短めで失礼します。
ウォッチ式に出る値の例です
旧シート座標→5671.909
新シートに入った座標→5672.25

Comments

[ttyp03]

Excel2010ではShapesでCopyが使えないのですが、Excelのバージョンを教えてもらえますか。

[DgRp_08]

バージョンを失念しておりました。
バージョンは2010ですが、こちらではCopy使用でコピー自体はできているのですが…

[ttyp03]

失礼しました。Copyが使えなかったのはこちらのミスでした。

[ttyp03]

同じようなコードを書いてやってみましたが問題なかったです。掲載していないコード以外に何かあるのかもしれないですね。

Answer 1

対象を一度アクティブにして、貼り付け時と同じSelectionから座標を取得してはどうでしょう？

    Dim dblTop As Double
    Dim dblLeft As Double
    
    '元シートでShapeを選択し、座標を取得
    wkOldSht.Activate
    wkOldSht.Shapes(li).Select
    dblTop = Selection.Top
    dblLeft = Selection.Left
    
    '旧⇒新にコピー＆ペースト
    wkOldSht.Shapes(li).Copy
    wkNewSht.Activate
    wkNewSht.Paste
    
    Selection.Top = dblTop
    Selection.Left = dblLeft

貼り付けのたびにシート切替を行うのでちらつくと思います。
これがまずい場合は再描画OFF設定

Application.ScreenUpdating = False

もあわせて実装すれば抑制できると思います。

Comments

[DgRp_08]

教えていただいた方法で出来ました！
ありがとうございます

元々の記述的に「double=single」のせいでズレが生じるから、左辺もなんとかsingleにしなければならない、と対処法を真逆に勘違いしてました。

また一つ勉強になりました。本当にありがとうございました！

[jawa]

オートシェイプの座標を揃えるという目的から考えて、考え方は正しかったと思います。

今回はそのやり方では（貼り付け後のオートシェイプの特定など）面倒なことが多かったので、裏道から回り込んだアドバイスをさせていただきました(^-^;

Answer 2

確認してみました。
確かにShapeとSelectionでは、型が異なるようですね。
但し、こちらで確認した感じは次のような感じで、あくまでも小数点以下の差異でしかありませんでした。

18.88638 ←Shape
18.8863773345947 ←Selection

今ある情報からの対策としてはtakitoさんと同じ回答になってしまいますが、Selectionを使わずにShapeに対して設定してみるくらいでしょうか。

wkNewSht.Shapes(li).Top = wkOldSht.Shapes(li).Top
wkNewSht.Shapes(li).Left = wkOldSht.Shapes(li).Left

Comments

[DgRp_08]

回答有り難うございました！
jawaさんの方法で解決することが出来ました。
selectionを使わないやり方はうまく行きませんでした。もしかしたらものすごく大量にコピー対象外にもオートシェイプがあることでどこかしらカウントがずれてるのかもしれませんが、原因特定はまだできていません。
ありがとうございました。
また何かありましたらよろしくお願いします。

Answer 3

Excel 2013 で動きを確認しました

wkNewSht.Shapes(wkNewSht.Shapes.Count).Top = wkOldSht.Shapes(li).Top
wkNewSht.Shapes(wkNewSht.Shapes.Count).Left = wkOldSht.Shapes(li).Left

こんな感じに新シートの方もShapesで取り扱ってあげるのはだめでしょうか？

Comments

[DgRp_08]

アドバイスいただきましてありがとうございます！
試してみたのですが、ダメでした。
コピー対象外に元々配置してあるボタンや凡例記号群などもあるのでもしかしたらカウントがずれてるのかもしれませんので、そこは調査してみます。。