0

の既存の図形 "Picture 1" (拡張メタファイル) のサイズと位置を認識し、その図形を削除し、グラフ "Chart 3" を別のブックから元のブックに拡張メタファイルとしてコピーするマクロを作成したいと考えています。コピーをサイズ/移動して、元の形状のサイズ/位置と同じにします。

宛先ワークシートを「wkst」、ソース ワークシートを「Source」と宣言しました。最初に設定した寸法に関係なく、コピーされた形状の最初の寸法は常に元の形状からわずかにずれています。以下のコードの場合、形状の高さがわずかに変化します。

メッセージ ボックスを追加したので、値が一致していることを確認できましたが、 (元の形状の高さ) は(コピーされた形状の高さ)MsgBox CurrentHと同じ値を表示しません。MsgBox wkst.Shapes("Picture 1").Heightわずかに変化します。つまり、594 から 572 です。

どんな助けでも素晴らしいでしょう、ありがとう!

Dim CurrentW As Double
Dim CurrentH As Double
Dim CurrentT As Double
Dim CurrentL As Double

    CurrentH = wkst.Shapes("Picture 1").Height
    CurrentW = wkst.Shapes("Picture 1").Width
    CurrentT = wkst.Shapes("Picture 1").Top
    CurrentL = wkst.Shapes("Picture 1").Left

    MsgBox CurrentH
    MsgBox CurrentW
    MsgBox CurrentT
    MsgBox CurrentL

    Source.ChartObjects("Chart 3").Copy
    wkst.Shapes("Picture 1").Delete
    wkst.Activate
    wkst.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
    With ActiveWindow.Selection
            .Name = "Picture 1"
            .Height = CurrentH
            .Width = CurrentW
            .Left = CurrentL
            .Top = CurrentT
    End With

    MsgBox wkst.Shapes("Picture 1").Height
    MsgBox wkst.Shapes("Picture 1").Width
    MsgBox wkst.Shapes("Picture 1").Top
    MsgBox wkst.Shapes("Picture 1").Left
4

1 に答える 1

0

この状況では、コピーしたシェイプの寸法を設定するパラメータをさらに追加する必要があります。したがって、コードのこの部分の代わりに:

With ActiveWindow.Selection
        .Name = "Picture 1"
        .Height = CurrentH
        .Width = CurrentW
        .Left = CurrentL
        .Top = CurrentT
End With

これを追加する必要があります：

With wkst.Shapes(wkst.Shapes.Count) '<-- the code set parameters of Shape therefore _
                                    this line need to be changed, too
        .Name = "Picture 1"
        .Left = CurrentL
        .Top = CurrentT
'new part -->
        .LockAspectRatio = msoFalse
    Dim Ratio As Double
        Ratio = CurrentH / CurrentW
        .ScaleHeight Ratio, msoFalse, msoScaleFromTopLeft
'<--new part
        .Width = CurrentW
        .Height = CurrentH
End With

パラメータの順序は重要です。コードは試され、テストされており、私にとってはうまく機能しています。

于 2013-07-15T16:46:58.970 に答える