Question

我正在尝试将我的图表从一张纸复制到另一张。

在我的床单中，我的图表有不同的尺寸。但是在sheet2中，我希望我的图表具有相同的高度和宽度。

有人可以建议我怎么做吗？

我运行以下代码，只是为了复制图表。我想把它们放在常规尺寸上。

Sub Overview()
Sheets("Cat").Select
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Copy
Sheets("Overview").Select
Range("B5").Select
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
Range("B5").Select

Answer 1

如果我理解你的话，你想调整表格中所有聊天的大小，以便它们具有相同的宽度和高度。

下面的代码将在工作表中运行所有图表，并将为宽度和高度设置新值，并将更改位置。

'Set Position off all Charts
    Dim intTop As Integer
    Dim intLeft As Integer
    Dim idx As Integer
    intTop = 275 'start Position from the Top for the first chart
    intLeft = 15 'strat positon from the left for the first chart
    idx = 0

    wsDia.Select
    For Each myChart In ActiveSheet.ChartObjects
        myChart.Width = 450
        myChart.Height = 200
        myChart.Top = intTop
        myChart.Left = intLeft

        intLeft = intLeft + 465
        idx = idx + 1
        If idx = 4 Then 'after 4 Charts, go to next row of charts
            intLeft = 15
            intTop = intTop + 230
            idx = 0
        End If

    Next myChart

<强>更新

如果你想改变PNG图片的高度，你需要像这样循环：

第一个循环是你想要用锁定的比率设置大小。这意味着如果您将高度设置为500，宽度将自动设置。

For Each mypNg In ActiveSheet.Shapes


    mypNg.Height = 500
Next

如果你想要比率unlocket，你必须添加：

    mypNg.LockAspectRatio = msoFalse

Answer 2

试试这段代码。

Dim Cht As Chart
Dim Ws As Worksheet, toWs As Worksheet
Set Ws = Sheets("Cat")
Set toWs = Sheets("Overview")
Set Cht = Ws.ChartObjects(1).Chart
Cht.CopyPicture
toWs.Activate
Range("b5").Activate
toWs.Paste

从一张纸复印到另一张时，调整图表的大小

2 个答案: