VBA Excel运行时错误4198命令失败

igetnqfo  于 2023-03-04  发布在  其他
关注(0)|答案(1)|浏览(287)

我有下面的代码的问题。在我的PC上它运行正常,并从Word模板生成PDF文件。我尝试了.rtf或.docx的模板文档。在PC上工作,我得到了
运行时错误4198命令失败。
在另一台电脑(笔记本电脑)同样的错误。在所有的电脑上,我已经安装了Word和Excel。

Sub PdfEleDomVtNt()
    Dim wdDoc As Document
    Dim wdApp As Word.Application
    Set wdApp = New Word.Application
    Dim objField1 As Object
    Dim objField2 As Object
    Dim objField3 As Object
    Dim objField4 As Object
    Dim objField5 As Object
    Dim objField6 As Object
    Dim objField7 As Object
    Dim objField8 As Object
    Dim objField9 As Object
    Dim objField10 As Object
    Dim objField11 As Object
    Dim objField12 As Object
    Dim objField13 As Object
    Dim objField14 As Object
    Dim objField15 As Object
    Dim objField16 As Object
    Dim objField17 As Object
    Dim objField18 As Object
    Dim objField19 As Object
    Dim objField20 As Object
    Dim objField21 As Object
    Dim objField22 As Object
    Dim objField23 As Object
    Dim objField24 As Object
    Dim objField25 As Object
    Dim objField26 As Object
    Dim objField27 As Object
    Dim objField28 As Object
    Dim objField29 As Object
    Dim objField30 As Object
    Dim objField31 As Object
    Dim objField32 As Object
    Dim objField33 As Object
    
    ThisWorkbook.Sheets("vlozene_hodnoty").Range("B21").Dirty
    
    Dim pdfFileName As Variant
    
    If ThisWorkbook.Sheets("vlozene_hodnoty").Range("A20").Value = "" Then
    pdfFileName = ThisWorkbook.Path & "\" + Sheets("vlozene_hodnoty").Range("B23").Value + ".pdf"
    Else
    
    pdfFileName = ThisWorkbook.Sheets("vlozene_hodnoty").Range("A20").Value + "\" + ThisWorkbook.Sheets("vlozene_hodnoty").Range("B23").Value + ".pdf"
    End If
    
    wdApp.Visible = False 'Nastav hodtnotu Tru pro viditelnost aplikace Word
    On Error GoTo ErrHandler
    
    Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Templates\YELLO_Kalkulace_MOO_2T_ELE.rtf") 
    On Error GoTo 0
    
    Set objField1 = wdDoc.FormFields("Text1")
    Set objField2 = wdDoc.FormFields("Text2")
    Set objField3 = wdDoc.FormFields("Text3")
    Set objField4 = wdDoc.FormFields("Text4")
    Set objField5 = wdDoc.FormFields("Text5")
    Set objField6 = wdDoc.FormFields("Text6")
    Set objField7 = wdDoc.FormFields("Text7")
    Set objField8 = wdDoc.FormFields("Text8")
    Set objField9 = wdDoc.FormFields("Text9")
    Set objField10 = wdDoc.FormFields("Text10")
    Set objField11 = wdDoc.FormFields("Text11")
    Set objField12 = wdDoc.FormFields("Text12")
    Set objField13 = wdDoc.FormFields("Text13")
    Set objField14 = wdDoc.FormFields("Text14")
    Set objField15 = wdDoc.FormFields("Text15")
    Set objField16 = wdDoc.FormFields("Text16")
    Set objField17 = wdDoc.FormFields("Text17")
    Set objField18 = wdDoc.FormFields("Text18")
    Set objField19 = wdDoc.FormFields("Text19")
    Set objField20 = wdDoc.FormFields("Text20")
    Set objField21 = wdDoc.FormFields("Text21")
    Set objField22 = wdDoc.FormFields("Text22")
    Set objField23 = wdDoc.FormFields("Text23")
    Set objField24 = wdDoc.FormFields("Text24")
    Set objField25 = wdDoc.FormFields("Text25")
    Set objField26 = wdDoc.FormFields("Text26")
    Set objField27 = wdDoc.FormFields("Text27")
    Set objField28 = wdDoc.FormFields("Text28")
    Set objField29 = wdDoc.FormFields("Text29")
    Set objField30 = wdDoc.FormFields("Text30")
    Set objField31 = wdDoc.FormFields("Text31")
    Set objField32 = wdDoc.FormFields("Text32")
    Set objField33 = wdDoc.FormFields("Text33")
    
    objField1.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N3"), "# ###")
    objField2.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N4")
    objField3.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N5")
    objField4.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N6")
    objField5.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N7")
    objField6.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N8")
    objField7.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N9")
    objField8.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N10")
    objField9.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N11")
    objField10.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N12"), "### ###")
    objField11.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N13"), "### ###")
    objField12.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N14"), "# ###,##0.00") 
    objField13.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N15"), "# ###,##0.00") 
    objField14.Result = ThisWorkbook.Sheets("vlozene_hodnoty").Range("N16") 'frekvence
    objField15.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N17"), "### ###") 
    objField16.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N18"), "#,###0.000") 
    objField17.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N19"), "#,###0.000") 
    objField18.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N20"), "#,###0.000") 
    objField19.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N21"), "#,###0.000") 
    objField20.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N22"), "# ###,##0.00") 
    objField21.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N23"), "# ###,##0.00") 
    objField22.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N24"), "#,###0.000")
    objField23.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N25"), "#,###0.000")
    objField24.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N26"), "#,###0.000")
    objField25.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N27"), "#,###0.000")
    objField26.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N28"), "# ###,##0.00")
    objField27.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N29"), "# ###,##0.00")
    objField28.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N30"), "#,###0.000")
    objField29.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N31"), "#,###0.000")
    objField30.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N32"), "#,###0.000")
    objField31.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N33"), "#,###0.000")
    objField32.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N34"), "# ###,##0.00")
    objField33.Result = Format(ThisWorkbook.Sheets("vlozene_hodnoty").Range("N35"), "# ###,##0.00")
    
    wdDoc.SaveAs pdfFileName, wdFormatPDF
    
    objField1.Result = ("")
    objField2.Result = ("")
    objField3.Result = ("")
    objField4.Result = ("")
    objField5.Result = ("")
    objField6.Result = ("")
    objField7.Result = ("")
    objField8.Result = ("")
    objField9.Result = ("")
    objField10.Result = ("")
    objField11.Result = ("")
    objField12.Result = ("")
    objField13.Result = ("")
    objField14.Result = ("")
    objField15.Result = ("")
    objField16.Result = ("")
    objField17.Result = ("")
    objField18.Result = ("")
    objField19.Result = ("")
    objField20.Result = ("")
    objField21.Result = ("")
    objField22.Result = ("")
    objField23.Result = ("")
    objField24.Result = ("")
    objField25.Result = ("")
    objField26.Result = ("")
    objField27.Result = ("")
    objField28.Result = ("")
    objField29.Result = ("")
    objField30.Result = ("")
    objField31.Result = ("")
    objField32.Result = ("")
    objField33.Result = ("")
    
    wdDoc.Close
    wdApp.Quit
    
    Shell "rundll32.exe url.dll,FileProtocolHandler " & pdfFileName, vbNormalFocus
    Exit Sub

ErrHandler:
    MsgBox "Soubor se šablonou se nepodařilo otevřít. Zkontrolujte cestu a název souboru.", vbCritical
End Sub

我检查了VBA中的引用,更改了模板的文档类型,但我已经结束了。我还尝试了谷歌运行时错误4198,但没有什么帮助我。错误显示与代码“wdDoc.SaveAs pdfFileName,wdFormatPDF”,但正如我所说,只有在工作PC或笔记本电脑上。

sycxhyv7

sycxhyv71#

您可以重复使用同一对象来填充表单域。

Option Explicit

Sub PdfEleDomVtNt()

    Const TEMPLATE = "YELLO_Kalkulace_MOO_2T_ELE.rtf"

    Dim wdDoc As Document, wdApp As Word.Application
    Dim wb As Workbook, ws As Worksheet, folder As String
    Dim objField As Word.FormField, v As Variant
    Dim pdfFileName As String, i As Long
      
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("vlozene_hodnoty")
    
    With ws
        .Range("B21").Dirty
        If .Range("A20").Value = "" Then
            folder = wb.Path
        Else
            folder = .Range("A20").Value
        End If
        If Right(folder, 1) <> "\" Then folder = folder & "\"
        pdfFileName = folder & .Range("B23").Value + ".pdf"
    End With
    
    Set wdApp = New Word.Application
    wdApp.Visible = False 'Nastav hodtnotu Tru pro viditelnost aplikace Word
    
    On Error GoTo ErrHandler
    Set wdDoc = wdApp.Documents.Open(wb.Path & "\Templates\" & TEMPLATE)
    On Error GoTo 0
    
    For i = 3 To 35
        v = ws.Cells(i, "N")
        Set objField = wdDoc.FormFields("Text" & i - 2)
        Select Case i
            Case 3
               objField.result = Format(v, "# ###")
               
            Case 4 To 11, 16 'frekvence
                objField.result = v
                
            Case 12, 13, 17
                objField.result = Format(v, "### ###")
                
            Case 14, 15, 22, 23, 28, 29, 34, 35
                objField.result = Format(v, "# ###,##0.00")
                
            Case Else
                objField.result = Format(v, "#,###0.000")
        End Select
    Next
 
    Debug.Print pdfFileName
    wdDoc.SaveAs pdfFileName, wdFormatPDF
    wdDoc.Close
    wdApp.Quit
    
    MsgBox pdfFileName & " Created", vbInformation
    
    Shell "rundll32.exe url.dll,FileProtocolHandler " & pdfFileName, vbNormalFocus
    Exit Sub

ErrHandler:
    MsgBox "Soubor se šablonou se nepodarilo otevrít. Zkontrolujte cestu a název souboru.", vbCritical
End Sub

相关问题