使用openxlsx2防止Excel单元格宽度超出打印页面范围

问题背景 #

使用openxlsx2包批量构建带样式的Excel工作簿时，遇到表格超出打印区域的问题。已配置自动列宽、文本换行样式，通过循环批量写入数据和应用样式，但仍无法阻止表格超出打印区域；将工作簿打印为PDF并设置单页适配时，内容被过度缩放，可读性极差。需要无需手动调整列宽的自动化方案，适配大量表格的批量处理场景。

解决方案关键改动 #

• 开启列标题文本换行：将列标题样式的wrapText设为TRUE，让超长列标题自动换行，减少单列宽度占用
• 优化打印页面配置：明确设置纸张尺寸，同时配置fitToWidth=1（强制适配单页宽度）、fitToHeight=0（高度不限制），避免过度缩放
• 限制最大列宽：在自动列宽基础上设置最大宽度阈值，防止个别极长内容导致列宽失控
• 调整样式应用逻辑：确保换行设置不会被后续样式覆盖

修改后的完整代码 #

# 加载包
library(tidyverse)
library(openxlsx)
library(openxlsx2)

# 初始化输出列表与工作簿
output <- list()
workbook <- createWorkbook()

# 测试数据
test1 <- structure(list(
  Ranking = c("Strongly Agree", "Agree", "Neutral", "Disagree", "Strongly Disagree"),
  Percentage.of.Cities.That.Believe.Firehouses.Should.Have.Fire.Dogs = c("20%", "10%", "10%", "10%", "50%"),
  Percentage.of.Cities.That.Believe.The.Sky.Is.Purple.and.The.Clouds.Are.Green = c("20%", "10%", "10%", "10%", "50%"),
  Percentage.of.Cities.That.Believe.That.Rocky.Road.Ice.Cream.Is.Superior = c("20%", "10%", "10%", "10%", "50%")
), class = "data.frame", row.names = c(NA, -5L)) -> output[["test1"]]

test2 <- structure(list(
  ID = c("1", "2", "3", "4", "5"),
  Female = c("Female", "Female", "Female", "Female", "Female"),
  Male = c(NA, "Male", "Male", "Male", "Male"),
  Non_Binary = c("Non-Binary", "Non-Binary", "Non-Binary", NA, NA)
), class = "data.frame", row.names = c(NA, -5L)) -> output[["test2"]]

test3 <- structure(list(
  fruit = c("Apples", "Pears", "Bananas"),
  John = c(1, 13, 34),
  Jacob = c(5, 9, 2),
  Total = c(6, 22, 36)
), class = c("grouped_df", "tbl_df", "tbl", "data.frame"), row.names = c(NA, -3L),
groups = structure(list(
  fruit = c("Apples", "Bananas", "Pears"),
  .rows = structure(list(1L, 3L, 2L), ptype = integer(0), class = c("vctrs_list_of", "vctrs_vctr", "list"))
), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -3L), .drop = TRUE)) -> output[["test3"]]

# 表格样式定义
cellStyle <- createStyle(
  wrapText = TRUE,
  halign = "center",
  valign = "center",
  border = c("Bottom"),
  borderColour = getOption("openxlsx.borderColour", "#BFBFBF"),
  borderStyle = getOption("openxlsx.borderStyle", "thin")
)

rowlabelStyle <- createStyle(
  wrapText = TRUE,
  border = c("Bottom"),
  borderColour = getOption("openxlsx.borderColour", "#BFBFBF"),
  borderStyle = getOption("openxlsx.borderStyle", "thin"),
  halign = "left",
  valign = "center",
  textDecoration = "bold"
)

# 修改列标题样式：开启文本换行
columnlabelStyle <- createStyle(
  wrapText = TRUE,  # 关键改动：从FALSE改为TRUE
  border = c("Top", "Bottom"),
  borderColour = getOption("openxlsx.borderColour", "#000000"),
  borderStyle = getOption("openxlsx.borderStyle", "thin"),
  halign = "center",
  valign = "center",
  textDecoration = "bold"
)

# 批量处理工作表
for (sheetName in names(output)) {
  dataframe <- output[[sheetName]]
  addWorksheet(workbook, sheetName)
  
  # 写入数据
  writeData(workbook, sheetName, dataframe, 
            startCol = 1, startRow = 1, 
            colNames = TRUE, rowNames = FALSE, keepNA = TRUE)
  
  # 计算自动列宽并限制最大值（这里设置最大宽度为20）
  auto_widths <- getColWidths(workbook, sheetName, cols = 1:ncol(dataframe), unit = "width")
  limited_widths <- pmin(auto_widths, 20)
  setColWidths(workbook, sheetName, cols = 1:ncol(dataframe), widths = limited_widths)
  
  # 优化打印页面设置
  pageSetup(workbook, sheetName, 
            orientation = "landscape",
            paperSize = "A4",  # 指定纸张尺寸
            fitToWidth = 1,    # 强制适配单页宽度
            fitToHeight = 0)   # 高度不限制，允许跨页
  
  # 应用样式
  addStyle(workbook, sheet = sheetName, columnlabelStyle, 
           rows = 1, cols = 1:ncol(dataframe), gridExpand = TRUE)
  addStyle(workbook, sheet = sheetName, cellStyle, 
           rows = 2:(nrow(dataframe)+1), cols = 1:ncol(dataframe), gridExpand = TRUE)
  addStyle(workbook, sheet = sheetName, rowlabelStyle, 
           rows = 2:(nrow(dataframe)+1), cols = 1, gridExpand = TRUE)
}

# 清理临时变量
rm(sheetName, dataframe)

# 保存工作簿
saveWorkbook(workbook, "test_adapted.xlsx", overwrite = TRUE)

效果说明 #

修改后，超长列标题会自动换行，列宽被限制在合理范围内，打印设置强制内容适配单页宽度且不会过度缩放；批量处理时无需手动干预，所有表格都会自动适配打印区域，生成的PDF可读性显著提升。

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