用于填充书签并保存少量 PDF 文件的宏

Question

我目前正忙于开发宏以将数据从 Excel 工作表传输到带有书签的 Word 模板。 目前，宏的主要部分正在工作，数据已很好地传输到模板，但我有几个问题从昨天开始无法修复，此后我尝试了很多。 1/ 当我想将文档保存为 PDF 时，我的宏会在关闭 docx 后将信息粘贴在模板中，因此，下一个 pdf 文件将有两行而不是一行的信息。我尝试使用导出功能，但结果相同。您知道如何更改我的代码以在注册为 pdf 文件后让模板为空吗？

2/ 为了命名 PDF 文件，我定义了不同的变量，但它似乎不起作用，实际上，似乎名称是用 N-1 个单元格的信息而不是 N 个单元格的信息定义的，任何解决它的想法？另外，我不知道如何将 YEAR 信息放在文件名中（我有一个兼容性错误，我认为是因为数据格式）

3/ 最后，我想设置一个 IF & Then 只考虑与当年有关的行，我没有找到如何使它有效地工作，你能给我一些建议吗？

你可以在这里找到我的 VBA 代码：

' Macro1 Macro
'
Option Explicit

'Filepath to the data and template
Const FilePath As String = "C:\Users\\OneDrive\Desktop\fiches\Templates\" & "Template macro.docx"""
Dim wd As New Word.Application
Dim NomCell As Range

Sub CreateWordDocuments()
'Defini a counter
Dim i As Integer
Dim prenom As String
Dim nom As String
Dim interviewyear As Date
i = 0
'create copy of Word in memory
Dim doc As Word.Document
wd.Visible = True
Dim NomRange As Range

'create a reference to all the people
Range("A2").Select
Set NomRange = Range(ActiveCell, ActiveCell.End(xlDown))
'for each person in list
For Each NomCell In NomRange

'open a document in Word

Set doc = wd.Documents.Open("C:\Users\\OneDrive\Desktop\fiches\Templates\" & "Template macro.docx")

'go to each bookmark and type in details
'If Year(Cells(NomCell, 14)) >= Year(Date) Then

CopyCell "Age", 4
CopyCell "Ancienneté", 6
CopyCell "Projet", 9
CopyCell "Grade", 10
CopyCell "Rôle", 11
CopyCell "Date_de_départ_prévue", 12
CopyCell "Carrière_manager", 13
CopyCell "Motif_départ", 16
CopyCell "Motif_départ_2", 17
CopyCell "Points_positifs_expérience", 18
CopyCell "Point_négatifs_expérience", 19
CopyCell "Situation_future_entreprise_ou_autre", 20
CopyCell "Commentaire_RRH", 21
CopyCell "Prénom", 2
CopyCell "Site", 7
CopyCell "Service_line", 8
CopyCell "Nom", 1
CopyCell "Date_entretien_de_départ", 15
CopyCell "RRH_entretien", 16


prenom = Cells(NomCell, 2).Value
nom = Cells(NomCell, 3).Value
'interviewyear = Cells(NomCell, 15).Date


'save and close this document
doc.SaveAs2 FilePath & nom & " " & prenom & interviewyear & ".pdf", wdExportFormatPDF
doc.Close
i = i + 1

Next NomCell
wd.Quit

MsgBox "The work is done, " & i & "  files had been created in " & FilePath & "!"

'End If
End Sub


Sub CopyCell(BookMarkNom As String, ColumnOffset As Integer)

'copy each cell to relevant Word bookmark
wd.Selection.Goto What:=wdGoToBookmark, Name:=BookMarkNom
wd.Selection.TypeText NomCell.Offset(0, ColumnOffset).Value

   
End Sub

Answer 1

未经测试，但您可以尝试类似的方法。依赖 ActiveCell/Selection 等不是很健壮，所以最好避免使用这种方法。

'Filepath to the data and template
Const FilesPath As String = "C:\Users\username\OneDrive\Desktop\fiches\"
Const TemplatesPath As String = FilesPath & "Templates\"
Const TemplateFile As String = "Template macro.docx"

Sub CreateWordDocuments()
    Dim i As Long
    Dim prenom As String
    Dim nom As String
    Dim interviewyear
    Dim wd As Word.Application
    Dim doc As Word.Document
    Dim NomRange As Range, NomCell As Range, ws As Worksheet

    i = 0

    Set ws = ActiveSheet 'for example
    Set NomRange = ws.Range("A2", ws.Cells(Rows.Count, 1).End(xlUp))
    
    Set wd = New Word.Application 'open Word
    wd.Visible = True

    For Each NomCell In NomRange.Cells
        
        Set doc = wd.Documents.Open(TemplatesPath & TemplateFile)
        With NomCell.EntireRow
            interviewyear = Year(.Cells(15).Value) 'year from date
            If interviewyear = Year(Date) Then 'from this year?
                'this is easier than calling a separate sub I think...
                doc.Bookmarks("Age").Range.Text = .Cells(5).Value 'or .Columns("E").Value
                doc.Bookmarks("Ancienneté").Range.Text = .Cells(7).Value
                doc.Bookmarks("Projet").Range.Text = .Cells(10).Value
                doc.Bookmarks("Grade").Range.Text = .Cells(11).Value
                'etc etc
                
                prenom = .Cells(2).Value
                nom = .Cells(3).Value
                doc.SaveAs2 FilesPath & nom & " " & prenom & interviewyear & ".pdf", wdExportFormatPDF
                doc.Close False
                i = i + 1
            End If 'current year
        End With
    Next NomCell
    wd.Quit
    MsgBox "The work is done, " & i & "  files had been created in " & FilesPath & "!"
End Sub