如何克服此“运行时错误” 4605?

时间:2019-05-30 09:06:55

标签: excel vba ms-word

我正在尝试将Excel工作表数据转换为Word,稍后它应将文件保存在Word中的特定路径中。

赞: 我将把数据提供到excel工作表中,然后从这些数据中准备Word中的一个字母,然后将该字母以Word的形式保存在特定路径中。

但是正如我尝试使用以下代码,如果我的数据超过20个,则最终出现运行时错误4605。

这是我当前正在工作的工作簿链接: https://app.box.com/s/slwwvm6zrdt7po8ecilfs7zi0pbeuta1

请建议或帮助我解决这个问题。

    Dim appWD As Word.Application
    Dim lastrow As Long
    Dim name As String
    Dim rng As Range
    Dim ws, ws1 As Worksheet
    Set appWD = CreateObject("Word.Application")
    appWD.Visible = True
    Application.ScreenUpdating = False
    Sheets("Revision").Select
    filesave = Range("N2").Value
    Set ws = Sheets("Revision")
    Set ws1 = Sheets("Template")

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastrow
        With ws
            emp_id = Range("A" & i).Value
            name = Range("B" & i).Value
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("A1")
            .Range("D" & i).Copy Destination:=Sheets("Template").Range("A2")
            .Range("E" & i).Copy Destination:=Sheets("Template").Range("A3")
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("F16")
            .Range("D" & i).Copy Destination:=Sheets("Template").Range("F17")
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("B4")
            .Range("M" & i).Copy Destination:=Sheets("Template").Range("D4")
            .Range("F" & i & ":L" & i).Copy
            With ws1
                .Range("C8").PasteSpecial Transpose:=True
                .Application.CutCopyMode = False
            End With
        End With
        With ws1.Range("A1:C4")
            .Copy
            appWD.Documents.Add
            With appWD.Selection
                .Font.Bold = True
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .TypeText Text:="PROMOTION & SALARY REVISION LETTER"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphRight
                .InsertDateTime
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphLeft
                .PasteSpecial DataType:=wdPasteText
                .Font.Bold = False
                .TypeParagraph
                .TypeText Text:="This is to keep you informed that your designation & salary has been revised with effect from "
                .TypeParagraph
            End With
        End With

        With ws1.Range("D4")
            .Application.CutCopyMode = False
            .Copy
            With appWD.Selection
                '.Font.Bold = True
                .Paste
                '.Font.Bold = False
            End With
        End With

        With ws1
            .Range("D8").Formula = "=RC[-1]*12"
            .Range("D9").Formula = "=RC[-1]*12"
            .Range("D10").Formula = "=RC[-1]*12"
            .Range("D11").Formula = "=RC[-1]*12"
            .Range("D12").Formula = "=RC[-1]*12"
            .Range("D13").Formula = "=RC[-1]*12"
            .Range("D14").Formula = "=RC[-1]*12"
            Set rng = Range("C7:C14")
            With rng.Borders
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThin
            End With
            Application.CutCopyMode = False
        End With
        With ws1.Range("B6:D14")
            .Application.CutCopyMode = False
            .Copy
            With appWD.Selection
                .PasteExcelTable LinkedToExcel:=False, _
                    WordFormatting:=False, RTF:=False
                .TypeParagraph
                .TypeText Text:="The remuneration stated above is subject to the terms and conditions of your contract of employment of which this is a part"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Font.Bold = True
                .TypeText Text:="ACKNOWLEDGED AND AGREED"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphLeft
                .TypeText Text:="Yours faithfully"
                .TypeParagraph
                .TypeText Text:="XYZ Private Limited.,"
                .TypeParagraph
                .TypeParagraph
                .TypeText Text:="ABC"
                .TypeParagraph
                .TypeText Text:="CEO                                                                        ACCEPTANCE"
            End With
        End With

        With ws1.Range("E16:F17")
            .Application.CutCopyMode = False
            .Copy
            With appWD
                .Selection.TypeParagraph
                .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
                .Selection.PasteSpecial DataType:=wdPasteText
                .ActiveDocument.SaveAs Filename:=filesave & "\" & emp_id & "_" & name & "_Increment_Letter" & "_1920"
                .ActiveDocument.Close
            End With
            Application.CutCopyMode = False
        End With
        Sheets("Revision").Select
    Next i
    appWD.Quit
End Sub

0 个答案:

没有答案