R/write_simple_xlsx.R

In epicentre-msf/llutils: Linelist Utilities

#' Write an xlsx file with simple options for formatting
#'
#' A wrapper to openxlsx with options for basic formatting, including a frozen
#' header pane, and optional alternating shading to distinguish groups of
#' observations.
#'
#' @param x a data frame
#' @param file path/filename ending with .xlsx (if `NULL` the resulting workbook
#'   is returned as an object rather than written to an xlsx file)
#' @param group (Optional) tidy-selection of grouping column(s) for applying
#'   alternating shading
#' @param group_fill (Optional) fill colour for alternating group shading
#'   (defaults to "#ffcccb")
#' @param date_format openxlsx format for date-columns (defaults to
#'   "yyyy-mm-dd")
#' @param first_active_row integer indicating first active row after the
#'   header (defaults to `2L`)
#' @param zoom integer specifying initial zoom percentage (defaults to `130`)
#' @param overwrite logical indicating whether to overwrite existing file
#'   (defaults to `TRUE`)
#'
#' @return
#' If `file = NULL` returns an openxlsx workbook object. Otherwise writes
#' workbook to file with no return.
#'
#' @examples
#' data(ll)
#'
#' \dontrun{
#' write_simple_xlsx(ll, "file_out.xlsx", group = site)
#' }
#'
#' @import openxlsx
#' @importFrom dplyr select
#' @importFrom rlang `!!` enquo
#' @export write_simple_xlsx
write_simple_xlsx <- function(x,
                              file = NULL,
                              group,
                              group_fill = "#ffcccb",
                              date_format = "yyyy-mm-dd",
                              first_active_row = 2L,
                              zoom = 130L,
                              overwrite = TRUE) {

  options("openxlsx.dateFormat" = date_format)
  wb <- openxlsx::createWorkbook()
  openxlsx::addWorksheet(wb, "Sheet 1", zoom = zoom)

  group_shade <- !missing(group)

  if (group_shade) {
    g <- dplyr::select(x, !!enquo(group))
    g <- apply(g, 1, paste, collapse = " ")
    g <- factor(g, levels = unique(g))
    i <- data.frame(i = as.integer(g[order(g)]) %% 2L)
    x <- x[order(g),]
    x <- cbind(i, x)
  }

  nrow_x <- nrow(x) + 1
  ncol_x <- ncol(x)

  openxlsx::writeData(wb, 1, x)
  openxlsx::setColWidths(wb, 1, cols = 1:ncol_x, widths = "auto")

  header <- openxlsx::createStyle(halign = "center", textDecoration = "bold")
  openxlsx::addStyle(wb, 1, style = header, rows = 1, cols = seq_len(ncol_x), gridExpand = TRUE)
  openxlsx::freezePane(wb, 1, firstActiveRow = first_active_row)

  if (group_shade) {
    openxlsx::conditionalFormatting(
      wb, 1,
      cols = 1:ncol_x,
      rows = 2:nrow_x,
      rule = paste0("$A2==0"),
      style = openxlsx::createStyle(bgFill = group_fill)
    )
  }

  if (!is.null(file)) {
    suppressMessages(
      openxlsx::saveWorkbook(wb, file = file, overwrite = overwrite)
    )
  } else {
    return(wb)
  }
}