宏更新 MS Word 标题中的表格单元格时出现问题

发布于 2025-01-14 13:50:24 字数 1867 浏览 3 评论 0原文

我正在开发一个宏,它将根据我存储在 Excel 中的值更新 MS Word 标题中表格的单元格。希望这将加快我正在处理的 100 多个字文档中手动更新包含项目阶段和截止日期的标题的过程。我对 VBA 知之甚少,但将这段代码拼凑在一起,希望知道自己在做什么的人能给我指出正确的方向,让这段代码正常工作。如果有帮助的话,很乐意提供更多信息。谢谢!

更新:感谢所有为使其正常工作提供建议的人 - 由于某种原因仍然出现错误。识别和编辑标题中的表格时遇到一些问题。

我在这一行收到错误 5941 - 请求的集合成员不存在

With oWordDoc.Sections(1)...    

这是我得到的:

Sub UpdateSpecHeaders()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim sFolder As String, strFilePattern As String
Dim strFileName As String, sFileName As String

    '> Folder containing files to update
sFolder = Range("A20").Value

    '> Identify file extension to search for
strFilePattern = "*.doc"

'> Establish a Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

Application.ScreenUpdating = False

'> Loop through the folder to get the word files
strFileName = Dir$(sFolder & strFilePattern)
Do Until strFileName = ""
    sFileName = sFolder & strFileName
    

    '> Open the word doc
    Set oWordDoc = oWordApp.Documents.Open(sFileName)
           
    '> Update Header
              
    With oWordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Range
    
            .Cells(Row:=3, Column:=1).Text = Range("A3").Value
            .Cells(Row:=3, Column:=2).Text = Range("B3").Value
    End With
                
    '> Save and close the file
           
    oWordDoc.SaveAs Filename:=oWordDoc.Name
    oWordDoc.Close SaveChanges:=False
        
    '> Find next file
    strFileName = Dir$()
Loop

'> Quit and clean up
Application.ScreenUpdating = True
oWordApp.Quit

Set oWordDoc = Nothing
Set oWordApp = Nothing

End Sub

I'm working on a macro that will update the cells of a table in an MS Word header according to values I'm storing in excel. Hoping this will speed up the process of manually updating the headers containing the project phase and due date in the 100+ word docs I'm working with. I know very little about VBA but cobbled this code together and hoping someone who knows what they're doing could point me in the right direction to get this code working. Happy to provide more information if it helps. Thanks!

Update: Thanks to all who have provided suggestions for getting this to work - still getting an error for some reason. Having some trouble recognizing and editing the table in the header.

I'm getting Error 5941 on this line - Requested member of the collection does not exist

With oWordDoc.Sections(1)...    

Here's what I've got:

Sub UpdateSpecHeaders()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim sFolder As String, strFilePattern As String
Dim strFileName As String, sFileName As String

    '> Folder containing files to update
sFolder = Range("A20").Value

    '> Identify file extension to search for
strFilePattern = "*.doc"

'> Establish a Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

Application.ScreenUpdating = False

'> Loop through the folder to get the word files
strFileName = Dir$(sFolder & strFilePattern)
Do Until strFileName = ""
    sFileName = sFolder & strFileName
    

    '> Open the word doc
    Set oWordDoc = oWordApp.Documents.Open(sFileName)
           
    '> Update Header
              
    With oWordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Range
    
            .Cells(Row:=3, Column:=1).Text = Range("A3").Value
            .Cells(Row:=3, Column:=2).Text = Range("B3").Value
    End With
                
    '> Save and close the file
           
    oWordDoc.SaveAs Filename:=oWordDoc.Name
    oWordDoc.Close SaveChanges:=False
        
    '> Find next file
    strFileName = Dir$()
Loop

'> Quit and clean up
Application.ScreenUpdating = True
oWordApp.Quit

Set oWordDoc = Nothing
Set oWordApp = Nothing

End Sub

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

命比纸薄 2025-01-21 13:50:24

我收到错误 424 - 此行需要对象

With ActiveDocument.Sections(1)...    

这是因为您从 Excel 运行 VBA 宏,其中简写属性为 ActiveWorksheetActiveWorkbook 等。但是ActiveDocument 属性才有意义。因此,应更改以下代码:

  '> Update Fields
    oWordApp.ActiveDocument.Fields.Update
    
    
    '> Update Header
    
        With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(2)
        .Cell(Row:=3, Column:=1).Text = Range("A3").Value
        .Cell(Row:=3, Column:=2).Text = Range("B3").Value
            
        End With

它应该如下所示:

  '> Update Fields
    oWordApp.ActiveDocument.Fields.Update
    
    
    '> Update Header
    
        With oWordApp.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(2)
        .Cell(Row:=3, Column:=1).Text = Range("A3").Value
        .Cell(Row:=3, Column:=2).Text = Range("B3").Value
            
        End With

I'm getting Error 424 - Object Required on this line

With ActiveDocument.Sections(1)...    

That is because you run the VBA macro from Excel where shorthand properties are ActiveWorksheet, ActiveWorkbook and etc. But the ActiveDocument property makes sense only when you run the code in Word. So, the following code should be changed:

  '> Update Fields
    oWordApp.ActiveDocument.Fields.Update
    
    
    '> Update Header
    
        With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(2)
        .Cell(Row:=3, Column:=1).Text = Range("A3").Value
        .Cell(Row:=3, Column:=2).Text = Range("B3").Value
            
        End With

It should look like that:

  '> Update Fields
    oWordApp.ActiveDocument.Fields.Update
    
    
    '> Update Header
    
        With oWordApp.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(2)
        .Cell(Row:=3, Column:=1).Text = Range("A3").Value
        .Cell(Row:=3, Column:=2).Text = Range("B3").Value
            
        End With

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文