R/wb_add_caption.R

In flexlsx: Exporting 'flextable' to 'xlsx' Files

#' Adds a caption to an excel file
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' @inheritParams wb_add_flextable
#' @param offset_rows zero-based row offset
#' @param offset_cols zero-based column offset
#'
#' @importFrom openxlsx2 fmt_txt
#' @importFrom purrr map_chr
#' @importFrom stringi stri_count
#'
#' @return NULL
#'
wb_add_caption <- function(wb, sheet,
                           ft,
                           offset_rows = offset_rows,
                           offset_cols = offset_cols) {
  idims <- dim(ft$body$content$data)

  # Default values from header
  df_styles_default <- lapply(
    ft$header$styles$text,
    \(x) {
      if ("default" %in% names(x)) {
        return(as.vector(x$data))
      }
      return(NULL)
    }
  ) |>
    data.frame()
  df_styles_default <- df_styles_default[1, ]

  # create content
  if (ft$caption$simple_caption) {
    # Replace <br> in flextables with newlines
    ft$caption$value <- gsub("<br *\\/{0,1}>", "\n", ft$caption$value)

    content <- openxlsx2::fmt_txt(
      ft$caption$value,
      bold = df_styles_default$bold,
      italic = df_styles_default$italic,
      underline = df_styles_default$underlined,
      size = df_styles_default$font.size,
      color = openxlsx2::wb_color(df_styles_default$color),
      font = df_styles_default$font.family,
      vert_align = df_styles_default$vertical.align
    )
  } else {
    ft$caption$value$txt <- gsub("<br *\\/{0,1}>", "\n", ft$caption$value$txt)
    content <- purrr::map_chr(
      seq_len(nrow(ft$caption$value)),
      \(i) {
        x <- ft$caption$value[i, ]
        openxlsx2::fmt_txt(
          x$txt,
          bold = x$bold,
          italic = x$italic,
          underline = x$underlined,
          size = x$font.size,
          color = openxlsx2::wb_color(x$color),
          font = x$font.family,
          vert_align = x$vertical.align
        ) |>
          paste0()
      }
    )
  }

  # wrap text if necessary
  to_apply_text_wrap <- ifelse(ft$caption$simple_caption,
    stringi::stri_count(ft$caption$value, regex = "\\n"),
    sum(stringi::stri_count(ft$caption$value$txt, regex = "\\n"))
  ) + 1
  if (to_apply_text_wrap > 0) {
    wb$add_cell_style(
      sheet = sheet,
      wrap_text = TRUE,
      dims = paste0(
        int2col(offset_cols + 1),
        offset_rows + 1
      )
    )

    wb$set_row_heights(
      sheet = sheet,
      heights = to_apply_text_wrap * 15,
      rows = offset_rows + 1
    )
  }

  # add to wb & merge
  wb$add_data(
    sheet = sheet,
    x = paste0(content, collapse = ""),
    dims = paste0(
      int2col(offset_cols + 1),
      offset_rows + 1
    )
  )
  wb$merge_cells(sheet = sheet, dims = paste0(
    int2col(offset_cols + 1),
    offset_rows + 1,
    ":",
    int2col(offset_cols + idims[2]),
    offset_rows + 1
  ))

  return(invisible(NULL))
}