求助：基于R脚本生成指定格式Word参会人员卡片

我尝试用R脚本生成Word文档，为64位参会人员制作符合指定样式的卡片，需求如下：

• 卡片规格：宽2cm、高8cm
• 卡片内容从上至下依次为：黑色加粗日期、蓝色粗分隔线、红色加粗院校名称、黑色加粗姓名、Logo、蓝色加粗职位
• Word文档中每行放置3-4张卡片

当前脚本未实现预期布局，原脚本、参考样式图及Logo图如下：

原R脚本 #

# Sample Test_cards dataset (should contain 64 rows in your actual data)
Test_cards <- tibble::tibble(
  ID = 1:64,
  Name = paste0("Name_", 1:64),
  Role = rep(c("Radiation Officer", "Radiologist", "Senior Manager", "Senior Technologist", "Technologist"), length.out = 64),
  Date = rep("Q3-2024", 64),
  School = rep("World’s College Hospital Here (Radiology)", 64),
  Logo = NA  # Assuming the same logo for simplicity
)
# Load necessary libraries
library(readxl)
library(officer)   # For creating Word documents
library(flextable) # For advanced table layout and styling
library(magick)    # For image handling
library(tibble)    # For tibble data structure


# Path to logo image (ensure the correct path)
logo_path <- "logo.png"

# Define the custom styling with fp_text() for school name (red) and other fields
school_fp <- fp_text(color = "red", bold = TRUE)
date_fp <- fp_text(color = "black", bold = TRUE)
name_fp <- fp_text(color = "black", bold = TRUE)
role_fp <- fp_text(color = "blue", bold = TRUE)

# Function to create a box for each entry with correct colors and formatting
create_box <- function(date, school, name, role, logo_path) {
  # Create a flextable for the card content
  box_table <- flextable(data.frame(Card = rep(NA, 5))) %>%
    
    # Date (first row) in black, bold, centered
    compose(i = 1, j = 1, value = as_paragraph(as_chunk(date, props = date_fp))) %>%
    
    # Add thicker blue horizontal line after the date
    hline(i = 1, j = 1, border = fp_border(color = "blue", width = 3)) %>%
    
    # School (second row) in red, bold, centered
    compose(i = 2, j = 1, value = as_paragraph(as_chunk(school, props = school_fp))) %>%
    
    # Name (third row) in black, bold, centered
    compose(i = 3, j = 1, value = as_paragraph(as_chunk(name, props = name_fp))) %>%
    
    # Insert the logo in the fourth row
    compose(i = 4, j = 1, value = as_paragraph(as_image(src = logo_path, width = 1.3, height = 1.5))) %>%
    
    # Role (fifth row) in blue, bold, centered
    compose(i = 5, j = 1, value = as_paragraph(as_chunk(role, props = role_fp))) %>%
    
    # Align all content to the center
    align(align = "center", part = "all")
  
  # Set the column width to 2.5 cm and adjust row heights for a total height of 5 cm
  box_table <- width(box_table, j = 1, width = 2.5)  # Set the width to 2.5 cm
  box_table <- height_all(box_table, height = 1)  # Adjust each row's height
  
  # Add black borders around the table (box)
  box_table <- border_outer(box_table, border = fp_border(color = "black", width = 2))
  
  return(box_table)
}

# Create a new Word document
doc <- read_docx()

# Loop over each row in Test_cards and generate a card for each entry
for (i in seq_len(nrow(Test_cards))) {
  # Extract the data for the current row
  date <- Test_cards$Date[i]
  school <- Test_cards$School[i]
  name <- Test_cards$Name[i]
  role <- Test_cards$Role[i]
  
  # Create the card (box) for this row
  box <- create_box(date, school, name, role, logo_path)
  
  # Add the box to the document
  doc <- body_add_flextable(doc, value = box)
  
  # Add a page break after each card except the last one
  if (i < nrow(Test_cards)) {
    doc <- body_add_break(doc)
  }
}

# Save the document
print(doc, target = "Test_cards_output.docx")

参考样式图 #

Logo图 #

以下是实现需求的修正版脚本，关键调整包括卡片尺寸适配、多行排列布局、样式细节优化：

# 加载所需库
library(officer)
library(flextable)
library(tibble)

# 示例数据（实际为64行）
Test_cards <- tibble::tibble(
  ID = 1:64,
  Name = paste0("Name_", 1:64),
  Role = rep(c("Radiation Officer", "Radiologist", "Senior Manager", "Senior Technologist", "Technologist"), length.out = 64),
  Date = rep("Q3-2024", 64),
  School = rep("World’s College Hospital Here (Radiology)", 64)
)

# Logo路径（请替换为实际路径）
logo_path <- "logo.png"

# 定义文本样式
date_fp <- fp_text(color = "black", bold = TRUE, font.size = 10)
school_fp <- fp_text(color = "red", bold = TRUE, font.size = 10)
name_fp <- fp_text(color = "black", bold = TRUE, font.size = 12)
role_fp <- fp_text(color = "blue", bold = TRUE, font.size = 10)

# 创建单张卡片的函数
create_single_card <- function(date, school, name, role, logo_path) {
  # 构建卡片内容的表格（6行对应6个元素）
  card_content <- data.frame(
    content = c(date, "", school, name, "", role),
    row_height = c(0.8, 0.2, 1, 1.2, 3.5, 1.3)  # 行高总和8cm，适配卡片高度
  )
  
  card <- flextable(card_content) %>%
    # 隐藏表头
    delete_part(part = "header") %>%
    # 设置列宽为2cm
    width(j = 1, width = 2) %>%
    # 设置各行高度
    height(i = 1:6, height = card_content$row_height) %>%
    # 日期行样式
    compose(i = 1, j = 1, value = as_paragraph(as_chunk(content, props = date_fp))) %>%
    # 蓝色粗分隔线（第二行）
    hline(i = 1, j = 1, border = fp_border(color = "blue", width = 2)) %>%
    # 院校名称行样式
    compose(i = 3, j = 1, value = as_paragraph(as_chunk(content, props = school_fp))) %>%
    # 姓名行样式
    compose(i = 4, j = 1, value = as_paragraph(as_chunk(content, props = name_fp))) %>%
    # Logo行（第五行）
    compose(i = 5, j = 1, value = as_paragraph(as_image(src = logo_path, width = 1.8, height = 3))) %>%
    # 职位行样式
    compose(i = 6, j = 1, value = as_paragraph(as_chunk(content, props = role_fp))) %>%
    # 所有内容居中对齐
    align(align = "center", part = "body") %>%
    # 添加卡片外边框
    border_outer(border = fp_border(color = "black", width = 1)) %>%
    # 去除内部边框
    border_inner(border = fp_border(width = 0))
  
  return(card)
}

# 将卡片按每行4张分组
cards_per_row <- 4
card_groups <- split(Test_cards, ceiling(seq_len(nrow(Test_cards))/cards_per_row))

# 创建Word文档
doc <- read_docx()

# 遍历每组，生成一行卡片
for (group in card_groups) {
  # 创建当前行的空表格（1行，列数=每行卡片数）
  row_table <- flextable(data.frame(matrix(ncol = cards_per_row, nrow = 1))) %>%
    delete_part(part = "header") %>%
    width(j = 1:cards_per_row, width = 2) %>%
    height(i = 1, height = 8)
  
  # 为每列插入卡片
  for (col in 1:nrow(group)) {
    card <- create_single_card(
      date = group$Date[col],
      school = group$School[col],
      name = group$Name[col],
      role = group$Role[col],
      logo_path = logo_path
    )
    row_table <- compose(row_table, i = 1, j = col, value = as_paragraph(as_flextable(card)))
  }
  
  # 添加当前行到文档
  doc <- body_add_flextable(doc, row_table)
  # 添加换行（可选，控制行间距）
  doc <- body_add_par(doc, value = "", style = "Normal")
}

# 保存文档
print(doc, target = "参会卡片_输出.docx")

关键修改说明 #

• 卡片尺寸精准控制：设置卡片宽2cm、高8cm，通过分配各行高度实现内容区域的合理布局
• 多行排列布局：将卡片按每行4张分组，用表格嵌套实现同行排列，避免每页仅一张卡片
• 样式细节优化：调整分隔线宽度、文本字号，适配参考样式；优化Logo尺寸，填充卡片中间区域
• 批量处理效率：通过分组循环生成整行卡片，减少文档操作次数，提升生成效率

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