[header] add scaling with doc and allign with margins options. closes #…

…1085
JanMarvin · Jul 17, 2024 · c5f5a7a · c5f5a7a
1 parent 62c13c5
commit c5f5a7a
Show file tree

Hide file tree

Showing 8 changed files with 103 additions and 28 deletions.
diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R
@@ -1667,6 +1667,8 @@ wb_set_bookview <- function(
 #'   right.  `header` and `footer` are used to default additional arguments.
 #'   Setting `even`, `odd`, or `first`, overrides `header`/`footer`. Use `NA` to
 #'   skip a position.
+#' @param align_with_margins Align header/footer with margins
+#' @param scale_with_doc Scale header/footer with document
 # #' @inheritParams wb_add_worksheet
 #' @param ... additional arguments
 #' @export
@@ -1710,30 +1712,33 @@ wb_set_bookview <- function(
 #' )
 wb_set_header_footer <- function(
     wb,
-    sheet        = current_sheet(),
-    header       = NULL,
-    footer       = NULL,
-    even_header  = NULL,
-    even_footer  = NULL,
-    first_header = NULL,
-    first_footer = NULL,
+    sheet              = current_sheet(),
+    header             = NULL,
+    footer             = NULL,
+    even_header        = NULL,
+    even_footer        = NULL,
+    first_header       = NULL,
+    first_footer       = NULL,
+    align_with_margins = NULL,
+    scale_with_doc     = NULL,
     ...
 ) {
   assert_workbook(wb)
   wb$clone()$set_header_footer(
-    sheet        = sheet,
-    header       = header,
-    footer       = footer,
-    even_header  = even_header,
-    even_footer  = even_footer,
-    first_header = first_header,
-    first_footer = first_footer,
-    ...          = ...
+    sheet              = sheet,
+    header             = header,
+    footer             = footer,
+    even_header        = even_header,
+    even_footer        = even_footer,
+    first_header       = first_header,
+    first_footer       = first_footer,
+    align_with_margins = align_with_margins,
+    scale_with_doc     = scale_with_doc,
+    ...                = ...
   )
 }
 
 
-
 #' Set page margins, orientation and print scaling of a worksheet
 #'
 #' Set page margins, orientation and print scaling.

diff --git a/R/class-workbook.R b/R/class-workbook.R
@@ -7173,15 +7173,19 @@ wbWorkbook <- R6::R6Class(
     #' @param even_footer evenFooter
     #' @param first_header firstHeader
     #' @param first_footer firstFooter
+    #' @param align_with_margins align_with_margins
+    #' @param scale_with_doc scale_with_doc
     #' @return The `wbWorkbook` object, invisibly
     set_header_footer = function(
-      sheet = current_sheet(),
-      header       = NULL,
-      footer       = NULL,
-      even_header  = NULL,
-      even_footer  = NULL,
-      first_header = NULL,
-      first_footer = NULL,
+      sheet              = current_sheet(),
+      header             = NULL,
+      footer             = NULL,
+      even_header        = NULL,
+      even_footer        = NULL,
+      first_header       = NULL,
+      first_footer       = NULL,
+      align_with_margins = NULL,
+      scale_with_doc     = NULL,
       ...
     ) {
 
@@ -7234,6 +7238,16 @@ wbWorkbook <- R6::R6Class(
         hf <- NULL
       }
 
+      if (!is.null(scale_with_doc)) {
+        assert_class(scale_with_doc, "logical")
+        self$worksheets[[sheet]]$scale_with_doc     <- scale_with_doc
+      }
+
+      if (!is.null(align_with_margins)) {
+        assert_class(align_with_margins, "logical")
+        self$worksheets[[sheet]]$align_with_margins <- align_with_margins
+      }
+
       self$worksheets[[sheet]]$headerFooter <- hf
       invisible(self)
     },

diff --git a/R/class-worksheet.R b/R/class-worksheet.R
@@ -62,6 +62,12 @@ wbWorksheet <- R6::R6Class(
     #' @field headerFooter headerFooter
     headerFooter = NULL,
 
+    #' @field scale_with_doc scale_with_doc
+    scale_with_doc = FALSE,
+
+    #' @field align_with_margins align_with_margins
+    align_with_margins = FALSE,
+
     #' @field rowBreaks rowBreaks
     rowBreaks = character(),
 
@@ -364,7 +370,11 @@ wbWorksheet <- R6::R6Class(
 
         # headerFooter
         # should return NULL when !length(self$headerFooter)
-        genHeaderFooterNode(self$headerFooter),
+        genHeaderFooterNode(
+          self$headerFooter,
+          self$scale_with_doc,
+          self$align_with_margins
+        ),
 
         # rowBreaks
         if (n <- length(self$rowBreaks)) {

diff --git a/R/helper-functions.R b/R/helper-functions.R
@@ -238,8 +238,10 @@ getHeaderFooterNode <- function(x) {
 
 #' generate headerFooter xml from left, center, and right characters
 #' @param x xml string
+#' @param scale_with_doc scale with doc
+#' @param align_with_margins align with margins
 #' @noRd
-genHeaderFooterNode <- function(x) {
+genHeaderFooterNode <- function(x, scale_with_doc = FALSE, align_with_margins = FALSE) {
 
   # <headerFooter differentOddEven="1" differentFirst="1" scaleWithDoc="0" alignWithMargins="0">
   #   <oddHeader>&amp;Lfirst L&amp;CfC&amp;RfR</oddHeader>
@@ -312,9 +314,11 @@ genHeaderFooterNode <- function(x) {
 
 
   headTag <- sprintf(
-    '<headerFooter differentOddEven="%s" differentFirst="%s" scaleWithDoc="0" alignWithMargins="0">',
+    '<headerFooter differentOddEven="%s" differentFirst="%s" scaleWithDoc="%s" alignWithMargins="%s">',
     as.integer(!(is.null(evenHeader) & is.null(evenFooter))),
-    as.integer(!(is.null(firstHeader) & is.null(firstFooter)))
+    as.integer(!(is.null(firstHeader) & is.null(firstFooter))),
+    as_xml_attr(scale_with_doc),
+    as_xml_attr(align_with_margins)
   )
 
   paste0(headTag, oddHeader, oddFooter, evenHeader, evenFooter, firstHeader, firstFooter, "</headerFooter>")

diff --git a/R/wb_load.R b/R/wb_load.R
@@ -972,7 +972,16 @@ wb_load <- function(
   for (i in seq_len(nSheets)) {
     if (sheets$typ[i] == "worksheet") {
       if (length(wb$worksheets[[i]]$headerFooter)) {
-        wb$worksheets[[i]]$headerFooter <- getHeaderFooterNode(wb$worksheets[[i]]$headerFooter)
+        # get attributes
+        hf_attrs <- rbindlist(xml_attr(wb$worksheets[[i]]$headerFooter, "headerFooter"))
+
+        if (!is.null(hf_attrs$alignWithMargins))
+          wb$worksheets[[i]]$align_with_margins <- as.logical(as.integer(hf_attrs$alignWithMargins))
+
+        if (!is.null(hf_attrs$scaleWithDoc))
+          wb$worksheets[[i]]$scale_with_doc     <- as.logical(as.integer(hf_attrs$scaleWithDoc))
+
+        wb$worksheets[[i]]$headerFooter       <- getHeaderFooterNode(wb$worksheets[[i]]$headerFooter)
       }
     }
   }

diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd
diff --git a/man/wb_set_header_footer.Rd b/man/wb_set_header_footer.Rd
diff --git a/tests/testthat/test-class-worksheet.R b/tests/testthat/test-class-worksheet.R
@@ -177,3 +177,24 @@ test_that("tab_color works", {
   )
 
 })
+
+test_that("setting and loading header/footer attributes works", {
+  wb <- wb_workbook() %>%
+    wb_add_worksheet() %>%
+    wb_set_header_footer(
+      header             = c(NA, "Header", NA),
+      scale_with_doc     = TRUE,
+      align_with_margins = TRUE
+    ) %>%
+    wb_page_setup(orientation = "landscape", fit_to_width = 1) %>%
+    wb_set_sheetview(view = "pageLayout", zoom_scale = 40) %>%
+    wb_add_data(x = as.data.frame(matrix(1:500, ncol = 25)))
+
+  temp <- temp_xlsx()
+  wb$save(temp)
+  rm(wb)
+
+  wb <- wb_load(temp)
+  expect_true(wb$worksheets[[1]]$scale_with_doc)
+  expect_true(wb$worksheets[[1]]$align_with_margins)
+})