Adding some formatting options

.gitignore

@@ -4,3 +4,4 @@
 *.so
 *.o
 *.a
+inst/doc

DESCRIPTION

@@ -1,10 +1,12 @@
 Package: writexl
 Type: Package
 Title: Export Data Frames to Excel 'xlsx' Format
-Version: 1.5.0
+Version: 1.5.1
 Authors@R: c(
     person("Jeroen", "Ooms", ,"[email protected]", role = c("aut", "cre"),
       comment = c(ORCID = "0000-0002-4035-0289")),
+    person("Richard Meitern", role = "ctb",
+      comment = c(ORCID = "0000-0002-2600-3002")),  
     person("John McNamara", role = "cph",
       comment = "Author of libxlsxwriter (see AUTHORS and COPYRIGHT files for details)"))
 Description: Zero-dependency data frame to xlsx exporter based on 'libxlsxwriter'
@@ -13,12 +15,16 @@ License: BSD_2_clause + file LICENSE
 Encoding: UTF-8
 URL: https://ropensci.r-universe.dev/writexl https://docs.ropensci.org/writexl/
 BugReports: https://github.com/ropensci/writexl/issues
-RoxygenNote: 7.0.2
+RoxygenNote: 7.2.1
 Suggests:
     spelling,
     readxl,
     nycflights13,
     testthat,
-    bit64
+    bit64,
+    knitr,
+    rmarkdown
 Language: en-US
+VignetteBuilder: knitr
 SystemRequirements: zlib
+

NEWS

@@ -1,3 +1,7 @@
+1.5.1
+  - added header formating suport for freezing panes, changing background color and autofiltering
+  - added option to change column widths manually or guess from row or header
+
 1.5.0
   - Update libxlsxwriter from b0c76b33
 

R/write_xlsx.R

@@ -18,16 +18,45 @@
 #' @param x data frame or named list of data frames that will be sheets in the xlsx
 #' @param path a file name to write to
 #' @param col_names write column names at the top of the file?
-#' @param format_headers make the \code{col_names} in the xlsx centered and bold
+#' @param format_headers make the \code{col_names} in the xlsx centred, bold
+#' and apply the header colour.
 #' @param use_zip64 use \href{https://en.wikipedia.org/wiki/Zip_(file_format)#ZIP64}{zip64}
 #' to enable support for 4GB+ xlsx files. Not all platforms can read this.
+#' @param freeze_rows number of rows to freeze at the top of the sheet
+#' (default: 0 i.e. no freeze)
+#' @param freeze_cols number of columns to freeze at the left of the sheet
+#' (default: 0 i.e. no freeze)
+#' @param autofilter add auto filter to columns (default: FALSE)
+#' @param header_bg_color background colour for header row cells (default: NA
+#'  meaning no color) other values could include any R colours like
+#'   "lightgray", "green", "lightblue" etc.
+#' @param col_widths A list of numeric vectors with column widths to use
+#'  (in inches). A length one vector is recycled. NA gives the default
+#'  behaviour. You can have the function guess the column width from the number
+#'  of characters in a row for this use one string value per data frame.
+#'  The possible string values include:
+#'   \itemize{
+#'     \item "guess_from_header": The widths are guessed from the character
+#'      count of the header.
+#'     \item "guess_from_row_2": The widths are guessed from the character
+#'      count of the 2nd row. You can use any row number here.
+#'   }
+#' @param guessed_column_width_padding numeric, inches to add to guessed
+#'   column widths (default:3)
 #' @examples # Roundtrip example with single excel sheet named 'mysheet'
 #' tmp <- write_xlsx(list(mysheet = iris))
 #' readxl::read_xlsx(tmp)
 write_xlsx <- function(x, path = tempfile(fileext = ".xlsx"), col_names = TRUE,
-                       format_headers = TRUE, use_zip64 = FALSE){
-  if(is.data.frame(x))
-    x <- list(x)
+                       format_headers = TRUE, use_zip64 = FALSE,
+                       freeze_rows = 1L,  freeze_cols = 0L,
+                       autofilter=TRUE, header_bg_color='lightgray',
+                       col_widths = "guess_from_header",
+                       guessed_column_width_padding = 3){
+
+  if(!is.list(col_widths)){col_widths <- list(col_widths)}
+
+  if(is.data.frame(x)){ x <- list(x)}
+
   if(!is.list(x) || !all(vapply(x, is.data.frame, logical(1))))
     stop("Argument x must be a data frame or list of data frames")
   x <- lapply(x, normalize_df)
@@ -40,9 +69,48 @@ write_xlsx <- function(x, path = tempfile(fileext = ".xlsx"), col_names = TRUE,
     warning("Deduplicating sheet names")
     names(x) <- make.unique(substring(names(x), 1, 28), sep = "_")
   }
+  if(!is.numeric(freeze_rows)){
+    stop("freeze_rows must be numeric! Got: ", freeze_rows)
+  }
+  freeze_rows <- as.integer(freeze_rows)
+
+  if(!is.numeric(freeze_cols)){
+    stop("freeze_cols must be numeric! Got: ", freeze_cols)
+  }
+  freeze_cols <- as.integer(freeze_cols)
+
+  hex_color <- function(color){
+    if(is.na(color)){return(-1L)}
+    rgb_values <- col2rgb(color)
+    hex_color <- rgb(rgb_values[1], rgb_values[2], rgb_values[3],
+                     maxColorValue = 255)
+    as.integer((paste0("0x", toupper(sub("#", "", hex_color)))))
+  }
+
+  if(!is.logical(autofilter)){stop("autofilter expects a logical value!")}
+
+  if(length(x) != length(col_widths)){
+    #Recycling col_widths
+    if(length(col_widths) == 1){
+      col_widths <- lapply(1:length(x),
+                           function(x, cw){col_widths[[1]]}, col_widths)
+    } else{
+      stop("The col_widths don't have the same number of width vectors as the ",
+           "input data frames")
+    }
+  }
+  #convert the column widths to numeric and guess if needed
+  col_widths <- lapply(1:length(x), guess_col_widths,
+                       cw=col_widths,
+                       dfs = x,
+                       extra_space = guessed_column_width_padding)
+
+
   stopifnot(is.character(path) && length(path))
   path <- normalizePath(path, mustWork = FALSE)
-  ret <- .Call(C_write_data_frame_list, x, path, col_names, format_headers, use_zip64)
+  ret <- .Call(C_write_data_frame_list, x, path, col_names, format_headers,
+               use_zip64, freeze_rows, freeze_cols, hex_color(header_bg_color),
+               autofilter, col_widths)
   invisible(ret)
 }
 
@@ -66,3 +134,27 @@ normalize_df <- function(df){
   }
   df
 }
+
+
+guess_col_widths <- function(i, cws, dfs, extra_space = 2){
+  cw <- cws[[i]]
+
+  if(is.numeric(cw)){return(cw)}
+  if(length(cw) != 1){stop("If not numeric, col_widths should have lenght 1!")}
+  if(is.na(cw)){return(NA)}
+  guess_names <- NULL
+  if(grepl("guess_from_head", cw)){
+    guess_names <- colnames(dfs[[i]])
+  }
+  if(grepl("guess_from_row",cw)){
+    row_num <- as.numeric(gsub("[^0-9]", "", cw))
+    if(nrow(dfs[[i]]) < row_num){
+      stop("Rows in data frame: ", nrow(dfs[[i]]),
+           "\nGuess row asked: ", row_num)
+      }
+    guess_names <- dfs[[i]][row_num, ]
+  }
+  if(is.null(guess_names)){stop("Unexpected col_widths string: ", cw)}
+
+  nchar(as.character(guess_names)) + extra_space
+}

src/write_xlsx.c

@@ -65,11 +65,25 @@ SEXP C_set_tempdir(SEXP dir){
   return Rf_mkString(TEMPDIR);
 }
 
-SEXP C_write_data_frame_list(SEXP df_list, SEXP file, SEXP col_names, SEXP format_headers, SEXP use_zip64){
+SEXP C_write_data_frame_list(SEXP df_list,
+                             SEXP file,
+                             SEXP col_names,
+                             SEXP format_headers,
+                             SEXP use_zip64,
+                             SEXP freeze_rows,
+                             SEXP freeze_cols,
+                             SEXP header_bg_color,
+                             SEXP autofilter,
+                             SEXP col_widths){
   assert_that(Rf_isVectorList(df_list), "Object is not a list");
   assert_that(Rf_isString(file) && Rf_length(file), "Invalid file path");
   assert_that(Rf_isLogical(col_names), "col_names must be logical");
   assert_that(Rf_isLogical(format_headers), "format_headers must be logical");
+  assert_that(Rf_isInteger(freeze_rows), "freeze_rows must be integer");
+  assert_that(Rf_isInteger(freeze_cols), "freeze_cols must be integer");
+  assert_that(Rf_isInteger(header_bg_color), "header_bg_color must be integer");
+  assert_that(Rf_isLogical(autofilter), "autofilter must be logical");
+  assert_that(Rf_isVectorList(col_widths), "col_widths must be a list of vectors");
 
   //create workbook
   lxw_workbook_options options = {
@@ -88,10 +102,18 @@ SEXP C_write_data_frame_list(SEXP df_list, SEXP file, SEXP col_names, SEXP forma
   lxw_format * datetime = workbook_add_format(workbook);
   format_set_num_format(datetime, "yyyy-mm-dd HH:mm:ss UTC");
 
-  //how to format headers (bold + center)
+  //how to format headers (bold + left + background color)
   lxw_format * title = workbook_add_format(workbook);
   format_set_bold(title);
-  format_set_align(title, LXW_ALIGN_CENTER);
+  format_set_align(title, LXW_ALIGN_LEFT); // works better with filter
+
+  //set bg color
+  if(Rf_asInteger(header_bg_color) > -1){
+    format_set_bg_color(title, Rf_asInteger(header_bg_color));
+  }
+
+
+
 
   //how to format hyperlinks (underline + blue)
   lxw_format * hyperlink = workbook_add_format(workbook);
@@ -117,9 +139,12 @@ SEXP C_write_data_frame_list(SEXP df_list, SEXP file, SEXP col_names, SEXP forma
     if(Rf_asLogical(col_names)){
       SEXP names = PROTECT(Rf_getAttrib(df, R_NamesSymbol));
       for(size_t i = 0; i < Rf_length(names); i++)
-        worksheet_write_string(sheet, cursor, i, Rf_translateCharUTF8(STRING_ELT(names, i)), NULL);
-      if(Rf_asLogical(format_headers))
-        assert_lxw(worksheet_set_row(sheet, cursor, 15, title));
+        //format the headers
+        if(Rf_asLogical(format_headers))
+          worksheet_write_string(sheet, cursor, i, Rf_translateCharUTF8(STRING_ELT(names, i)), title);
+        else
+          worksheet_write_string(sheet, cursor, i, Rf_translateCharUTF8(STRING_ELT(names, i)), NULL);
+
       UNPROTECT(1);
       cursor++;
     }
@@ -128,17 +153,36 @@ SEXP C_write_data_frame_list(SEXP df_list, SEXP file, SEXP col_names, SEXP forma
     size_t cols = Rf_length(df);
     size_t rows = 0;
 
-    // determinte how to format each column
+    // set column widths and determine format
+    SEXP sheet_col_widths = VECTOR_ELT(col_widths, s);
+    size_t len_widths = Rf_length(sheet_col_widths);
+    double *widths_value;
+    int widths_type = TYPEOF(sheet_col_widths);
+    if (widths_type == REALSXP) {
+      widths_value = REAL(sheet_col_widths);
+    } else {
+      widths_value = (double *)malloc(len_widths * sizeof(double));
+      for(size_t i = 0; i < len_widths; i++){
+        widths_value[i] = LXW_DEF_COL_WIDTH;
+      }
+    }
+
     R_COL_TYPE coltypes[cols];
     for(size_t i = 0; i < cols; i++){
+      // set column width keep date and datetime widhts
+      double width;
+      width = ISNA(widths_value[i]) ? LXW_DEF_COL_WIDTH : widths_value[i];
+      worksheet_set_column(sheet, i, i, width, NULL);
+
+      // determine format
       SEXP COL = VECTOR_ELT(df, i);
       coltypes[i] = get_type(COL);
       if(!Rf_isMatrix(COL) && !Rf_inherits(COL, "data.frame"))
         rows = max(rows, Rf_length(COL));
       if(coltypes[i] == COL_DATE)
-        assert_lxw(worksheet_set_column(sheet, i, i, 20, date));
+        assert_lxw(worksheet_set_column(sheet, i, i, 11, date));
       if(coltypes[i] == COL_POSIXCT)
-        assert_lxw(worksheet_set_column(sheet, i, i, 20, datetime));
+        assert_lxw(worksheet_set_column(sheet, i, i, 21, datetime));
     }
 
     // Need to iterate by row first for performance
@@ -201,8 +245,19 @@ SEXP C_write_data_frame_list(SEXP df_list, SEXP file, SEXP col_names, SEXP forma
       }
       cursor++;
     }
+    //freeze rows
+    if((Rf_asInteger(freeze_rows) + Rf_asInteger(freeze_cols)) > 0){
+      worksheet_freeze_panes(sheet, Rf_asInteger(freeze_rows), Rf_asInteger(freeze_cols));
+    }
+
+    if(Rf_asLogical(autofilter)){
+         worksheet_autofilter(sheet, 0, 0, rows, cols-1);
+    }
+
   }
 
+
+
   //this both writes the xlsx file and frees the memory
   assert_lxw(workbook_close(workbook));
   UNPROTECT(1);
@@ -216,7 +271,7 @@ SEXP C_lxw_version(void){
 static const R_CallMethodDef CallEntries[] = {
   {"C_lxw_version",           (DL_FUNC) &C_lxw_version,           0},
   {"C_set_tempdir",           (DL_FUNC) &C_set_tempdir,           1},
-  {"C_write_data_frame_list", (DL_FUNC) &C_write_data_frame_list, 5},
+  {"C_write_data_frame_list", (DL_FUNC) &C_write_data_frame_list, 10},
   {NULL, NULL, 0}
 };
 

vignettes/.gitignore

@@ -0,0 +1,2 @@
+*.html
+*.R