Excel VBA 用书签修改word文档

Xela 发表于 Dev

谢拉

我下面的代码有问题。我创建了一个用户表单，以便自动生成我准备的 Word 文档（我创建了一堆书签）。

它在我的电脑上运行得很好，但在另一台电脑上却没有，我真的不明白为什么。两台计算机都具有相同的 Office 版本 (1902)，并且我已激活 Microsoft Word 16.0 对象库参考。

我所说的“它不起作用”是指 Word 文档将打开但不会执行任何操作......而且我没有一条错误消息。

    Private Sub BCO_Click()

        Dim objWord As New Word.Application, wordDoc As Word.Document

'FCO is the userform and the subobjects are combobox entries.
        If FCO.SOCIETENAME <> "" And FCO.NUMCO <> "" And FCO.ComboBox1 <> "" Then

            Dim pathcovierge As String
            Dim pathconew As String

'Path of the files needed there, copy from an existing (pathcovierge) to a new one (pathconex)
            pathcovierge = path & "\Documents_Vierges\" & "CO.docx"
            pathconew = path & "\CO\CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx"

            If Dir(path & "\CO\", vbDirectory) = "" Then MkDir path & "\CO\"

'If file already open, msgbox
            On Error Resume Next

            FileCopy pathcovierge, pathconew

            If Err > 0 Then
                MsgBox "Veuillez fermer CO.docx afin de générer un CO."
            End If



'opening of the new word document

            objWord.Visible = True
            objWord.Documents.Open pathconew

            Dim DocDest As Word.Document
            Set DocDest = GetObject(pathconew)


'THIS IS NOT WORKING.

            DocDest.Bookmarks("WNUMCO").Range.Text = FCO.NUMCO.Value
            DocDest.Bookmarks("WDATECO").Range.Text = FCO.DATECO.Value
            DocDest.Bookmarks("WNOMCLIENT").Range.Text = FCO.SOCIETENAME.Value



'Saving (working)
            DocDest.SaveAs pathconew
            AppActivate ("CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx")

            On Error GoTo 0
        Else
            MsgBox "Veuillez rentrer tous les champs obligatoires (*)"
        End If


    End Sub

未处理的异常

我查看了您的代码并进行了一些更改（另请参阅我在代码中的注释）：

我通过提前退出程序而不是使用“箭头代码”来增强可读性。
现在打开的 Word 文档将立即设置为变量。
您的错误处理抑制了所有错误。我改变了它，但你应该添加适当的错误处理。考虑将您的程序拆分为几个单独的程序。

这应该会导致您的结果：

Private Sub BCO_Click()
    If FCO.SOCIETENAME = "" Or FCO.NUMCO = "" Or FCO.ComboBox1 = "" Then
        MsgBox "Veuillez rentrer tous les champs obligatoires (*)"
        Exit Sub
    End If

    Dim pathcovierge As String
    pathcovierge = path & "\Documents_Vierges\" & "CO.docx"

    Dim pathconew As String
    pathconew = path & "\CO\CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx"

    If Dir(path & "\CO\", vbDirectory) = "" Then MkDir path & "\CO\"

    'This seems to be the reason why you get no error:
    On Error Resume Next

    FileCopy pathcovierge, pathconew

    If Err > 0 Then
        MsgBox "Veuillez fermer CO.docx afin de générer un CO."
    End If

    'This will let you see a possible error, but you should think about implement a proper error handling though:
    On Error Goto 0

    Dim objWord As Word.Application
    Set objWord = New Word.Application
    objWord.Visible = True

    Dim docDest As Word.Document
    'If the problem was to get the handle to the opened document, this should work better:
    Set docDest = objWord.Documents.Open(pathconew)

    docDest.Bookmarks("WNUMCO").Range.Text = FCO.NUMCO.Value
    docDest.Bookmarks("WDATECO").Range.Text = FCO.DATECO.Value
    docDest.Bookmarks("WNOMCLIENT").Range.Text = FCO.SOCIETENAME.Value

    docDest.SaveAs pathconew

    AppActivate ("CO_" & UCase(FCO.SOCIETENAME.Value) & "_" & UCase(FCO.NUMCO.Value) & ".docx")
End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。