指定形状的尺寸的错误

我想创建一个宏，它可以识别现有形状“图片1”（增强型图元文件）的大小和位置，删除该形状，从另一个图表复制图表“图表3”工作簿放入原始工作簿作为增强型图元文件，并且大小/移动副本与原始形状的大小/位置相同。指定形状的尺寸的错误

我已宣布目标工作表为“wkst”，源工作表为“来源”。除了一件事情之外，它完美地工作：复制形状的第一个维度始终与原始形状略有关系，无论我首先设置了哪个维度。在下面的代码的情况下，形状的高度稍微改变。

我添加了消息框，所以我可以确保它们的值匹配，但是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

来源

2013-07-15 user2583978

在这种情况下，您需要添加一些参数来设置复制的形状的尺寸。因此，而不是你的这部分代码的：

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-15 16:46:58

指定形状的尺寸的错误

回答

相关问题