R/wb_change_height_width.R

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

#' Changes the cell width
#'
#' @inheritParams wb_add_caption
#'
#' @return NULL
#'
wb_change_cell_width <- function(wb, sheet, ft, offset_cols) {

  # Tell me why?
  cwidths <- rbind(ft$header$colwidths,
                   ft$body$colwidths,
                   ft$footer$colwidths) |>
    apply(2,max) * 2.54 * 4 / 16 * 20 # Ain't nothing but a constant


  wb$set_col_widths(sheet = sheet,
                    cols = paste0(openxlsx2::int2col(1 + offset_cols), ":",
                                  openxlsx2::int2col(length(cwidths) + offset_cols)),
                    widths = cwidths)

  return(invisible(NULL))
}

#' Changes the row height
#'
#' @inheritParams wb_add_caption
#' @param df_style the styling tibble from [ft_to_style_tibble]
#'
#' @return NULL
#'
#' @importFrom dplyr select mutate group_by all_of summarize
#' @importFrom rlang .data
#' @importFrom stringi stri_count
#'
wb_change_row_height <- function(wb, sheet, df_style) {

  font_sizes <- vapply(df_style$content,
                       \(x) ifelse(all(is.na(x$font.size)),
                                   NA_real_,
                                   max(x$font.size, na.rm=T)),
                       FUN.VALUE = numeric(1))

  newline_counts <- vapply(df_style$content,
                           \(x) sum(stringi::stri_count(x$txt, regex = "<br */{0,1}>") +
                                      stringi::stri_count(x$txt, regex = "\n")),
                           FUN.VALUE = numeric(1)) + 1

  row_heights <- newline_counts*coalesce(font_sizes,df_style$font.size)/11*15

  df_row_heights <- df_style |>
    dplyr::select(dplyr::all_of("row_id")) |>
    dplyr::mutate(rh = row_heights) |>
    dplyr::group_by(.data$row_id) |>
    dplyr::summarize(row_heights = max(.data$rh),
                     .groups = "drop")

  wb$set_row_heights(sheet = sheet,
                     rows = df_row_heights$row_id,
                     heights = df_row_heights$row_heights)
}