我正在尝试将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