Working with {openxlsx2}

Working_with_openxlsx2.R

#
# openxlsx2 implementation of 
#  https://layalchristinelettry.rbind.io/blog/202303_openxlsx/
#

#### helper function -----------------------------------------------------------
prepare_penguins_mod <- function(data,
                                 data_raw) {
  # for demonstration purposes, add a column "any_comment" and "size"
  data |>
    dplyr::mutate(
      size = character(length = nrow(data)),
      any_comment = character(length = nrow(data)),
      id = data_raw$`Individual ID`,
      date_modification = lubridate::today()
    ) |>
    # rearrange the columns to have 'year' as the first column
    # use quotes to select global variables
    dplyr::select("year", "id", tidyselect::everything())
}

#--- define your datasets ------------------------------------------------------
data_penguins <- palmerpenguins::penguins
data_penguins_raw <- palmerpenguins::penguins_raw

#--- modify data ---------------------------------------------------------------
data_penguins_mod <- prepare_penguins_mod(
  data = data_penguins,
  data_raw = data_penguins_raw
)

# define the arguments of the write_hyperlink()
dataset <- data_penguins_mod
metadata <- data_penguins_raw
excel_sheet <- "penguins"
first_row <- 2L
meta_ws_name <- "penguins_raw"

hyperlink_tib <- dataset |>
  dplyr::mutate(
    # find the metadata rows where id matches `Individual ID`
    list_indices_indicators_to_link = as.integer(purrr::map(
      id,
      ~ match(
        .x,
        metadata$`Individual ID`
      )
    )),
    # write the link to make the change of a cell value in penguins_raw reactive
    # in the other sheet
    cell = paste0(
      meta_ws_name, "!",
      # get the capital letter for the excel column corresponding to the column
      # index in the penguins_raw dataset
      LETTERS[which(colnames(metadata) == "Comments")],
      list_indices_indicators_to_link + first_row
    ),
    # add an IF condition to get an empty cell if the resp. Comments value in
    # penguins_raw is empty
    link_rewritten = paste0(
      "=IF(", cell, '="","",', cell, ")"
    )
  )

options <- c(
  "huge",
  "big",
  "normal",
  "small",
  "tiny"
)


### create workbook with openxlsx2 ---------------------------------------------

library(openxlsx2)

wb <- wb_workbook()

### sheet 0 --------------------------------------------------------------------

wb$add_worksheet("drop-down-values", visible = "hidden")
wb$add_data(x = options)


### sheet 1 --------------------------------------------------------------------

wb$add_worksheet("penguins")
wb$add_data(x = data_penguins_mod, start_row = first_row)
col_names <- wb_dims(x = data_penguins_mod, from_row = first_row,
                     select = "col_names")
wb$add_font(dims = col_names, size = 12, bold = TRUE)
wb$add_border(dims = col_names)
col_data <- wb_dims(x = data_penguins_mod, from_row = first_row,
                    select = "data")
wb$add_font(dims = col_data, size = 12)
wb$add_cell_style(dims = col_data, vertical = "top", horizontal = "left",
                  wrap_text = TRUE)
wb$add_fill(dims = col_data, color = wb_color("#f4cccc"))
wb$set_col_widths(cols = int2col(seq_along(data_penguins_raw)), widths = 22)
col_date <- wb_dims(x = data_penguins_mod, from_row = first_row,
                    cols = "date_modification")
wb$add_numfmt(dims = col_date, numfmt = "dd/mm/yyyy")


wb$protect_worksheet(properties = c(autoFilter = FALSE, formatCells = FALSE))

col_size <- wb_dims(x = data_penguins_mod, from_row = first_row, cols = "size")
wb$add_cell_style(dims = col_size, locked = FALSE)
wb$add_border(dims = col_size, inner_hgrid = "thin")
wb$add_fill(dims = col_size, color = wb_color("#d9d2e9"))

col_comment <- wb_dims(x = data_penguins_mod, from_row = first_row,
                       cols = "any_comment")
wb$add_cell_style(dims = col_comment, locked = FALSE)
wb$add_border(dims = col_comment, inner_hgrid = "thin")
wb$add_fill(dims = col_comment, color = wb_color("#d9d2e9"))

wb$add_formula(x = hyperlink_tib$link_rewritten, dims = col_comment)

wb$freeze_pane(first_active_row = first_row + 1L, first_active_col = first_row)


## data validation
dims <- wb_dims(x = data_penguins_mod, cols = "size", from_row = first_row)
wb$add_data_validation(
  dims = dims,
  operator = "equal",
  type = "list",
  value = "'drop-down-values'!$A$1:$A$5"
)

wb$add_dxfs_style(name = "cf_huge", bg_fill = wb_color("#AAAAAA"))
wb$add_dxfs_style(name = "cf_big", bg_fill = wb_color("#6FA8DC"))
wb$add_dxfs_style(name = "cf_normal", bg_fill = wb_color("#00AA00"))
wb$add_dxfs_style(name = "cf_small", bg_fill = wb_color("#CCCC00"))
wb$add_dxfs_style(name = "cf_tiny", bg_fill = wb_color("#CC0000"), 
                  font_color = wb_color("#EEEEEE"))

wb$add_conditional_formatting(
  dims = dims,
  type = "containsText",
  rule = "huge",
  style = "cf_huge"
)
wb$add_conditional_formatting(
  dims = dims,
  type = "containsText",
  rule = "big",
  style = "cf_big"
)
wb$add_conditional_formatting(
  dims = dims,
  type = "containsText",
  rule = "normal",
  style = "cf_normal"
)
wb$add_conditional_formatting(
  dims = dims,
  type = "containsText",
  rule = "small",
  style = "cf_small"
)
wb$add_conditional_formatting(
  dims = dims,
  type = "containsText",
  rule = "tiny",
  style = "cf_tiny"
)

# TODO will add filters to first four columns
wb$add_filter(
  rows = first_row,
  cols = c(
    which(names(data_penguins_mod) == "year"),
    which(names(data_penguins_mod) == "species"),
    which(names(data_penguins_mod) == "island")
  )
)


### sheet 2 --------------------------------------------------------------------

wb$add_worksheet("penguins_raw")
wb$add_data(x = data_penguins_raw, start_row = first_row, with_filter = TRUE)
col_names <- wb_dims(x = data_penguins_raw, from_row = first_row,
                     select = "col_names")
wb$add_font(dims = col_names, size = 12, bold = TRUE)
wb$add_border(dims = col_names)
col_data <- wb_dims(x = data_penguins_raw, from_row = first_row,
                    select = "data")
wb$add_font(dims = col_data, size = 12)
wb$add_cell_style(dims = col_data, vertical = "top", horizontal = "left",
                  wrap_text = TRUE)
wb$add_fill(dims = col_data, color = wb_color("#f4cccc"))
wb$set_col_widths(cols = int2col(seq_along(data_penguins_raw)), widths = 22)
wb$protect_worksheet(properties = c(autoFilter = FALSE, formatCells = FALSE))

col_comment <- wb_dims(x = data_penguins_raw, from_row = first_row, 
                       cols = "Comments")
wb$add_cell_style(dims = col_comment, locked = FALSE)
wb$add_border(dims = col_comment, inner_hgrid = "thin")
wb$add_fill(dims = col_comment, color = wb_color("#d9d2e9"))

wb$freeze_pane(first_active_row = first_row + 1L)

### fin ------------------------------------------------------------------------

wb$open()

@Layalchristine24 This is a openxlsx2 conversion inspired by your blog post.

@JanMarvin Thank you for the implementation of my code written with openxlsx but using openxlsx2. It is very helpful to see the equivalent code translated into openxlsx2.

Just FYI: There are two major differences moving code from openxlsx to openxlsx2.

1. We don't have a style object anymore in openxlsx2, instead everything needs to be applied directly into a cell region
2. We recommend using dims cell regions. There's a helper wb_dims()with a detailed man page, but it's basically some cell range in A1 notation.

I restructured the code a bit, but hopefully the output is similar to your code. Let me know if you have further questions, I stumbled over your code and took the chance to play around with it :)

@JanMarvin Great! Thank you! I will have a look at it and I will come back to you if something is not clear.

@JanMarvin As I moved from Hugo Apéro to Quarto, please find my blog post about openxlsx here.

Thanks for letting me know!