diff --git a/R/baseXML.R b/R/baseXML.R
index 1f5063abe..c3b2121c2 100644
--- a/R/baseXML.R
+++ b/R/baseXML.R
@@ -480,16 +480,16 @@ gen_databar_extlst <- function(guid, sqref, posColor, negColor, values, border,
xml <- sprintf('', guid, border, gradient)
if (is.null(values)) {
- xml <- sprintf('
+ xml <- sprintf('
%s
- %s', xml, posColor, negColor, negColor, sqref)
+ %s', xml, posColor, negColor, negColor, sqref)
} else {
- xml <- sprintf('
+ xml <- sprintf('
%s
%s%s
- %s', xml, values[[1]], values[[2]], posColor, negColor, negColor, sqref)
+ %s', xml, values[[1]], values[[2]], posColor, negColor, negColor, sqref)
}
return(xml)
diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R
index d024f33af..46e4f326e 100644
--- a/R/class-workbook-wrappers.R
+++ b/R/class-workbook-wrappers.R
@@ -3873,9 +3873,9 @@ wb_add_form_control <- function(
#' `[params$reverse]`\cr If `TRUE`, the order is reversed. Default `FALSE`\cr\cr
#' `[params$percent]`\cr If `TRUE`, uses percentage\cr\cr
#' `[params$iconSet]`\cr Uses one of the implemented icon sets. Values must match the length of the icons
-#' in the set 3Arrows, 3ArrowsGray, 3Flags, 3Signs, 3Symbols, 3Symbols2, 3TrafficLights1, 3TrafficLights2,
-#' 4Arrows, 4ArrowsGray, 4Rating, 4RedToBlack, 4TrafficLights, 5Arrows, 5ArrowsGray, 5Quarters, 5Rating. The
-#' default is 3TrafficLights1.
+#' in the set 3Arrows, 3ArrowsGray, 3Flags, 3Signs, 3Stars, 3Symbols, 3Symbols2, 3TrafficLights1, 3TrafficLights2,
+#' 3Triangles, 4Arrows, 4ArrowsGray, 4Rating, 4RedToBlack, 4TrafficLights, 5Arrows, 5ArrowsGray, 5Boxes, 5Quarters, 5Rating.
+#' The default is 3TrafficLights1.
#' }
#' }
#'
diff --git a/R/class-workbook.R b/R/class-workbook.R
index 32b86ff34..504a826fc 100644
--- a/R/class-workbook.R
+++ b/R/class-workbook.R
@@ -1901,33 +1901,17 @@ wbWorkbook <- R6::R6Class(
next_id <- get_next_id(self$worksheets_rels[[sheet]])
+
+
# add the pivot table and the drawing to the worksheet
- is_ext_x14 <- grepl("xmlns:x14", self$worksheets[[sheet]]$extLst)
if (!any(grepl(sprintf("Target=\"../slicers/slicer%s.xml\"", self$worksheets[[sheet]]$relships$slicer), self$worksheets_rels[[sheet]]))) {
slicer_list_xml <- sprintf(
- '',
+ '',
next_id
)
- # add the extension list to the worksheet
- if (length(self$worksheets[[sheet]]$extLst) == 0 || !any(is_ext_x14)) {
-
- ext_x14 <- ""
-
- self$worksheets[[sheet]]$append(
- "extLst",
- ext_x14
- )
-
- is_ext_x14 <- grepl("xmlns:x14", self$worksheets[[sheet]]$extLst)
-
- }
-
- self$worksheets[[sheet]]$extLst[is_ext_x14] <- xml_add_child(
- self$worksheets[[sheet]]$extLst[is_ext_x14],
- xml_child = slicer_list_xml
- )
+ self$worksheets[[sheet]]$.__enclos_env__$private$do_append_x14(slicer_list_xml, "x14:slicer", "x14:slicerList")
self$worksheets_rels[[sheet]] <- append(
self$worksheets_rels[[sheet]],
@@ -1992,7 +1976,7 @@ wbWorkbook <- R6::R6Class(
# remove worksheet relationship
self$worksheets_rels[[sheet]] <- self$worksheets_rels[[sheet]][!grepl(slicer_xml, self$worksheets_rels[[sheet]])]
# remove "x14:slicerList"
- is_ext_x14 <- grepl("xmlns:x14", self$worksheets[[sheet]]$extLst)
+ is_ext_x14 <- grepl("x14:slicerList", self$worksheets[[sheet]]$extLst)
extLst <- xml_rm_child(self$worksheets[[sheet]]$extLst[is_ext_x14], xml_child = "x14:slicerList")
self$worksheets[[sheet]]$extLst[is_ext_x14] <- extLst
@@ -2296,7 +2280,7 @@ wbWorkbook <- R6::R6Class(
)
# add the extension list to the worksheet
- is_ext_x15 <- grepl("xmlns:x15", self$worksheets[[sheet]]$extLst)
+ is_ext_x15 <- grepl("x15:timelineRefs", self$worksheets[[sheet]]$extLst)
if (length(self$worksheets[[sheet]]$extLst) == 0 || !any(is_ext_x15)) {
ext_x15 <- ""
@@ -2306,7 +2290,7 @@ wbWorkbook <- R6::R6Class(
ext_x15
)
- is_ext_x15 <- grepl("xmlns:x15", self$worksheets[[sheet]]$extLst)
+ is_ext_x15 <- length(self$worksheets[[sheet]]$extLst)
}
@@ -2378,7 +2362,7 @@ wbWorkbook <- R6::R6Class(
# remove worksheet relationship
self$worksheets_rels[[sheet]] <- self$worksheets_rels[[sheet]][!grepl(timeline_xml, self$worksheets_rels[[sheet]])]
# remove "x15:timelineRefs"
- is_ext_x15 <- grepl("xmlns:x15", self$worksheets[[sheet]]$extLst)
+ is_ext_x15 <- grepl("x15:timelineRefs", self$worksheets[[sheet]]$extLst)
extLst <- xml_rm_child(self$worksheets[[sheet]]$extLst[is_ext_x15], xml_child = "x15:timelineRefs")
self$worksheets[[sheet]]$extLst[is_ext_x15] <- extLst
@@ -9537,7 +9521,7 @@ wbWorkbook <- R6::R6Class(
uniqueValues = cf_unique_values(dxfId),
## iconSet ----
- iconSet = cf_icon_set(values, params),
+ iconSet = cf_icon_set(self$worksheets[[sheet]]$extLst, sqref, values, params),
## containsErrors ----
containsErrors = cf_iserror(dxfId, sqref),
@@ -9556,11 +9540,15 @@ wbWorkbook <- R6::R6Class(
)
# dataBar needs additional extLst
- if (!is.null(attr(cfRule, "extLst")))
- self$worksheets[[sheet]]$extLst <- read_xml(attr(cfRule, "extLst"), pointer = FALSE)
+ if (!is.null(attr(cfRule, "extLst"))) {
+ # self$worksheets[[sheet]]$extLst <- read_xml(attr(cfRule, "extLst"), pointer = FALSE)
+ self$worksheets[[sheet]]$.__enclos_env__$private$do_append_x14(attr(cfRule, "extLst"), "x14:conditionalFormatting", "x14:conditionalFormattings")
+ }
- private$append_sheet_field(sheet, "conditionalFormatting", read_xml(cfRule, pointer = FALSE))
- names(self$worksheets[[sheet]]$conditionalFormatting) <- nms
+ if (length(cfRule)) {
+ private$append_sheet_field(sheet, "conditionalFormatting", read_xml(cfRule, pointer = FALSE))
+ names(self$worksheets[[sheet]]$conditionalFormatting) <- nms
+ }
invisible(self)
},
diff --git a/R/class-worksheet.R b/R/class-worksheet.R
index 36a91d5e5..fc24088ca 100644
--- a/R/class-worksheet.R
+++ b/R/class-worksheet.R
@@ -902,6 +902,7 @@ wbWorksheet <- R6::R6Class(
# @description add data_validation_lst
# @param datavalidation datavalidation
+ # TODO extend this for x15 and add it to timeline
do_append_x14 = function(
x,
s_name,
@@ -921,6 +922,8 @@ wbWorksheet <- R6::R6Class(
uri <- ""
# if (l_name == "x14:dataValidations") uri <- "{CCE6A557-97BC-4b89-ADB6-D9C93CAAB3DF}"
if (l_name == "x14:sparklineGroups") uri <- "{05C60535-1F16-4fd2-B633-F4F36F0B64E0}"
+ if (l_name == "x14:conditionalFormattings") uri <- "{78C0D931-6437-407d-A8EE-F0AAD7539E65}"
+ if (l_name == "x14:slicerList") uri <- "{A8765BA9-456A-4dab-B4F3-ACF838C121DE}"
is_needed_uri <- grepl(pattern = uri, extLst, fixed = TRUE)
@@ -942,13 +945,15 @@ wbWorksheet <- R6::R6Class(
# check again and should be exactly one ext node
is_xmlns_x14 <- grepl(pattern = "xmlns:x14", extLst)
+ l_name_attr <- c("xmlns:xm" = "http://schemas.microsoft.com/office/excel/2006/main")
+
# check for l_name and add one if none is found
if (length(xml_node(ext, "ext", l_name)) == 0) {
ext <- xml_add_child(
ext,
xml_node_create(
l_name,
- xml_attributes = c("xmlns:xm" = "http://schemas.microsoft.com/office/excel/2006/main"))
+ xml_attributes = l_name_attr)
)
}
diff --git a/R/conditional_formatting.R b/R/conditional_formatting.R
index 78f2092a6..f50990730 100644
--- a/R/conditional_formatting.R
+++ b/R/conditional_formatting.R
@@ -121,29 +121,6 @@ cf_create_databar <- function(extLst, formula, params, sqref, values) {
gradient = gradient
)
- # check if any extLst availaible
- if (length(extLst) == 0) {
- extLst <- newExtLst
- } else if (length(xml_node(extLst, "ext", "x14:conditionalFormattings")) == 0) {
- # extLst is available, has no conditionalFormattings
- extLst <- xml_add_child(
- extLst,
- xml_node(newExtLst, "ext", "x14:conditionalFormattings")
- )
- } else {
- # extLst is available, has conditionalFormattings
- extLst <- xml_add_child(
- extLst,
- xml_node(
- newExtLst,
- "ext",
- "x14:conditionalFormattings",
- "x14:conditionalFormatting"
- ),
- level = "x14:conditionalFormattings"
- )
- }
-
cf_rule_extLst <- sprintf(
'
@@ -192,7 +169,7 @@ cf_create_databar <- function(extLst, formula, params, sqref, values) {
)
}
- attr(cf_rule, "extLst") <- extLst
+ attr(cf_rule, "extLst") <- newExtLst
cf_rule
}
@@ -349,6 +326,8 @@ cf_bottom_n <- function(dxfId, values) {
#' @rdname cf_rules
#' @noRd
cf_icon_set <- function(
+ extLst,
+ sqref,
values,
params
) {
@@ -359,6 +338,15 @@ cf_icon_set <- function(
reverse <- NULL
iconSet <- NULL
+ # per default iconSet creation is store in $conditionalFormatting.
+ # The few exceptions are stored in extLst
+ guid <- NULL
+ x14_ns <- NULL
+ if (any(params$iconSet %in% c("3Stars", "3Triangles", "5Boxes", "NoIcons"))) {
+ guid <- st_guid()
+ x14_ns <- "x14:"
+ }
+
if (!is.null(params$iconSet))
iconSet <- params$iconSet
@@ -372,15 +360,16 @@ cf_icon_set <- function(
# create cfRule with iconset and cfvo
cf_rule <- xml_node_create(
- "cfRule",
+ paste0(x14_ns, "cfRule"),
xml_attributes = c(
type = "iconSet",
- priority = priority
+ priority = priority,
+ id = guid
)
)
iconset <- xml_node_create(
- "iconSet",
+ paste0(x14_ns, "iconSet"),
xml_attributes = c(
iconSet = iconSet,
showValue = showValue,
@@ -389,25 +378,59 @@ cf_icon_set <- function(
)
for (i in seq_along(values)) {
- iconset <- xml_add_child(
- iconset,
- xml_child = c(
- xml_node_create(
- "cfvo",
- xml_attributes = c(
- type = type,
- val = values[i]
+ if (is.null(x14_ns)) {
+ iconset <- xml_add_child(
+ iconset,
+ xml_child = c(
+ xml_node_create(
+ "cfvo",
+ xml_attributes = c(
+ type = type,
+ val = values[i]
+ )
)
)
)
- )
+ } else {
+ iconset <- xml_add_child(
+ iconset,
+ xml_child = c(
+ xml_node_create(
+ "x14:cfvo",
+ xml_attributes = c(
+ type = type
+ ),
+ xml_children = xml_node_create("xm:f",
+ xml_children = values[i]
+ )
+ )
+ )
+ )
+ }
}
# return
- xml_add_child(
+ xml <- xml_add_child(
cf_rule,
xml_child = iconset
)
+
+ if (!is.null(x14_ns)) {
+ extLst <- paste0(
+ "",
+ xml,
+ "",
+ sqref,
+ "",
+ ""
+ )
+
+ xml <- character()
+ attr(xml, "extLst") <- extLst
+
+ }
+
+ xml
}
#' @rdname cf_rules
diff --git a/R/utils.R b/R/utils.R
index 186d26fe0..60b73b631 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -454,7 +454,7 @@ determine_select_valid <- function(args, select = NULL) {
"`select` can't be \"row_names\" if `x` doesn't have row names.\n",
"Use `row_names = TRUE` inside `wb_dims()` to ensure row names are preserved.",
call. = FALSE
- )
+ )
} else if (isFALSE(args$col_names %||% TRUE) && identical(select, "col_names")) {
# If the default for col_names ever changes in openxlsx2, this would need adjustment.
stop(
@@ -655,7 +655,7 @@ wb_dims <- function(..., select = NULL) {
"Only `rows` and `cols` can be provided unnamed to `wb_dims()`.\n",
"You must name all other arguments.",
call. = FALSE
- )
+ )
}
if (len == 1 && all_args_unnamed) {
@@ -866,9 +866,9 @@ wb_dims <- function(..., select = NULL) {
if (select == "col_names") {
if (is.null(cols_arg) || length(cols_arg) %in% c(0, 1))
- ncol_to_span <- ncol(x)
- else
- ncol_to_span <- cols_arg
+ ncol_to_span <- ncol(x)
+ else
+ ncol_to_span <- cols_arg
nrow_to_span <- 1L
} else if (select == "row_names") {
ncol_to_span <- 1L
diff --git a/man/wb_add_conditional_formatting.Rd b/man/wb_add_conditional_formatting.Rd
index 1fcce9bbd..9ad946a68 100644
--- a/man/wb_add_conditional_formatting.Rd
+++ b/man/wb_add_conditional_formatting.Rd
@@ -101,9 +101,9 @@ unlisted parameters are ignored.
\verb{[params$reverse]}\cr If \code{TRUE}, the order is reversed. Default \code{FALSE}\cr\cr
\verb{[params$percent]}\cr If \code{TRUE}, uses percentage\cr\cr
\verb{[params$iconSet]}\cr Uses one of the implemented icon sets. Values must match the length of the icons
-in the set 3Arrows, 3ArrowsGray, 3Flags, 3Signs, 3Symbols, 3Symbols2, 3TrafficLights1, 3TrafficLights2,
-4Arrows, 4ArrowsGray, 4Rating, 4RedToBlack, 4TrafficLights, 5Arrows, 5ArrowsGray, 5Quarters, 5Rating. The
-default is 3TrafficLights1.
+in the set 3Arrows, 3ArrowsGray, 3Flags, 3Signs, 3Stars, 3Symbols, 3Symbols2, 3TrafficLights1, 3TrafficLights2,
+3Triangles, 4Arrows, 4ArrowsGray, 4Rating, 4RedToBlack, 4TrafficLights, 5Arrows, 5ArrowsGray, 5Boxes, 5Quarters, 5Rating.
+The default is 3TrafficLights1.
}
}
}
diff --git a/tests/testthat/test-conditional_formatting.R b/tests/testthat/test-conditional_formatting.R
index 927c6f486..dba20a5c2 100644
--- a/tests/testthat/test-conditional_formatting.R
+++ b/tests/testthat/test-conditional_formatting.R
@@ -564,14 +564,14 @@ test_that("extend dataBar tests", {
got <- wb$worksheets[[1]]$conditionalFormatting
expect_equal(exp, got)
- exp <- read_xml("
-
- A1:A11
- C1:C11
- E1:E11
- G1:G11
- I1:I11
- 05K1:K11
+ exp <- read_xml("
+
+ A1:A11
+ C1:C11
+ E1:E11
+ G1:G11
+ I1:I11
+ 05K1:K11
", pointer = FALSE)
got <- wb$worksheets[[1]]$extLst
expect_equal(exp, got)
@@ -911,3 +911,114 @@ test_that("remove conditional formatting works", {
got <- wb$worksheets[[4]]$conditionalFormatting
expect_equal(exp, got)
})
+
+test_that("conditional formatting works with slicers/timelines", {
+
+ # create a workbook with two sheets and some data
+ test_wb <- function() {
+ # prepare data
+ df <- data.frame(
+ AirPassengers = c(AirPassengers),
+ time = seq(from = as.Date("1949-01-01"), to = as.Date("1960-12-01"), by = "month"),
+ letters = letters[1:4]
+ )
+
+ # create workbook
+ wb <- wb_workbook()$
+ add_worksheet("pivot")$
+ add_worksheet("data")$
+ add_data(x = df)
+ }
+
+ # create data on sheet pivot with cf
+ test_cf <- function(wb) {
+ x <- matrix(
+ sample(c(0, 1), size = 20 * 10, replace = TRUE),
+ 20,
+ 10
+ )
+
+ wb$add_data(x = x, sheet = "pivot", colNames = FALSE, dims = wb_dims(x = x, from_row = 30))
+ wb$add_conditional_formatting(
+ dims = wb_dims(x = x, from_row = 30, cols = 1),
+ rule = c(.1, 0.1, 1),
+ type = "iconSet",
+ params = list(
+ percent = FALSE,
+ iconSet = "3Stars",
+ reverse = FALSE)
+ )
+ wb$add_conditional_formatting(
+ dims = wb_dims(x = x, from_row = 30, cols = 2),
+ rule = c(.1, 0.1, 1),
+ type = "iconSet",
+ params = list(
+ percent = FALSE,
+ iconSet = "3Stars",
+ reverse = FALSE)
+ )
+ wb
+ }
+
+ # add pt w/ slicer and timeline on sheet pivot
+ test_pt <- function(wb) {
+
+ # get pivot table data source
+ df <- wb_data(wb, sheet = "data")
+
+ # create pivot table
+ wb$add_pivot_table(
+ df,
+ sheet = "pivot",
+ rows = "time",
+ cols = "letters",
+ data = "AirPassengers",
+ pivot_table = "airpassengers",
+ params = list(
+ compact = FALSE, outline = FALSE, compact_data = FALSE,
+ row_grand_totals = FALSE, col_grand_totals = FALSE)
+ )
+
+ # add slicer
+ wb$add_slicer(
+ df,
+ dims = "E1:I7",
+ sheet = "pivot",
+ slicer = "letters",
+ pivot_table = "airpassengers",
+ params = list(choose = c(letters = 'x %in% c("a", "b")'))
+ )
+
+ # add timeline
+ wb$add_timeline(
+ df,
+ dims = "E9:I14",
+ sheet = "pivot",
+ timeline = "time",
+ pivot_table = "airpassengers",
+ params = list(
+ beg_date = as.Date("1954-01-01"),
+ end_date = as.Date("1961-01-01"),
+ choose_beg = as.Date("1957-01-01"),
+ choose_end = as.Date("1958-01-01"),
+ level = 0,
+ style = "TimeSlicerStyleLight2"
+ )
+ )
+ wb
+ }
+
+ wb <- test_wb()
+ wb <- test_cf(wb)
+ wb <- test_pt(wb)
+
+ expect_equal(3L, length(wb$worksheets[[1]]$extLst))
+
+ wb <- test_wb()
+ wb <- test_pt(wb)
+ wb <- test_cf(wb)
+
+ expect_equal(3L, length(wb$worksheets[[1]]$extLst))
+
+
+})