Skip to content

Commit

Permalink
[wb_page_setup] rework the function. In the future wb_set_page_setup(…
Browse files Browse the repository at this point in the history 
…) could be used
  • Loading branch information
@JanMarvin
JanMarvin committed Mar 10, 2024
1 parent c60c0d2 commit 6fb3583
Show file tree
Hide file tree
Showing 8 changed files with 390 additions and 59 deletions.
47 changes: 47 additions & 0 deletions R/class-workbook-wrappers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1623,6 +1623,8 @@ wb_set_header_footer <- function(
#' @param ... additional arguments
#' @export
#' @details
#' When adding fitting to width and height manual adjustment of the scaling factor is required. Setting `fit_to_width` and `fit_to_height` only tells spreadsheet software that the scaling was applied, but not which scaling was applied.
#'
#' `paper_size` is an integer corresponding to:
#'
#' | size | "paper type" |
Expand Down Expand Up @@ -1693,6 +1695,51 @@ wb_set_header_footer <- function(
#' | 66 | A2 paper (420 mm by 594 mm) |
#' | 67 | A3 transverse paper (297 mm by 420 mm) |
#' | 68 | A3 extra transverse paper (322 mm by 445 mm) |
#' | 69 | Japanese Double Postcard (200 mm x 148 mm) 70=A6(105mmx148mm) |
#' | 71 | Japanese Envelope Kaku #2 |
#' | 72 | Japanese Envelope Kaku #3 |
#' | 73 | Japanese Envelope Chou #3 |
#' | 74 | Japanese Envelope Chou #4 |
#' | 75 | Letter Rotated (11in x 8 1/2 11 in) |
#' | 76 | A3 Rotated (420 mm x 297 mm) |
#' | 77 | A4 Rotated (297 mm x 210 mm) |
#' | 78 | A5 Rotated (210 mm x 148 mm) |
#' | 79 | B4 (JIS) Rotated (364 mm x 257 mm) |
#' | 80 | B5 (JIS) Rotated (257 mm x 182 mm) |
#' | 81 | Japanese Postcard Rotated (148 mm x 100 mm) |
#' | 82 | Double Japanese Postcard Rotated (148 mm x 200 mm) 83 = A6 Rotated (148 mm x 105 mm) |
#' | 84 | Japanese Envelope Kaku #2 Rotated |
#' | 85 | Japanese Envelope Kaku #3 Rotated |
#' | 86 | Japanese Envelope Chou #3 Rotated |
#' | 87 | Japanese Envelope Chou #4 Rotated 88=B6(JIS)(128mmx182mm) |
#' | 89 | B6 (JIS) Rotated (182 mm x 128 mm) |
#' | 90 | (12 in x 11 in) |
#' | 91 | Japanese Envelope You #4 |
#' | 92 | Japanese Envelope You #4 Rotated 93=PRC16K(146mmx215mm) 94=PRC32K(97mmx151mm) |
#' | 95 | PRC 32K(Big) (97 mm x 151 mm) |
#' | 96 | PRC Envelope #1 (102 mm x 165 mm) |
#' | 97 | PRC Envelope #2 (102 mm x 176 mm) |
#' | 98 | PRC Envelope #3 (125 mm x 176 mm) |
#' | 99 | PRC Envelope #4 (110 mm x 208 mm) |
#' | 100 | PRC Envelope #5 (110 mm x 220 mm) |
#' | 101 | PRC Envelope #6 (120 mm x 230 mm) |
#' | 102 | PRC Envelope #7 (160 mm x 230 mm) |
#' | 103 | PRC Envelope #8 (120 mm x 309 mm) |
#' | 104 | PRC Envelope #9 (229 mm x 324 mm) |
#' | 105 | PRC Envelope #10 (324 mm x 458 mm) |
#' | 106 | PRC 16K Rotated |
#' | 107 | PRC 32K Rotated |
#' | 108 | PRC 32K(Big) Rotated |
#' | 109 | PRC Envelope #1 Rotated (165 mm x 102 mm) |
#' | 110 | PRC Envelope #2 Rotated (176 mm x 102 mm) |
#' | 111 | PRC Envelope #3 Rotated (176 mm x 125 mm) |
#' | 112 | PRC Envelope #4 Rotated (208 mm x 110 mm) |
#' | 113 | PRC Envelope #5 Rotated (220 mm x 110 mm) |
#' | 114 | PRC Envelope #6 Rotated (230 mm x 120 mm) |
#' | 115 | PRC Envelope #7 Rotated (230 mm x 160 mm) |
#' | 116 | PRC Envelope #8 Rotated (309 mm x 120 mm) |
#' | 117 | PRC Envelope #9 Rotated (324 mm x 229 mm) |
#' | 118 | PRC Envelope #10 Rotated (458 mm x 324 mm) |
#'
#' @examples
#' wb <- wb_workbook()
Expand Down
210 changes: 169 additions & 41 deletions R/class-workbook.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6048,6 +6048,18 @@ wbWorkbook <- R6::R6Class(

#' @description page_setup()
#' @param orientation orientation
#' @param black_and_white black_and_white
#' @param cell_comments cell_comment
#' @param copies copies
#' @param draft draft
#' @param errors errors
#' @param first_page_number first_page_number
#' @param id id
#' @param page_order page_order
#' @param paper_height,paper_width paper size
#' @param use_first_page_number use_first_page_number
#' @param use_printer_defaults use_printer_defaults
#' @param hdpi,vdpi horizontal and vertical dpi
#' @param scale scale
#' @param left left
#' @param right right
Expand All @@ -6063,10 +6075,25 @@ wbWorkbook <- R6::R6Class(
#' @param summary_row summaryRow
#' @param summary_col summaryCol
#' @return The `wbWorkbook` object, invisibly
page_setup = function(
set_page_setup = function(
sheet = current_sheet(),
# page properties
black_and_white = NULL,
cell_comments = NULL,
copies = NULL,
draft = NULL,
errors = NULL,
first_page_number = NULL,
id = NULL, # useful? and should the user be able to set this by accident?
page_order = NULL,
paper_height = NULL,
paper_width = NULL,
hdpi = NULL,
vdpi = NULL,
use_first_page_number = NULL,
use_printer_defaults = NULL,
orientation = NULL,
scale = 100,
scale = NULL,
left = 0.7,
right = 0.7,
top = 0.75,
Expand All @@ -6076,75 +6103,97 @@ wbWorkbook <- R6::R6Class(
fit_to_width = FALSE,
fit_to_height = FALSE,
paper_size = NULL,
# outline properties
print_title_rows = NULL,
print_title_cols = NULL,
summary_row = NULL,
summary_col = NULL,
...
summary_col = NULL
) {

standardize_case_names(...)

sheet <- private$get_sheet_index(sheet)
xml <- self$worksheets[[sheet]]$pageSetup

if (!is.null(orientation)) {
orientation <- tolower(orientation)
if (!orientation %in% c("portrait", "landscape")) stop("Invalid page orientation.")
} else {
# if length(xml) == 1 then use if () {} else {}
orientation <- ifelse(grepl("landscape", xml), "landscape", "portrait") ## get existing
}
attrs <- rbindlist(xml_attr(xml, "pageSetup"))

## orientation ----
orientation <- orientation %||% attrs$orientation
orientation <- tolower(orientation)
if (!orientation %in% c("portrait", "landscape")) stop("Invalid page orientation.")

if ((scale < 10) || (scale > 400)) {
stop("Scale must be between 10 and 400.")
## scale ----
if (!is.null(scale)) {
scale <- scale %||% attrs$scale
scale <- as.numeric(scale)
if ((scale < 10) || (scale > 400)) {
message("Scale must be between 10 and 400. Scale was: ", scale)
scale <- if (scale < 10) 10 else if (scale > 400) 400
}
}

paper_size <- paper_size %||% attrs$paperSize
if (!is.null(paper_size)) {
paper_sizes <- 1:68
paper_sizes <- paper_sizes[!paper_sizes %in% 48:49]
paper_sizes <- 1:118
paper_size <- as.integer(paper_size)
if (!paper_size %in% paper_sizes) {
stop("paper_size must be an integer in range [1, 68]. See ?wb_page_setup details.")
stop("paper_size must be an integer in range [1, 118]. See ?wb_page_setup details.")
}
paper_size <- as.integer(paper_size)
} else {
paper_size <- regmatches(xml, regexpr('(?<=paperSize=")[0-9]+', xml, perl = TRUE)) ## get existing
}

## Keep defaults on orientation, hdpi, vdpi, paperSize ----
hdpi <- regmatches(xml, regexpr('(?<=horizontalDpi=")[0-9]+', xml, perl = TRUE))
vdpi <- regmatches(xml, regexpr('(?<=verticalDpi=")[0-9]+', xml, perl = TRUE))
## HDPI/VDPI ----
horizontal_dpi <- hdpi %||% attrs$horizontalDpi
vertical_dpi <- vdpi %||% attrs$verticalDpi

## Update ----
self$worksheets[[sheet]]$pageSetup <- sprintf(
'<pageSetup paperSize="%s" orientation="%s" scale = "%s" fitToWidth="%s" fitToHeight="%s" horizontalDpi="%s" verticalDpi="%s"/>',
paper_size, orientation, scale, as_xml_attr(fit_to_width), as_xml_attr(fit_to_height), hdpi, vdpi
xml <- xml_attr_mod(
xml,
xml_attributes = c(
blackAndWhite = as_xml_attr(black_and_white),
cellComments = as_xml_attr(cell_comments),
copies = as_xml_attr(copies),
draft = as_xml_attr(draft),
errors = as_xml_attr(errors),
firstPageNumber = as_xml_attr(first_page_number),
fitToHeight = as_xml_attr(fit_to_height),
fitToWidth = as_xml_attr(fit_to_width),
horizontalDpi = as_xml_attr(horizontal_dpi),
id = as_xml_attr(id),
orientation = as_xml_attr(orientation),
pageOrder = as_xml_attr(page_order),
paperHeight = as_xml_attr(paper_height),
paperSize = as_xml_attr(paper_size),
paperWidth = as_xml_attr(paper_width),
scale = as_xml_attr(scale),
useFirstPageNumber = as_xml_attr(use_first_page_number),
usePrinterDefaults = as_xml_attr(use_printer_defaults),
verticalDpi = as_xml_attr(vertical_dpi)
)
)

if (fit_to_height || fit_to_width) {
self$worksheets[[sheet]]$sheetPr <- unique(c(self$worksheets[[sheet]]$sheetPr, '<pageSetupPr fitToPage="1"/>'))
}
self$worksheets[[sheet]]$pageSetup <- xml

## update pageMargins
self$worksheets[[sheet]]$pageMargins <-
sprintf('<pageMargins left="%s" right="%s" top="%s" bottom="%s" header="%s" footer="%s"/>', left, right, top, bottom, header, footer)
sprintf(
'<pageMargins left="%s" right="%s" top="%s" bottom="%s" header="%s" footer="%s"/>',
left, right, top, bottom, header, footer
)

## summary row and col ----
outlinepr <- character()
validRow <- function(summary_row) {
return(tolower(summary_row) %in% c("above", "below"))
}
validCol <- function(summary_col) {
return(tolower(summary_col) %in% c("left", "right"))
}

outlinepr <- ""

if (!is.null(summary_row)) {

if (!validRow(summary_row)) {
stop("Invalid \`summary_row\` option. Must be one of \"Above\" or \"Below\".")
} else if (tolower(summary_row) == "above") {
outlinepr <- ' summaryBelow=\"0\"'
outlinepr <- c(summaryBelow = "0")
} else {
outlinepr <- ' summaryBelow=\"1\"'
outlinepr <- c(summaryBelow = "1")
}
}

Expand All @@ -6153,16 +6202,29 @@ wbWorkbook <- R6::R6Class(
if (!validCol(summary_col)) {
stop("Invalid \`summary_col\` option. Must be one of \"Left\" or \"Right\".")
} else if (tolower(summary_col) == "left") {
outlinepr <- paste0(outlinepr, ' summaryRight=\"0\"')
outlinepr <- c(outlinepr, c(summaryRight = "0"))
} else {
outlinepr <- paste0(outlinepr, ' summaryRight=\"1\"')
outlinepr <- c(outlinepr, c(summaryRight = "1"))
}
}

if (!stri_isempty(outlinepr)) {
self$worksheets[[sheet]]$sheetPr <- unique(c(self$worksheets[[sheet]]$sheetPr, paste0("<outlinePr", outlinepr, "/>")))
## update sheetPr ----
xml <- self$worksheets[[sheet]]$sheetPr

if (length(xml) == 0) xml <- "<sheetPr/>"

## order matters: tabColor, outlinePr, pageSetUpPr.
## TODO make sure that the order is valid
if (length(outlinepr)) {
xml <- xml_child_mod(xml, "outlinePr", xml_attributes = outlinepr)
}

if (fit_to_height || fit_to_width) {
xml <- xml_child_mod(xml, "pageSetUpPr", xml_attributes = c(fitToPage = "1"))
}

self$worksheets[[sheet]]$sheetPr <- xml

## print Titles ----
if (!is.null(print_title_rows) && is.null(print_title_cols)) {
if (!is.numeric(print_title_rows)) {
Expand Down Expand Up @@ -6208,14 +6270,80 @@ wbWorkbook <- R6::R6Class(

self$workbook$definedNames <- c(
self$workbook$definedNames,
sprintf('<definedName name="_xlnm.Print_Titles" localSheetId="%s">\'%s\'!%s,\'%s\'!%s</definedName>', localSheetId, sheet, cols, sheet, rows)
sprintf(
'<definedName name="_xlnm.Print_Titles" localSheetId="%s">\'%s\'!%s,\'%s\'!%s</definedName>',
localSheetId, sheet, cols, sheet, rows
)
)

}

invisible(self)
},

#' @description page_setup()
#' @param orientation orientation
#' @param scale scale
#' @param left left
#' @param right right
#' @param top top
#' @param bottom bottom
#' @param header header
#' @param footer footer
#' @param fit_to_width fitToWidth
#' @param fit_to_height fitToHeight
#' @param paper_size paperSize
#' @param print_title_rows printTitleRows
#' @param print_title_cols printTitleCols
#' @param summary_row summaryRow
#' @param summary_col summaryCol
#' @return The `wbWorkbook` object, invisibly
page_setup = function(
sheet = current_sheet(),
orientation = NULL,
scale = 100,
left = 0.7,
right = 0.7,
top = 0.75,
bottom = 0.75,
header = 0.3,
footer = 0.3,
fit_to_width = FALSE,
fit_to_height = FALSE,
paper_size = NULL,
print_title_rows = NULL,
print_title_cols = NULL,
summary_row = NULL,
summary_col = NULL,
...
) {

standardize_case_names(...)

sheet <- private$get_sheet_index(sheet)

self$set_page_setup(
sheet = sheet,
orientation = orientation,
scale = scale,
left = left,
right = right,
top = top,
bottom = bottom,
header = header,
footer = footer,
fit_to_width = fit_to_width,
fit_to_height = fit_to_height,
paper_size = paper_size,
print_title_rows = print_title_rows,
print_title_cols = print_title_cols,
summary_row = summary_row,
summary_col = summary_col
)

invisible(self)
},

## header footer ----

#' @description Sets headers and footers
Expand Down

0 comments on commit 6fb3583

Please sign in to comment.