#' Pass data to Excel workbooks
#'
#' \code{to_excel} allows you to pass R objects (primarily a \code{data.frame}) to
#' an open \code{Workbook}, and write it later with \code{write_data}. The workbook
#' can be created by calling \code{excel_workbook}, which is itself a wrapper for
#' \code{\link[openxlsx]{createWorkbook}}.
#'
#' @param df A \code{data.frame}, \code{table} or \code{matrix}.
#' @param wb A \code{Workbook}.
#' @param ... Arguments passed to \code{to_excel.data.frame} (See below).
#' @param title The title to give to the table. When \code{NULL} (the default),
#' \code{to_excel} will use the 'title' attribute of the object, or a single whitespace
#' if \code{attr(x, 'title')} returns \code{NULL} as well.
#' @param sheet The sheet you want to write the data to.
#' @param format Format values and apply the default template to the table output.
#' @param append Whether or not the function should append to or replace the
#' sheet before writing.
#' @param row Specify the startingrow when writing data to a new sheet.
#' @param col Start column. Same as for row.
#' @param template Optional: Specify a path if you would like to append data to
#' an existing .xlsx file. Default creates a new workbook.
#' @author Kristian D. Olsen
#' @note This function requires \pkg{openxlsx}.
#' @export
#' @examples
#' if (require(openxlsx)) {
#' wb <- excel_workbook()
#' df <- data.frame("String" = c("A", "B"), "Int" = c(1:2L), "Percent" = c(0.5, 0.75))
#'
#' # The workbook is mutable, so we don't have to assign result.
#' to_excel(df, wb, title = "Example data", sheet = "Example", append = FALSE)
#'
#' # Data is first argument, so we can use it with dplyr.
#' # df %>% to_excel(wb, title = "Example dplyr", sheet = "Example", append = TRUE)
#'
#' # Save the data
#' write_data(wb, "Example table.xlsx", overwrite = TRUE)
#' }
to_excel <- function(df, wb, title = NULL, ...) {
if (!inherits(wb, "Workbook")) {
stop ("'wb' should be a Workbook. See help(to_excel).")
} else if (!identical(attr(class(wb), "package"), "openxlsx")) {
stop("Unknown type of 'workbook'.")
}
UseMethod("to_excel")
}
#' @rdname to_excel
#' @export
excel_workbook <- function(template = NULL) {
if (is.null(template)) {
openxlsx::createWorkbook()
} else {
if (!is_string(template) || tools::file_ext(template) != "xlsx")
stop("Argument 'template' should be NULL or a path to a .xlsx file.")
openxlsx::loadWorkbook(clean_path(template))
}
}
#' @export
write_data.Workbook <- function(x, file, ...) {
if (!identical(attr(class(x), "package"), "openxlsx")) {
stop("Unknown type of 'workbook'.")
}
openxlsx::saveWorkbook(x, file, ...)
}
#' @rdname to_excel
#' @export
to_excel.data.frame <- function(df, wb, title = NULL, sheet = "tables", format = TRUE, append = TRUE, row = 1L, col = 1L, ...) {
# Check input
if (!is_string(sheet)) {
stop("The sheet has to be a string (character(1)).")
} else if (!is.null(title) && !is_string(title)) {
stop("Title has to be either NULL or a string.")
} else if (!is.integer(row) || !is.integer(col)) {
stop("'row' and 'col' must be an integer.")
}
# Map out which cells need to be written to and their type.
index <- list(
# Don't need to subract 1L from rows because of the header (colnames).
columns = c(start = col, end = ncol(df) + col - 1L),
rows = c(start = row, end = nrow(df) + row),
format = excel_formats(df)
)
# Get last row if sheet exists, or create if it does not.
if (sheet %in% openxlsx::sheets(wb)) {
if (append) {
row <- nrow(openxlsx::read.xlsx(wb, sheet = sheet, colNames = FALSE, skipEmptyRows = FALSE))
index$rows <- index$rows + row + 1L # Space between previous table.
} else {
openxlsx::removeWorksheet(wb, sheet)
openxlsx::addWorksheet(wb, sheetName = sheet)
}
} else {
openxlsx::addWorksheet(wb, sheetName = sheet)
}
# Return early if there are no colummnames in the data.
if (is.null(names(df)) || identical(names(df), character(0))) {
warning("No columnames in data. An empty sheet was created: ", paste0("'", sheet, "'"))
return()
}
if (format) {
# Write title on the first row
title <- title %||% attr(df, "title") %||% " "
openxlsx::writeData(wb, sheet, title, startRow = index$rows[1], startCol = index$columns[1])
index$rows[2] <- index$rows[2] + 1L # +1 for last row written to.
# Titlecase and write data
substr(names(df), 1L, 1L) <- toupper(substr(names(df), 1L, 1L))
openxlsx::writeData(wb, sheet, df, startRow = index$rows[1] + 1L, startCol = index$columns[1])
# Apply template and formatting
format_excel_table(wb, sheet, index)
format_excel_columns(wb, sheet, index)
} else {
openxlsx::writeData(wb, sheet, df, startRow = row)
}
invisible(index)
}
#' @export
to_excel.data.table <- function(df, wb, title = NULL, ...) {
warning("Coercing ", class(df), " to data.frame.")
title <- title %||% attr(df, "title")
to_excel(as.data.frame(df, stringsAsFactors = FALSE), wb, title, ...)
}
#' @export
to_excel.table <- to_excel.data.table
#' @export
to_excel.matrix <- to_excel.data.table
# Set column formats in excel --------------------------------------------------
format_excel_columns <- function(wb, sheet, cell) {
# Format all rows except title and header (always present when formatting).
# Columns derived from a character vector. Need to add first column from cell
# and subtract 1 to get correct index.
rows <- (cell$rows[1] + 2L):cell$rows[2]
if (any(cell$format == "numeric")) {
cols <- which(cell$format == "numeric") + cell$columns[1] - 1L
openxlsx::addStyle(wb, sheet, excel_numeric, rows = rows, cols = cols, gridExpand = TRUE, stack = TRUE)
}
if (any(cell$format == "integer")) {
cols <- which(cell$format == "integer") + cell$columns[1] - 1L
openxlsx::addStyle(wb, sheet, excel_integer, rows = rows, cols = cols, gridExpand = TRUE, stack = TRUE)
}
if (any(cell$format == "date")) {
cols <- which(cell$format == "date") + cell$columns[1] - 1L
openxlsx::addStyle(wb, sheet, excel_date, rows = rows, cols = cols, gridExpand = TRUE, stack = TRUE)
}
if (any(cell$format == "percent")) {
cols <- which(cell$format == "percent") + cell$columns[1] - 1L
openxlsx::addStyle(wb, sheet, excel_percent, rows = rows, cols = cols, gridExpand = TRUE, stack = TRUE)
}
if (any(cell$format %in% c("character", "factor"))) {
cols <- which(cell$format %in% c("character", "factor")) + cell$columns[1] - 1L
openxlsx::addStyle(wb, sheet, excel_character, rows = rows, cols = cols, gridExpand = TRUE, stack = TRUE)
}
}
excel_numeric <- openxlsx::createStyle(numFmt = "0.0")
excel_integer <- openxlsx::createStyle(numFmt = "0")
excel_date <- openxlsx::createStyle(numFmt = "yyyy-mm-dd")
excel_percent <- openxlsx::createStyle(numFmt = "0%")
excel_character <- openxlsx::createStyle(halign = "left")
# Simplified "class" for columns -----------------------------------------------
excel_formats <- function(df) {
type <- vapply(df, function(x) class(x)[1], character(1))
type[vapply(df, is.factor, logical(1))] <- "factor"
type[vapply(df, is_percent, logical(1))] <- "percent"
type[vapply(df, is_date, logical(1))] <- "date"
# Return character vector
type
}
# Apply excel themes -----------------------------------------------------------
format_excel_table <- function(wb, sheet, cell) {
# Style is applied to all columns.
cols <- cell$columns[1]:cell$columns[2]
body <- (cell$rows[1]:cell$rows[2]) + 1L
# Style the title and merge columns
rows <- cell$rows[1]
openxlsx::addStyle(wb, sheet, excel_title, rows = rows, cols = cols, gridExpand = TRUE)
openxlsx::mergeCells(wb, sheet, rows = rep(rows, length(cols)), cols = cols)
# Apply baseline style to the data
rows <- (cell$rows[1] + 1L):cell$rows[2]
openxlsx::addStyle(wb, sheet, excel_body, rows = rows, cols = cols, gridExpand = TRUE)
# Change styling for first (header)
rows <- cell$rows[1] + 1L
openxlsx::addStyle(wb, sheet, excel_header, rows = rows, cols = cols, gridExpand = TRUE)
# Leftmost header should have left-aligned text
openxlsx::addStyle(wb, sheet, excel_character, rows = rows, cols = cell$columns[1], gridExpand = TRUE, stack = TRUE)
# .. and last row
rows <- cell$rows[2]
openxlsx::addStyle(wb, sheet, excel_footer, rows = rows, cols = cols, gridExpand = TRUE)
}
excel_title <- openxlsx::createStyle(
fontName = "Trebuchet MS",
fontSize = 10,
fontColour = "#000000",
border = "Top",
borderColour = "#0094A5",
borderStyle = "medium",
fgFill = "#7DC6CC",
halign = "left",
valign = "center",
textDecoration = "Bold",
wrapText = TRUE
)
excel_body <- openxlsx::createStyle(
fontName = "Trebuchet MS",
fontSize = 8,
fontColour = "#000000",
border = "Bottom",
borderColour = "#BFBFBF",
borderStyle = "thin",
fgFill = "#FFFFFF",
halign = "center",
valign = "center"
)
excel_header <- openxlsx::createStyle(
fontName = "Trebuchet MS",
fontSize = 8,
fontColour = "#000000",
border = "Bottom",
borderColour = "#0094A5",
borderStyle = "thin",
fgFill = "#CCE9EB",
halign = "center",
valign = "center",
wrapText = TRUE
)
excel_footer <- openxlsx::createStyle(
fontName = "Trebuchet MS",
fontSize = 8,
fontColour = "#000000",
border = "Bottom",
borderColour = "#0094A5",
borderStyle = "medium",
fgFill = "#FFFFFF",
halign = "center",
valign = "center"
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.