我在 Excel 中创建了一个宏来打开 Word docx,交换一些内容,然后我想另存为新的 word docx 并创建 PDF。除了保存新的 Word docx 之外,我一切正常 - 有人可以帮我让它工作吗?
这就是我试图用来保存新单词 docx 的内容 - 如果我删除它,其余部分就可以完美工作。
ActiveDocument.SaveAs Filename:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".doc"
这是完整的脚本。
Sub Secondments()
Dim wd As Word.Application
Dim doc As Word.Document
Set wd = New Word.Application
wd.Visible = True
Dim SetVarFromCell()
Dim Y As Long
Dim X As Long
Y = Worksheets("User Input").Cells(32, "C").Value
X = Y + 1
Dim V As String
Dim P As String
Dim H As String
Dim oRng As Word.Range
Dim para As Word.Paragraph
Dim found As Boolean
Dim A As String
A = ActiveWorkbook.Path & "\"
'MsgBox "The path is " & A, vbInformation
For i = 2 To X
V = Worksheets("Secondments").Cells(i, 31).Value
P = Worksheets("Secondments").Cells(i, 33).Value
H = Worksheets("Secondments").Cells(i, 20).Value
Set doc = wd.Documents.Open("\\Hbap.adroot.hsbc\au\IT Operations\DATA\Restricted\HeadOffice\HPE\Recruitment Centre\Recruitment Process Australia\Offers\Secondments\Automated Letters\Secondment Template.docx")
If H = "N" Then
Set oRng = wd.ActiveDocument.Range
With oRng.Find
.Text = "<<HDACopy1>>"
.Wrap = wdFindStop
found = .Execute
Do While found
Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
para.Range.Delete
Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
para.Range.Delete
oRng.Collapse wdCollapseEnd
oRng.End = wd.ActiveDocument.Content.End
found = oRng.Find.Execute
Loop
End With
End If
If H = "N" Then
Set oRng = wd.ActiveDocument.Range
With oRng.Find
.Text = "<<HDACopy5>>"
.Wrap = wdFindStop
found = .Execute
Do While found
Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
para.Range.Delete
Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
para.Range.Delete
oRng.Collapse wdCollapseEnd
oRng.End = wd.ActiveDocument.Content.End
found = oRng.Find.Execute
Loop
End With
End If
If V = "N" Then
Set oRng = wd.ActiveDocument.Range
With oRng.Find
.Text = "<<VisaCopy>>"
.Wrap = wdFindStop
found = .Execute
Do While found
Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
para.Range.Delete
Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
para.Range.Delete
oRng.Collapse wdCollapseEnd
oRng.End = wd.ActiveDocument.Content.End
found = oRng.Find.Execute
Loop
End With
End If
If P = "N" Then
Set oRng = wd.ActiveDocument.Range
With oRng.Find
.Text = "<<PTCopy>>"
.Wrap = wdFindStop
found = .Execute
Do While found
Set para = oRng.Next(wdParagraph, 1).Paragraphs(1)
para.Range.Delete
Set para = oRng.Next(wdParagraph, -1).Paragraphs(1)
para.Range.Delete
oRng.Collapse wdCollapseEnd
oRng.End = wd.ActiveDocument.Content.End
found = oRng.Find.Execute
Loop
End With
End If
With wd.Selection.Find
.Text = "<<CandidateName>>"
.Replacement.Text = Cells(i, 1).Value
.Execute Replace:=wdReplaceAll
.Text = "<<Date>>"
.Replacement.Text = Cells(i, 39).Value
.Execute Replace:=wdReplaceAll
.Text = "<<Address1>>"
.Replacement.Text = Cells(i, 3).Value
.Execute Replace:=wdReplaceAll
.Text = "<<Address2>>"
.Replacement.Text = Cells(i, 4).Value
.Execute Replace:=wdReplaceAll
.Text = "<<Address3>>"
.Replacement.Text = Cells(i, 5).Value
.Execute Replace:=wdReplaceAll
.Text = "<<EmployeeFirstName>>"
.Replacement.Text = Cells(i, 6).Value
.Execute Replace:=wdReplaceAll
.Text = "<<PositionTitle>>"
.Replacement.Text = Cells(i, 7).Value
.Execute Replace:=wdReplaceAll
.Text = "<<Salary>>"
.Replacement.Text = Cells(i, 8).Value
.Execute Replace:=wdReplaceAll
.Text = "<<StartDate>>"
.Replacement.Text = Cells(i, 43).Value
.Execute Replace:=wdReplaceAll
.Text = "<<GCBChange>>"
.Replacement.Text = Cells(i, 11).Value
.Execute Replace:=wdReplaceAll
.Text = "<<HoursChange>>"
.Replacement.Text = Cells(i, 14).Value
.Execute Replace:=wdReplaceAll
.Text = "<<ManagerName>>"
.Replacement.Text = Cells(i, 17).Value
.Execute Replace:=wdReplaceAll
.Text = "<<ManagerTitle>>"
.Replacement.Text = Cells(i, 18).Value
.Execute Replace:=wdReplaceAll
.Text = "<<CostCentre>>"
.Replacement.Text = Cells(i, 19).Value
.Execute Replace:=wdReplaceAll
.Text = "<<HDACopy1>>"
.Replacement.Text = Cells(i, 24).Value
.Execute Replace:=wdReplaceAll
.Text = "<<HDACopy2>>"
.Replacement.Text = Cells(i, 25).Value
.Execute Replace:=wdReplaceAll
.Text = "<<HDACopy3>>"
.Replacement.Text = Cells(i, 26).Value
.Execute Replace:=wdReplaceAll
.Text = "<<HDACopy4>>"
.Replacement.Text = Cells(i, 27).Value
.Execute Replace:=wdReplaceAll
.Text = "<<HDACopy5>>"
.Replacement.Text = Cells(i, 28).Value
.Execute Replace:=wdReplaceAll
.Text = "<<VisaCopy>>"
.Replacement.Text = Cells(i, 32).Value
.Execute Replace:=wdReplaceAll
.Text = "<<PTCopy>>"
.Replacement.Text = Cells(i, 34).Value
.Execute Replace:=wdReplaceAll
.Text = "<<EndDate>>"
.Replacement.Text = Cells(i, 47).Value
.Execute Replace:=wdReplaceAll
End With
ActiveDocument.SaveAs Filename:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".doc"
doc.ExportAsFixedFormat OutputFileName:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".pdf", _
ExportFormat:=wdExportFormatPDF
Application.DisplayAlerts = False
doc.Close SaveChanges:=False
Application.DisplayAlerts = True
Next
wd.Quit
End Sub
我想与 PDF 一起创建一个新的 word docx。
我最终确实解决了这个问题 - 这就是让它发挥作用的原因 -
wd.ActiveDocument.SaveAs2 Filename:=ActiveWorkbook.Path & "/" & Cells(i, 1).Value & " " & Cells(i, 35).Value & " " & Cells(i, 39).Value & ".docx"