I'm building and styling a workbook using the openxlsx2 package, and I'm struggling with getting my column widths to not exceed the length of the printable area in the final excel workbook. I specified different styles for different elements of the worksheet, including auto widths for columns and wrapped text, and then set up a for loop to write worksheets and apply the styles to all the dataframes I built earlier in my code. However, the text wrapping and auto column functions aren't preventing a table from running over the printable area. The result is that when I print my Excel workbook to a PDF and specify that the worksheet should fit on one page, the result is too small to read.
I can manually adjust the column widths, but I would prefer a reproducible solution so I don't have to adjust the columns every time I run the R script. Likewise, I could specify a width for every table, but in my real script, I have a large amount of tables, so I wanted to use the for loop to automate the task. The desired output is that tables that would exceed the printable area would automatically wrap the text.
Here's my code (minimal reproducible example):
# Code
## Packages
library(tidyverse)
library(openxlsx)
library(openxlsx2)
## Report Output
output<-list() #opens an empty list
workbook<-createWorkbook() #opens an active workbook for binding
## Test Data
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"]]
## Table Aesthetics
cellStyle <- createStyle(wrapText = TRUE,
halign = "center",
valign = "center",
border= c("Bottom"),
borderColour = getOption("openxlsx.borderColour", "#BFBFBF"),
borderStyle = getOption("openxlsx.borderStyle", "thin")) #creates a custom cell style
rowlabelStyle<-createStyle(wrapText = TRUE,
border= c("Bottom"),
borderColour = getOption("openxlsx.borderColour", "#BFBFBF"),
borderStyle = getOption("openxlsx.borderStyle", "thin"),
halign = "left",
valign = "center",
textDecoration = "bold") #creates a custom row label style
columnlabelStyle<-createStyle(wrapText = FALSE,
border= c("Top", "Bottom"),
borderColour = getOption("openxlsx.borderColour", "#000000"),
borderStyle = getOption("openxlsx.borderStyle", "thin"),
halign = "center",
valign = "center",
textDecoration = "bold") #creates a custom column label style
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)
setColWidths(workbook,
sheetName,
cols = 1:ncol(dataframe),
widths="auto")
pageSetup(workbook,
sheetName,
orientation = "landscape",
scale = 100,
fitToWidth = TRUE)
addStyle(workbook,
sheet = sheetName,
columnlabelStyle,
rows = 1,
cols = 1:ncol(dataframe),
gridExpand = T)
addStyle(workbook,
sheet = sheetName,
cellStyle,
rows = 1:nrow(dataframe) + 1,
cols = 1:ncol(dataframe),
gridExpand = T)
addStyle(workbook,
sheet = sheetName,
rowlabelStyle, rows = seq(nrow(dataframe)) + 1,
cols = 1,
gridExpand = T)
}
rm(sheetName,dataframe)
## Write to Excel
saveWorkbook(workbook,"test.xlsx", overwrite = TRUE) #saves the workbook to the destination folder
As stated, the code above is using only openxlsx, but since this is labeled openxlsx2, a proper answer could be the following. It is not possible to force the data into the correct column width using wb_set_col_width("auto"). Because this function is guessing the column width by the actual column in the data frame. Since the column header is a very long string, the column is sized to something similar of nchar(names(dat)). Each column width is very large and this wont be impacted by anything in your spreadsheet software. The standard simply does not allow for column widths that are evaluated when opening the file in spreadsheet software. It has to be predefined as a number.
Something that might come close, could be the following. I size all columns so that they fill the page. But if you want to have this more flexible as only filling the page if it is required, you'd have to calculate some column width when writing the file.
library(openxlsx2)
## tweaked the data: using constructive::construct(lapply(output, as.data.frame))
output <- list(
test1 = data.frame(
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)
),
test2 = data.frame(
ID = c(1, 2, 3, 4, 5),
Female = "Female",
Male = rep(c(NA, "Male"), c(1L, 4L)),
Non_Binary = rep(c("Non-Binary", NA), 3:2)
),
test3 = data.frame(
fruit = c("Apples", "Pears", "Bananas"),
John = c(1, 13, 34),
Jacob = c(5, 9, 2),
Total = c(6, 22, 36)
)
)
## create worksheet
wb <- openxlsx2::wb_workbook()
for (i in seq_along(output)) {
dat <- output[[i]]
dims_header <- wb_dims(x = dat, select = "col_names")
dims_rows <- wb_dims(x = dat, cols = 1)
dims_cell <- wb_dims(x = dat, cols = 2:ncol(dat))
wb$add_worksheet(names(output)[i], grid_lines = FALSE)
wb$add_data(x = dat)
wb$set_col_widths(widths = 30, cols = seq_along(dat)) # 30 looks well enough
wb$page_setup(orientation = "landscape", fit_to_width = TRUE)
# header
wb$add_cell_style(dims = dims_header, wrap_text = TRUE, horizontal = "center", vertical = "center")
wb$add_border(dims = dims_header, top_border = NULL, left_border = NULL, right_border = NULL, bottom_color = wb_color(hex = "#000000"))
wb$add_font(dims = dims_header, bold = TRUE)
# row names
wb$add_cell_style(dims = dims_rows, wrap_text = TRUE, horizontal = "left", vertical = "center")
wb$add_border(
dims = dims_rows,
top_border = NULL,
left_border = NULL,
right_border = NULL,
bottom_color = wb_color("#BFBFBF"),
inner_hgrid = "thin",
inner_hcolor = wb_color(hex = "#BFBFBF")
)
wb$add_font(dims = dims_rows, bold = TRUE)
# cells
wb$add_cell_style(dims = dims_cell, wrap_text = FALSE, horizontal = "center", vertical = "center")
wb$add_border(
dims = dims_cell,
top_color = wb_color(hex = "#BFBFBF"),
left_border = NULL,
right_border = NULL,
bottom_color = wb_color(hex = "#BFBFBF"),
inner_hgrid = "thin",
inner_hcolor = wb_color(hex = "#BFBFBF")
)
# use pct format
if (i == 1) wb$add_numfmt(dims = dims_cell, numfmt = 9)
}
if (interactive()) wb$open()