Question

我的下面的代码有问题。我创建了一个用户窗体，以便自动生成我准备的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

Answer 1

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

我通过提前退出程序而不是使用“箭头代码”来增强了可读性。
现在打开的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

Excel VBA修改带书签的Word文档

1 个答案: