我一直在通过将一些图表和数据从excel文档复制到word文档中来创建报告。我要粘贴到content控件中,因此在excel中使用ChartObject.CopyPicture
,在word中使用ContentControl.Range.Paste
。这是在循环中完成的:
Set ws = ThisWorkbook.Worksheets("Charts")
With ws
For Each cc In wordDocument.ContentControls
If cc.Range.InlineShapes.Count > 0 Then
scaleHeight = cc.Range.InlineShapes(1).scaleHeight
scaleWidth = cc.Range.InlineShapes(1).scaleWidth
cc.Range.InlineShapes(1).Delete
.ChartObjects(cc.Tag).CopyPicture Appearance:=xlScreen, Format:=xlPicture
cc.Range.Paste
cc.Range.InlineShapes(1).scaleHeight = scaleHeight
cc.Range.InlineShapes(1).scaleWidth = scaleWidth
ElseIf ...
Next cc
End With
使用Office 2007创建这些报告产生的文件大小约为6MB,但在Office 2010中创建它们(使用相同的工作表和文档)产生的文件大小约为其10倍。
在解压docx之后,我发现额外的大小来自emf文件,这些文件对应于使用VBA粘贴的图表。在此之前,它们的大小从360到900 KB,大小为5-18 MB。而且图形效果也好不到哪里去。
更进一步,它似乎与图表风格有关。我创建了一个新的电子表格,并插入了7个数据点和相应的2D饼图。使用默认样式时,它复制为79KB的emf,使用样式26时,它复制为10MB的emf。当我使用Office2007时,图表会复制为一个700KB的emf。代码如下:
Sub CopyAndPaste()
ThisWorkbook.Worksheets("Charts").ChartObjects("Chart 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture
GetObject(, Class:="Word.Application").ActiveDocument.Range.Paste
End Sub
我可以使用xlBitmap
格式进行CopyPicture,虽然它有点小,但它比Office2007生成的EMF值要大,而且质量明显较差。是否有其他方法可以减小文件大小?理想情况下,我希望为图表生成一个分辨率与我使用Office2007时相同的文件。有没有办法只使用VBA (不修改电子表格中的图表)?有什么方法可以在不链接文档的情况下轻松复制为对象吗?
发布于 2014-08-23 06:53:45
我以前处理过类似的事情
不是使用
Document.Range.Paste
尝试使用
Document.Range.PasteSpecial DataType:= wdPasteMetafilePicture
或
Document.Range.PasteSpecial DataType:= wdPasteShape
这会将图表粘贴为图片或绘图,而不是作为嵌入的excel对象。
等同于使用“特殊粘贴...”从菜单上。
其他DataTypes也可用
http://msdn.microsoft.com/en-us/library/office/aa220339(v=office.11).aspx
发布于 2014-07-02 07:02:56
这可能是因为.emf文件的缩放不正确。使用PNG可能会解决大小问题(如上面的注释所述),但仍将是一个问题,因为它们不是矢量图像。
如果您使用AddPicture将图像添加到您的文件中,则下一页显示了一个解决方案,您可以在其中更改比例并减小文件大小,无论使用的是什么默认值。所以它可能会解决你的问题。
https://stackoverflow.com/questions/23807428
复制相似问题