Skip to content

Commit

Permalink
[styles] add wb_add_dxfs_style() wrapper
Browse files Browse the repository at this point in the history
  • Loading branch information
JanMarvin committed Jun 25, 2023
1 parent 8d6b3ed commit 0114e16
Show file tree
Hide file tree
Showing 7 changed files with 304 additions and 4 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Expand Up @@ -60,6 +60,7 @@ export(wb_add_creators)
export(wb_add_data)
export(wb_add_data_table)
export(wb_add_data_validation)
export(wb_add_dxfs_style)
export(wb_add_fill)
export(wb_add_filter)
export(wb_add_font)
Expand Down
57 changes: 57 additions & 0 deletions R/class-workbook-wrappers.R
Expand Up @@ -2708,6 +2708,63 @@ wb_add_named_style <- function(
)
}

#' add dxfs style
#' These styles are used with conditional formatting and custom table styles
#' @param wb wbWorkbook
#' @param name the style name
#' @param font_name the font name
#' @param font_size the font size
#' @param font_color the font color (a `wb_color()` object)
#' @param numFmt the number format
#' @param border logical if borders are applied
#' @param border_color the border color
#' @param border_style the border style
#' @param bgFill any background fill
#' @param gradientFill any gradient fill
#' @param text_bold logical if text is bold
#' @param text_italic logical if text is italic
#' @param text_underline logical if text is underlined
#' @param ... additional arguments passed to `create_dxfs_style()`
#' @return The `wbWorkbookObject`, invisibly
#' @export
wb_add_dxfs_style <- function(
wb,
name,
font_name = NULL,
font_size = NULL,
font_color = NULL,
numFmt = NULL,
border = NULL,
border_color = wb_color(getOption("openxlsx2.borderColor", "black")),
border_style = getOption("openxlsx2.borderStyle", "thin"),
bgFill = NULL,
gradientFill = NULL,
text_bold = NULL,
text_italic = NULL,
text_underline = NULL,
...
) {

assert_workbook(wb)
wb$clone()$add_dxfs_style(
name = name,
font_name = font_name,
font_size = font_size,
font_color = font_color,
numFmt = numFmt,
border = border,
border_color = border_color,
border_style = border_style,
bgFill = bgFill,
gradientFill = gradientFill,
text_bold = text_bold,
text_italic = text_italic,
text_underline = text_underline,
... = ...
)

}

#' Add comment to worksheet
#' @param wb A workbook object
#' @param sheet A worksheet of the workbook
Expand Down
61 changes: 61 additions & 0 deletions R/class-workbook.R
Expand Up @@ -6353,6 +6353,67 @@ wbWorkbook <- R6::R6Class(
invisible(self)
},

#' @description create dxfs style
#' These styles are used with conditional formatting and custom table styles
#' @param name the style name
#' @param font_name the font name
#' @param font_size the font size
#' @param font_color the font color (a `wb_color()` object)
#' @param numFmt the number format
#' @param border logical if borders are applied
#' @param border_color the border color
#' @param border_style the border style
#' @param bgFill any background fill
#' @param gradientFill any gradient fill
#' @param text_bold logical if text is bold
#' @param text_italic logical if text is italic
#' @param text_underline logical if text is underlined
#' @param ... additional arguments passed to `create_dxfs_style()`
#' @return The `wbWorksheetObject`, invisibly
#' @export
add_dxfs_style = function(
name,
font_name = NULL,
font_size = NULL,
font_color = NULL,
numFmt = NULL,
border = NULL,
border_color = wb_color(getOption("openxlsx2.borderColor", "black")),
border_style = getOption("openxlsx2.borderStyle", "thin"),
bgFill = NULL,
gradientFill = NULL,
text_bold = NULL,
text_italic = NULL,
text_underline = NULL,
...
) {

xml_style <- create_dxfs_style(
font_name = font_name,
font_size = font_size,
font_color = font_color,
numFmt = numFmt,
border = border,
border_color = border_color,
border_style = border_style,
bgFill = bgFill,
gradientFill = gradientFill,
text_bold = text_bold,
text_italic = text_italic,
text_underline = text_underline,
... = ...
)

got <- self$styles_mgr$get_dxf_id(name)

if (!is.null(got) && !is.na(got))
warning("dxfs style names should be unique")

self$add_style(xml_style, name)

invisible(self)
},

#' @description clone style from one sheet to another
#' @param from the worksheet you are cloning
#' @param to the worksheet the style is applied to
Expand Down
63 changes: 63 additions & 0 deletions man/wbWorkbook.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

63 changes: 63 additions & 0 deletions man/wb_add_dxfs_style.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

57 changes: 57 additions & 0 deletions tests/testthat/test-wb_styles.R
Expand Up @@ -743,3 +743,60 @@ test_that("wb_add_named_style() works", {
expect_equal(exp, got)

})

test_that("wb_add_dxfs_style() works", {
wb <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_add_dxfs_style(
name = "nay",
font_color = wb_color(hex = "FF9C0006"),
bgFill = wb_color(hex = "FFFFC7CE")
) %>%
wb_add_dxfs_style(
name = "yay",
font_color = wb_color(hex = "FF006100"),
bgFill = wb_color(hex = "FFC6EFCE")
) %>%
wb_add_data(x = -5:5) %>%
wb_add_data(x = LETTERS[1:11], startCol = 2) %>%
wb_add_conditional_formatting(
cols = 1,
rows = 1:11,
rule = "!=0",
style = "nay"
) %>%
wb_add_conditional_formatting(
cols = 1,
rows = 1:11,
rule = "==0",
style = "yay"
)

exp <- c(
`A1:A11` = "<cfRule type=\"expression\" dxfId=\"0\" priority=\"2\"><formula>A1&lt;&gt;0</formula></cfRule>",
`A1:A11` = "<cfRule type=\"expression\" dxfId=\"1\" priority=\"1\"><formula>A1=0</formula></cfRule>"
)
got <- wb$worksheets[[1]]$conditionalFormatting
expect_equal(exp, got)

exp <- c("nay", "yay")
got <- wb$styles_mgr$dxf$name
expect_equal(exp, got)

expect_warning(
wb_workbook() %>%
wb_add_worksheet() %>%
wb_add_dxfs_style(
name = "nay",
font_color = wb_color(hex = "FF9C0006"),
bgFill = wb_color(hex = "FFFFC7CE")
) %>%
wb_add_dxfs_style(
name = "nay",
font_color = wb_color(hex = "FF006100"),
bgFill = wb_color(hex = "FFC6EFCE")
),
"dxfs style names should be unique"
)

})
6 changes: 2 additions & 4 deletions vignettes/conditional-formatting.Rmd
Expand Up @@ -21,10 +21,8 @@ library(openxlsx2)

```{r}
wb <- wb_workbook()
negStyle <- create_dxfs_style(font_color = wb_color(hex = "FF9C0006"), bgFill = wb_color(hex = "FFFFC7CE"))
posStyle <- create_dxfs_style(font_color = wb_color(hex = "FF006100"), bgFill = wb_color(hex = "FFC6EFCE"))
wb$styles_mgr$add(negStyle, "negStyle")
wb$styles_mgr$add(posStyle, "posStyle")
wb$add_dxfs_style(name = "negStyle", font_color = wb_color(hex = "FF9C0006"), bgFill = wb_color(hex = "FFFFC7CE"))
wb$add_dxfs_style(name = "posStyle", font_color = wb_color(hex = "FF006100"), bgFill = wb_color(hex = "FFC6EFCE"))
```

## Rule applies to all each cell in range
Expand Down

0 comments on commit 0114e16

Please sign in to comment.