VBA将Excel图表复制到Word作为图片更改图表大小答案

【问题标题】：VBA copying Excel chart to Word as picture changes the chart sizeVBA将Excel图表复制到Word作为图片更改图表大小
【发布时间】：2016-11-22 02:46:16
【问题描述】：

我想创建一个宏，用于从 Excel 复制图表并将它们作为图片粘贴到 Word 中（最好是增强型元文件）。

我设置了一个 Word 模板文档，其中包含一个表格，其中包含应插入图片的特定单元格中的书签。

但是，使用我当前的代码，插入的图像太大了，把整个表格搞砸了。我尝试了不同的图片选项（增强的图元文件、png 等），但它们都有相同的结果。

当我尝试在表格中使用PasteSpecial 手动复制图表时，它会保持原来的大小，这正是我想要的。

我必须在我的代码中进行哪些更改才能获得它？

Sub CopyCharts2Word()

Dim wd As Object
Dim ObjDoc As Object
Dim FilePath As String
Dim FileName As String
FilePath = "C:\Users\Name\Desktop"
FileName = "Template.docx"


'check if template document is open in Word, otherwise open it
On Error Resume Next
Set wd = GetObject (, "Word.Application")    
If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
    Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
Else
    On Error GoTo notOpen
    Set ObjDoc = wd.Documents(FileName)
    GoTo OpenAlready
notOpen:
    Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
End If
OpenAlready:
On Error GoTo 0

'find Bookmark in template doc 
wd.Visible = True                                              
ObjDoc.Bookmarks("Boomark1").Select  

 'copy chart from Excel        
 Sheets("Sheet1").ChartObjects("ChartA").chart.ChartArea.Copy        

 'insert chart to Bookmark in template doc
 wd.Selection.PasteSpecial Link:=False, _
 DataType:=wdPasteMetafilePicture, _
 Placement:=wdInLine, _
 DisplayAsIcon:=False

 End Sub

【问题讨论】：

您是否尝试在手动复制/粘贴时记录宏并比较代码？
是的，问题是，它只记录了我在 Excel 中所做的事情（即选择并复制图表，而不是我如何将它插入 Word 文档）。当我尝试在 Word 中录制粘贴图表的宏时，它不会让我选择要插入图表的表格。
手动粘贴时，展示位置是什么？我相信它是紧的而不是内联的。 word 也有内联形状，请查看。这会有所帮助。
谢谢cyboashu，这是正确的线索：紧有助于保持大小！将图表插入 Word 后，我尝试调整它的大小，但我在处理内联形状时遇到了困难，因为它在表格内...

标签： excel vba charts ms-word copy-paste

【解决方案1】：

是的，就是这样：

我换了

'insert chart to Bookmark in template doc
wd.Selection.PasteSpecial Link:=False, _
DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, _
DisplayAsIcon:=False

与

wd.Selection.PasteSpecial Link:=False, _
DataType:=wdPasteMetafilePicture, _
Placement:=wdTight, _    
DisplayAsIcon:=False

这样，图表的大小与 Excel 工作表中的大小保持一致！

【讨论】：

【解决方案2】：

拉斐尔谢谢你。我使用了您的解决方案的一部分。当我从 excel 创建新的 word 文档时，我的问题是书签。而且我没有找到更好的书签解决方案，所以我查看了不同的网站，这是我的解决方案（感谢来自不同网站和 Stackoverflow 的所有答案）

Sub Kpyla_Click()

Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim crt As Object
Dim pic As Word.Shape
Dim ust As Word.Range

Kpyla.Caption = "E->W"
Kpyla.Font.Size = 14
Kpyla.Height = 25
Kpyla.Width = 40
Kpyla.Top = 60
Kpyla.Left = 180
Kpyla.Visible = True

On Error GoTo ErrHandler1
Set crt = ActiveSheet.ChartObjects(1)
MsgBox ("Active Chart")
crt.Activate

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")

If wdApp Is Nothing Then
    MsgBox ("Creating New")
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Add
Else
    MsgBox ("Active")
    Set wdDoc = wdApp.ActiveDocument
End If

wdApp.Visible = True

With wdDoc.PageSetup
    .Orientation = wdOrientLandscape
    .TopMargin = wdApp.InchesToPoints(0.25)
    .BottomMargin = wdApp.InchesToPoints(0.25)
    .LeftMargin = wdApp.InchesToPoints(0.25)
    .RightMargin = wdApp.InchesToPoints(0.25)
    .HeaderDistance = wdApp.InchesToPoints(1)
    .FooterDistance = wdApp.InchesToPoints(1)
End With
Set ust = wdDoc.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range
ust.Text = "" & vbNewLine

With wdApp.Selection
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
End With

crt.Chart.ChartArea.Copy

Set wdRng = wdDoc.ActiveWindow.Selection.Range
wdRng.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdTight, DisplayAsIcon:=True

wdDoc.Content.Select '''/

With wdApp.Selection
    .Collapse Direction:=0
    .InsertBreak Type:=7
End With

MsgBox ("Ending")
Exit Sub

ErrHandler1: MsgBox ("No Chart") Exit Sub End Sub

【讨论】：