R实现：将数据框列表的表格批量插入多个Word文档

已完成批量生成公司专属Word信函的功能，现在需要给每个信函的第二页插入对应公司的费用汇总表格，已知需用到officer包的body_add_break和body_add_table函数，但不知如何适配现有代码，以下是解决方案：

现有代码回顾 #

示例数据框

DF <- data.frame(Company=c('Alpha','Alpha', 'Beta', 'Beta', 'Gamma'),
              Name= c('John Doe', 'John Doe','Jane Doe','Jane Doe', 'Jack Smith'),
              Address=c('123 Main St','123 Main St', '234 Maple St','234 Maple St', '456 30th St' ),
              Address_Line_2=c('Suite A','Suite A', '', '', 'Suite B'),
              City_State_Zip=c('Los Angeles, CA 12345', 'Los Angeles, CA 12345','New York City, NY 23456','New York City, NY 23456', 'Chicago, IL 3456'),
              Charge_Date = c('01-01-2023', '01-31-2023','02-01-2023',  '02-01-2023', '03-01-2023'),
              Total_Charge = c(100,150,100,200,300),
              SKU_Number = c('#1234','#2345', '#5678', '#4567', '#5678'))

拆分并生成带总计行的数据框列表

List <- DF  %>% 
  dplyr::select(Company,Charge_Date,SKU_Number,Total_Charge,)%>%
  base::split(., .$Company)%>%
  janitor::adorn_totals(.,"row")

批量生成Word信函的现有代码

DF2 <- DF  %>% 
.[!duplicated (.[c('Company')]), ] 

# 替换文本函数
replace_all_text <- function(DF2, replacement_list, doc_path = "C:\\Mock_Path\\Letter.docx") {
  document <- read_docx(doc_path)
  Reduce(
    function(doc, repl)
    body_replace_all_text(doc, repl["pattern"], DF2[[repl["repl"]]], ignore.case = TRUE),
    replacement_list,
    init = document
  )
}

# 定义替换规则
replacement_list <- list(
  c(pattern = "Today’s Date", repl = "date"),
  c(pattern = "Company Name", repl = "Company"),
  c(pattern = "First Name/Last Name", repl = "Name"),
  c(pattern = "Company Address", repl = "Address"),
  c(pattern = "Address Line 2", repl = "Address_Line_2"),
  c(pattern = "City, State Zip", repl = "City_State_Zip")
)

# 添加日期列
DF2$date <- format(Sys.Date(), "%B %d, %Y")
df_split <- split(DF2, seq_len(nrow(DF2)))

# 批量生成替换后的文档
replaced_docs_list <- lapply(df_split, function(DF2) replace_all_text(DF2, replacement_list)) %>%
  setNames(DF2$Company)

解决方案：整合表格插入逻辑 #

核心思路是根据公司名称匹配数据框列表中的表格，添加分页符后插入表格，以下两种方式均可实现：

方式1：在保存文档时直接插入表格

修改最后的文档保存逻辑，在输出前添加分页和表格：

# 保存文档并插入对应表格
purrr::iwalk(replaced_docs_list, function(doc, company) {
  # 获取当前公司的汇总表格
  company_table <- List[[company]]
  # 添加分页符（确保表格在第二页）并插入表格
  doc <- doc %>%
    body_add_break() %>%
    body_add_table(company_table, style = "Table Grid", align = "left")
  
  outfile <- paste0(company, ".docx")
  message("Saving doc: ", outfile)
  print(doc, target = outfile)
})

方式2：整合到文本替换函数中

修改replace_all_text函数，让它在完成文本替换后直接插入表格，逻辑更集中：

# 修改后的替换文本函数，新增表格插入逻辑
replace_all_text <- function(DF2, replacement_list, company_table, doc_path = "C:\\Mock_Path\\Letter.docx") {
  document <- read_docx(doc_path)
  
  # 执行文本替换
  document <- Reduce(
    function(doc, repl)
    body_replace_all_text(doc, repl["pattern"], DF2[[repl["repl"]]], ignore.case = TRUE),
    replacement_list,
    init = document
  )
  
  # 添加分页符和对应公司的表格
  document <- document %>%
    body_add_break() %>%
    body_add_table(company_table, style = "Table Grid")
  
  return(document)
}

# 重新生成带表格的文档列表
replaced_docs_list <- lapply(df_split, function(row) {
  # 获取当前行对应的公司表格
  company_table <- List[[row$Company]]
  # 调用修改后的函数
  replace_all_text(row, replacement_list, company_table)
}) %>%
  setNames(DF2$Company)

# 保存文档
purrr::iwalk(replaced_docs_list, function(doc, company) {
  outfile <- paste0(company, ".docx")
  message("Saving doc: ", outfile)
  print(doc, target = outfile)
})

关键说明 #

• body_add_break()：在文档末尾插入分页符，保证表格位于新页面（即第二页）
• body_add_table()：参数style可指定Word内置的表格样式（比如"Table Grid"是带网格线的样式），可根据需求调整
• 确保List中的公司名称与replaced_docs_list的命名完全一致，这样才能正确匹配到对应表格

内容的提问来源于stack exchange，提问作者CuRious Coder