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

我正试图将我的图表从一张图复制到另一张图上。

在我的工作表中，我有我的不同大小的图表。 但在sheet2中，我希望我的图表具有相同的高度和宽度。

任何人都可以build议我怎么能做到这一点？

我有下面的代码运行，只是为了复制图表。 我想要他们在正常的大小。

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

如果我理解你是正确的，你想调整你的聊天logging在表格中，这样他们将拥有完全相同的宽度和高度。

下面的代码将运行所有图表，并将设置宽度和高度的新值，并将改变位置。

 '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图片的高度，你需要像这样循环：

第一个循环是如果你想设置一个locking比例的大小。 这意味着如果将高度设置为500，宽度将自动设置。

 For Each mypNg In ActiveSheet.Shapes mypNg.Height = 500 Next 

如果你想要比例解锁，你必须添加：

  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