「シートをコピーして新たなブックを作成したらサイズが変わる」事件（未解決）

先日 Excel について、ある調査を依頼されました。カメラ機能で作成した図を含むシートについて、同シートをコピーして新たなブックを作成したところ、この図のサイズが勝手に変わってしまうというのです。

この問題について、オブジェクトの固定などで解決を試みましたが上手くいかず、提出期限を考えると時間切れの状態に。

そこで、真の解決方法には至らないまま、とりあえず以下の方法でお茶を濁すことにしました。

シートのコピーをマクロで行う。
コピー前に、シート内の Shape 全てについて位置とサイズ情報を記録。
コピー後に、記録した情報を同 Shape に反映する。

まず、クラスモジュールを二つ準備します。

↓ ShapeSizeClass

Option Explicit

Public myTop As Double
Public myLeft As Double
Public myHeight As Double
Public myWidth As Double

↓ ShapeClass

Option Explicit
Dim myShapes() As Variant

Private Sub Class_Initialize()
    Dim iMax As Long
        iMax = ActiveSheet.Shapes.Count
    ReDim myShapes(1 To iMax)
    Dim i As Long
    Dim myShape As Shape
        i = 1
        For Each myShape In ActiveSheet.Shapes
            Set myShapes(i) = New ShapeSizeClass
            With myShapes(i)
                .myTop = myShape.Top
                .myLeft = myShape.Left
                .myHeight = myShape.Height
                .myWidth = myShape.Width
                i = i + 1
            End With
        Next
End Sub

Private Sub Class_Terminate()
    Dim i As Long
    Dim myShape As Shape
        i = 1
        For Each myShape In ActiveSheet.Shapes
            With myShapes(i)
                myShape.Top = .myTop
                myShape.Left = .myLeft
                myShape.Height = .myHeight
                myShape.Width = .myWidth
                i = i + 1
            End With
        Next
End Sub

あとは標準モジュールで、シートをコピーするマクロの先頭に、この２行を追加します。

    Dim cl As ShapeClass
    Set cl = New ShapeClass

クラス初期化時に各情報を取得し、最後に同情報でサイズと位置を調整するわけです。

ただしこの方式には、以下の問題があると考えます。
thom.hateblo.jp

実際は、「正しい相手に情報が返っているか」を確認しながら行う必要がありますね。その場しのぎの即席マクロだったし、とりあえず結果が正しかったので良しとしてしまいましたが。

参考まで。