从Excel写入数据到Word

• 我想使用Excel来存储列A中的“标签名称”和它们在列B中的相关“replace文本”。当代码运行时，它需要收集每个标签，一次一个（逐行），search整个Word文档中的这些单词，并用相应的replacereplace它们。
• 我注意到页眉和页脚中的特殊标签没有被replace。 我转向这篇文章（ http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm ），发现使用一系列范围（或循环遍历文档中所有可用的故事范围）我能够做到这个。
• 我改进了我的代码，正如上面的链接所build议的，只要我的代码被embedded到我的“Normal”Word文件中，从而使用Word中的VBA代码在另一个Word文档上进行操作。 但是，目标是使用VBA Excel在读取Excel文件的同时操作replace项。
• 当我将代码移动到Excel时，我挂起了一个自动化错误，

“运行时错误”-2147319779（8002801d）“：自动化错误库未注册”。

• 我已经从查看registry中find了使用“Word.Application.12”代替“Word.Application”的答案。

我有一个Windows 7,64位机器，与Microsoft Office 2007.我select了以下库：

• Excel中：

  • Visual Basic的应用程序
  • Microsoft Excel 12.0对象库
  • OLE自动化
  • Microsoft Access 12.0对象库
  • Microsoft Outlook 12.0对象库
  • Microsoft Word 12.0对象库
  • Microsoft Forms 2.0对象库
  • Microsoft Office 14.0对象库

• 字：

  • Visual Basic的应用程序
  • Microsoft Word 12.0对象库
  • OLE自动化
  • Microsoft Office 12.0对象库

我在Excel中关于VBA操作没有问题。 通常情况下，我将传递一组string到这个函数，但是现在，我已经在函数内部embedded了string，就好像我只打算交换一个string（对于任意数量的实例），另一个预定的string。

Function Story_Test() Dim File As String Dim Tag As String Dim ReplacementString As String Dim a As Integer Dim WordObj As Object Dim WordDoc As Object Dim StoryRange As Word.Range Dim Junk As Long Dim BaseFile As String 'Normally, these lines would be strings which get passed in File = "Z:\File.docx" Tag = "{{Prepared_By}}" ReplacementString = "Joe Somebody" 'Review currently open documents, and Set WordDoc to the correct one 'Don't worry, I already have error handling in place for the more complex code Set WordObj = GetObject(, "Word.Application") BaseFile = Basename(File) For a = 1 To WordObj.Documents.Count If WordObj.Documents(a).Name = BaseFile Then Set WordDoc = WordObj.Documents(a) Exit For End If Next a 'This is a fix provided to fix the skipped blank Header/Footer problem Junk = WordDoc.Sections(1).Headers(1).Range.StoryType 'Okay, this is the line where we can see the error. 'When this code is run from Excel VBA, problem. From Word VBA, no problem. 'Anyone known why this is??? '*********************************************************************** For Each StoryRange In WordObj.Documents(a).StoryRanges '*********************************************************************** Do 'All you need to know about the following function call is ' that I have a function that works to replace strings. 'It works fine provided it has valid strings and a valid StoryRange. Call SearchAndReplaceInStory_ForVariants(StoryRange, Tag, _ ReplacementString, PreAdditive, FinalAdditive) Set StoryRange = StoryRange.NextStoryRange Loop Until StoryRange Is Nothing Next StoryRange Set WordObj = Nothing Set WordDoc = Nothing End Function 

Answer 1

 For Each StoryRange In WordObj.Documents(a).StoryRanges 

应该可能是

 For Each StoryRange In WordDoc.StoryRanges 

因为你只是在上面的循环中分配的。

Answer 2

现在，我将不得不得出结论，因为我没有相反的可能性，在一个VBA环境中使用Microsoft Office 12对象库与另一个VBA环境中使用Microsoft Office 14对象库是有区别的。 我也没有手段/授权来改变，所以我现在必须得出结论，那就是两者之间的差异是罪魁祸首。 所以，如果我想继续前进并期望获得不同的结果，那么我会假设Microsoft Office 12 Object Library是正确的库，其中14有一些我不知道的差异。

感谢所有提供意见的人。 如果您有任何其他build议，我们可以讨论并转发。 谢谢！

Answer 3

这是为了更新一系列遍布于body＆Headers页脚的链接。 我没有从内存中写出这些，只是做了一些修改，包含和调整。 它向您展示了如何覆盖所有不同的部分，并且可以很容易地修改成在您的参数中工作。 请完成后发布您的最终代码。

 Public Sub UpdateAllFields() Dim doc As Document Dim wnd As Window Dim lngMain As Long Dim lngSplit As Long Dim lngActPane As Long Dim rngStory As Range Dim TOC As TableOfContents Dim TOA As TableOfAuthorities Dim TOF As TableOfFigures Dim shp As Shape Dim sctn As Section Dim Hdr As HeaderFooter Dim Ftr As HeaderFooter ' Set Objects Set doc = ActiveDocument Set wnd = ActiveDocument.ActiveWindow ' get Active Pane Number lngActPane = wnd.ActivePane.Index ' Hold View Type of Main pane lngMain = wnd.Panes(1).View.Type ' Hold SplitSpecial lngSplit = wnd.View.SplitSpecial ' Get Rid of any split wnd.View.SplitSpecial = wdPaneNone ' Set View to Normal wnd.View.Type = wdNormalView ' Loop through each story in doc to update For Each rngStory In doc.StoryRanges If rngStory.StoryType = wdCommentsStory Then Application.DisplayAlerts = wdAlertsNone ' Update fields rngStory.Fields.Update Application.DisplayAlerts = wdAlertsAll Else ' Update fields rngStory.Fields.Update End If Next 'Loop through text boxes and update For Each shp In doc.Shapes With shp.TextFrame If .HasText Then shp.TextFrame.TextRange.Fields.Update End If End With Next ' Loop through TOC and update For Each TOC In doc.TablesOfContents TOC.Update Next ' Loop through TOA and update For Each TOA In doc.TablesOfAuthorities TOA.Update Next ' Loop through TOF and update For Each TOF In doc.TablesOfFigures TOF.Update Next For Each sctn In doc.Sections For Each Hdr In sctn.Headers Hdr.Range.Fields.Update For Each shp In Hdr.Shapes With shp.TextFrame If .HasText Then shp.TextFrame.TextRange.Fields.Update End If End With Next shp Next Hdr For Each Ftr In sctn.Footers Ftr.Range.Fields.Update For Each shp In Ftr.Shapes With shp.TextFrame If .HasText Then shp.TextFrame.TextRange.Fields.Update End If End With Next shp Next Ftr Next sctn ' Return Split to original state wnd.View.SplitSpecial = lngSplit ' Return main pane to original state wnd.Panes(1).View.Type = lngMain ' Active proper pane wnd.Panes(lngActPane).Activate ' Close and release all pointers Set wnd = Nothing Set doc = Nothing End Sub