首页 文章

将数据从Excel写入Word

提问于
浏览
1
  • 我想使用Excel在列A中存储"tag names",在列B中存储它们关联的"replacement text" . 当代码运行时,它需要一次一个地收集每个标记(逐行),在整个Word文档中搜索这些单词,并用相应的替代品替换它们 .

  • 我注意到页眉和页脚中的特殊标签没有被替换 . 我转向这篇文章(http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm)并发现使用一系列范围(或循环浏览文档中所有可用的故事范围)我能够做到这一点 .

  • 我改进了我的代码,正如上面链接中所建议的那样,只要我的代码嵌入到我的"Normal" Word文件中,就可以使用Word中的VBA代码来操作另一个Word文档 . 但是,目标是在读取Excel文件时使用VBA Excel操作替换 .

  • 当我将代码移动到Excel时,我会挂起一个读取的自动化错误,

“运行时错误'-2147319779(8002801d)':自动化错误库未注册 . ”

  • 我已经从审查注册表到使用"Word.Application.12"代替"Word.Application"寻找答案 .

我有一台带有Microsoft Office 2007的Windows 7,64位机器 . 我选择了以下库:

  • Excel:

  • Visual Basic For Applications

  • 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 For Applications

  • Microsoft Word 12.0对象库

  • OLE自动化

  • Microsoft Office 12.0对象库

关于VBA,我在Excel内部操作没有任何问题 . 通常,我会将一组字符串传递给这个函数,但是现在,我已经在函数内部嵌入了字符串,好像我只计划交换一个字符串(对于任意数量的实例),另一个预定的字符串 .

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

3 回答

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

    应该是

    For Each StoryRange In WordDoc.StoryRanges
    

    因为你刚刚在上面的循环中分配了它 .

  • 0

    现在,我将不得不得出结论,因为我没有可能进行相反的测试,在一个VBA环境中使用Microsoft Office 12对象库和在另一个VBA环境中使用Microsoft Office 14对象库之间存在差异 . 我也没有手段/授权来改变,所以我必须得出结论,就目前而言,两者之间的区别是罪魁祸首 . 所以,如果我要前进并期望不同的结果,我会假设Microsoft Office 12对象库是正确的库,其中14有一些我不知道的差异 .

    感谢所有提供输入的人 . 如果您有任何其他建议,我们可以讨论并转发 . 谢谢!

  • 0

    这是为了更新遍布正文和页眉页脚的一堆链接 . 我没有写这个只是从记忆中做了一堆修复,包含和调整 . 它向您展示了如何覆盖所有不同的部分,并且可以轻松修改以在您的参数范围内工作 . 完成后请发布最终代码 .

    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
    

相关问题