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中工作的方式编写代码? 我试图确保所有的偏好是相同的,但我可能错过了一些可能导致问题的偏好。 任何想法将不胜感激,因为这是我的一个问题。

你基本上有两个问题:

  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 ,只是findselect 。 为了取代 ,我需要做的事情是:

 .Execute Replace:=wdReplaceAll 

但是,这两个粘贴(无论是PasteAndFormatExecuteMso已成功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