VBA脚本将Excel图表复制到Word不能在更高版本的Word中工作

我正在尝试将Excel图表复制到Word。 我在Excel中有以下脚本，它适用于PC和Office Mac 2011的Office 2003.在Office（2016）的更高版本中，图表在粘贴时不会resize，并且它所search的令牌不会被replace为图表它在早期的版本中。 这是可用的脚本，但不适用于更高版本的Office。 任何帮助将不胜感激。

ActiveChart.ChartArea.Select ActiveChart.ChartArea.Copy Set wrd = CreateObject("Word.Application") wrd.Documents(DocumentName).Activate wrd.Selection.Find.ClearFormatting With wrd.Selection.Find .Text = "insert" & ChartName 'This is the token it is looking for in the Word document and is where the chart should be inserted. .Replacement.Text = "" .Forward = True .Wrap = 1 'wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute If .Found = True Then wrd.Selection.PasteAndFormat Type:=13 'wdChartPicture End If 

在早期版本的Office中，此脚本通过查找令牌并粘贴它来将活动图表复制并粘贴到Word中。 令牌被图表取代，图表被resize。 在较新的版本中，令牌保留在图表的底部，图表未被resize。

如果无法弄清楚为什么它不起作用，是否有可能以强制它在所有版本的Office中工作的方式编写代码？ 我试图确保所有的偏好是相同的，但我可能错过了一些可能导致问题的偏好。 任何想法将不胜感激，因为这是我的一个问题。

Answer 1

你基本上有两个问题：

1. 为什么不在Excel 2016中工作
2. 我怎样才能使这个代码独立于版本和操作系统？

我没有2016 Excel，也没有Mac OS，所以我可能无法回答＃1，但是我将在Excel 2010和2013中分享我的一些发现，以便在2016年帮助您find解决scheme。我是能够回答下面的＃2。

Excel 2010/2013调查结果：

在2010年的Excel中，我看到了一些类似的问题.Execute实际上并没有取代文本。 我观察到的是.Execute改变了select – 实质上是.Execute selectfind的文本。 IOW，它不会默认replace ，只是find并select 。 为了取代 ，我需要做的事情是：

 .Execute Replace:=wdReplaceAll 

但是，这两个粘贴（无论是PasteAndFormat或ExecuteMso已成功replace新的“select”。

我在Excel 2013中观察到了 这一点 ， 这是MSDN上logging的最新版本 ，可能与2016年相同的对象模型。

NB我使用.CopyPicture方法而不是.Copy方法。 用这种方法你可能会有更好的运气。 这是值得一试的。

寻求独立于版本（和操作系统无关的代码）

是否有可能以强制其在所有版本的Office中工作的方式编写代码？

是的，这需要确定每个版本中的工作方式，并使用一种称为“ 条件编译”的技术。 通常使用这种技术来适应对象模型的变化，这会引起编译错误。

例如，假设这个代码块在2003年运行：

  .Execute If .Found = True Then wrd.Selection.PasteAndFormat Type:=13 'wdChartPicture End If 

这个代码块在2010年和2013年工作：

  .Execute Replace:=wdReplaceAll If .Found = True Then wrd.CommandBars.ExecuteMSO "PasteAsPicture" End If 

还有一些其他的代码在2016+工作（这不是真正的代码，但忍受着我）：

  .Execute Replace:=wdReplaceAll If .Found = True Then wrd.SOMETHING_FOR_2016 End If 

那么你会做：

 #If Mac Then Debug.Print "Mac" .Execute If .Found = True Then wrd.SOMETHINGFORMAC 'pseudo-code End If #Else Debug.Print "Windows" Select Case CLng(Application.Version) Case 11 'Excel 2003 Debug.Print 2003 .Execute If .Found = True Then wrd.Selection.PasteAndFormat Type:=13 'wdChartPicture End If Case 14 'Excel 2010 Debug.Print 2010 .Execute Replace:=wdReplaceAll If .Found = True Then wrd.CommandBars.ExecuteMSO "PasteAsPicture" End If Case 15 'Excel 2013 Debug.Print 2013 .Execute Replace:=wdReplaceAll If .Found = True Then wrd.CommandBars.ExecuteMSO "PasteAsPicture" End If Case Is > 15 'Excel 2016+ Debug.Print "2016+" .Execute Replace:=wdReplaceAll If .Found = True Then wrd.SOMETHING_FOR_2016 End If Case Else MsgBox "Other versions would require add'l logic..." End Select #End If