diff --git a/R/class-workbook.R b/R/class-workbook.R index 8dba29ae0..022e170bb 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -1960,6 +1960,44 @@ wbWorkbook <- R6::R6Class( invisible(self) }, + #' @description add pivot table + #' @return The `wbWorkbook` object + remove_slicer = function(sheet = current_sheet()) { + sheet <- private$get_sheet_index(sheet) + + # get indices + slicer_id <- self$worksheets[[sheet]]$relships$slicer + cache_names <- unname(sapply(xml_attr(self$slicers[slicer_id], "slicers", "slicer"), "[", "cache")) + slicer_names <- unname(sapply(xml_attr(self$slicerCaches, "slicerCacheDefinition"), "[", "name")) + slicer_cache_id <- which(cache_names %in% slicer_names) + + # strings to grep + slicer_xml <- sprintf("slicers/slicer%s.xml", slicer_id) + caches_xml <- sprintf("slicerCaches/slicerCache%s.xml", slicer_cache_id) + + # empty slicer + self$slicers[slicer_id] <- "" + # empty slicerCache + self$slicerCaches[slicer_cache_id] <- "" + + # remove slicer cache relship + self$worksheets[[sheet]]$relships$slicer <- integer() + # 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) + extLst <- xml_rm_child(self$worksheets[[sheet]]$extLst[is_ext_x14], xml_child = "x14:slicerList") + self$worksheets[[sheet]]$extLst[is_ext_x14] <- extLst + + # clear workbook.xml.rels + self$workbook.xml.rels <- self$workbook.xml.rels[!grepl(paste0(caches_xml, collapse = "|"), self$workbook.xml.rels)] + + # clear Content_Types + self$Content_Types <- self$Content_Types[!grepl(paste0(c(slicer_xml, caches_xml), collapse = "|"), self$Content_Types)] + + invisible(self) + }, + #' @description add pivot table #' @param x a wb_data object #' @param dims the worksheet cell where the pivot table is placed @@ -2662,15 +2700,16 @@ wbWorkbook <- R6::R6Class( slicersDir <- dir_create(tmpDir, "xl", "slicers") slicerCachesDir <- dir_create(tmpDir, "xl", "slicerCaches") - slicer <- self$slicers[self$slicers != ""] - for (i in seq_along(slicer)) { + slicer_id <- which(self$slicers != "") + for (i in slicer_id) { write_file( - body = slicer[i], + body = self$slicers[i], fl = file.path(slicersDir, sprintf("slicer%s.xml", i)) ) } - for (i in seq_along(self$slicerCaches)) { + caches_id <- which(self$slicerCaches != "") + for (i in caches_id) { write_file( body = self$slicerCaches[[i]], fl = file.path(slicerCachesDir, sprintf("slicerCache%s.xml", i)) diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index 1797ced2d..d2909a357 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -164,6 +164,7 @@ worksheet names.} \item \href{#method-wbWorkbook-add_data_table}{\code{wbWorkbook$add_data_table()}} \item \href{#method-wbWorkbook-add_pivot_table}{\code{wbWorkbook$add_pivot_table()}} \item \href{#method-wbWorkbook-add_slicer}{\code{wbWorkbook$add_slicer()}} +\item \href{#method-wbWorkbook-remove_slicers}{\code{wbWorkbook$remove_slicers()}} \item \href{#method-wbWorkbook-add_timeline}{\code{wbWorkbook$add_timeline()}} \item \href{#method-wbWorkbook-add_formula}{\code{wbWorkbook$add_formula()}} \item \href{#method-wbWorkbook-add_style}{\code{wbWorkbook$add_style()}} @@ -748,6 +749,26 @@ The \code{wbWorkbook} object } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-wbWorkbook-remove_slicers}{}}} +\subsection{Method \code{remove_slicers()}}{ +add pivot table +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{wbWorkbook$remove_slicers(sheet = current_sheet())}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{sheet}}{The name of the sheet} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{wbWorkbook} object +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-wbWorkbook-add_timeline}{}}} \subsection{Method \code{add_timeline()}}{ diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index e68bd28ea..bd6cb3901 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -600,6 +600,98 @@ test_that("writing slicers works", { }) + +test_that("removing slicers works", { + + ### 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("pivot2")$ + add_worksheet("data")$ + add_data(x = df) + + ### get pivot table data source + df <- wb_data(wb, sheet = "data") + + ### first sheet + # 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")')) + ) + + wb$add_slicer( + df, + dims = "E8:I15", + sheet = "pivot", + slicer = "time", + pivot_table = "airpassengers" + ) + + ### second sheet + # create pivot table + wb$add_pivot_table( + df, + sheet = "pivot2", + rows = "time", + cols = "letters", + data = "AirPassengers", + pivot_table = "airpassengers2", + 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 = "pivot2", + slicer = "letters", + pivot_table = "airpassengers2", + params = list(choose = c(letters = 'x %in% c("a", "b")')) + ) + + wb$add_slicer( + df, + dims = "E8:I15", + sheet = "pivot2", + slicer = "time", + pivot_table = "airpassengers2" + ) + + ### remove slicer + wb$remove_slicer(sheet = "pivot") + + temp <- temp_xlsx() + expect_silent(wb$save(temp)) # no warning, all files written as expected + +}) + test_that("writing na.strings = NULL works", { # write na.strings = na_strings()