diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index 25ecadc7b..c49b46b42 100644 --- a/R/class-workbook-wrappers.R +++ b/R/class-workbook-wrappers.R @@ -734,6 +734,13 @@ wb_add_worksheet <- function( #' formulas, charts, pivot tables, etc. may not be updated. Some elements like #' named ranges and slicers cannot be cloned yet. #' +#' Cloning from another workbook is still an experimental feature and might not +#' work reliably. Cloning data, media, charts and tables should work. Slicers +#' and pivot tables as well as everything everything relying on dxfs styles +#' (e.g. custom table styles and conditional formatting) is currently not +#' implemented. +#' Formula references are not updated to reflect interactions between workbooks. +#' #' @param wb A `wbWorkbook` object #' @param old Name of existing worksheet to copy #' @param new Name of the new worksheet to create @@ -752,6 +759,23 @@ wb_add_worksheet <- function( #' wb$clone_worksheet("Sheet 1", new = "Sheet 2") #' # Take advantage of waiver functions #' wb$clone_worksheet(old = "Sheet 1") +#' +#' ## cloning from another workbook +#' +#' # create a workbook +#' wb <- wb_workbook()$ +#' add_worksheet("NOT_SUM")$ +#' add_data(x = head(iris))$ +#' add_fill(dims = "A1:B2", color = wb_color("yellow"))$ +#' add_border(dims = "B2:C3") +#' +#' # we will clone this styled chart into another workbook +#' fl <- system.file("extdata", "oxlsx2_sheet.xlsx", package = "openxlsx2") +#' wb_from <- wb_load(fl) +#' +#' # clone styles and shared strings +#' wb$clone_worksheet(old = "SUM", new = "SUM", from = wb_from) +#' wb_clone_worksheet <- function(wb, old = current_sheet(), new = next_sheet(), from = NULL) { assert_workbook(wb) wb$clone()$clone_worksheet(old = old, new = new, from = from) diff --git a/R/class-workbook.R b/R/class-workbook.R index 3d1edaddc..afd2158da 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -756,10 +756,12 @@ wbWorkbook <- R6::R6Class( clone_worksheet = function(old = current_sheet(), new = next_sheet(), from = NULL) { if (is.null(from)) { - from <- self$clone() + from <- self$clone() external_wb <- FALSE + suffix <- "_n" } else { external_wb <- TRUE + suffix <- "" assert_workbook(from) } @@ -803,12 +805,6 @@ wbWorkbook <- R6::R6Class( ## append to worksheets list self$append("worksheets", from$worksheets[[old]]$clone(deep = TRUE)) - # ## TODO why do we have sheet names all over the place ... - # private$original_sheet_names <- c( - # private$original_sheet_names, - # new - # ) - ## update content_tyes ## add a drawing.xml for the worksheet # FIXME only add what is needed. If no previous drawing is found, don't @@ -936,7 +932,7 @@ wbWorkbook <- R6::R6Class( # but the xlsx file is not broken slicer_child <- xml_node(cloned_slicers, "slicers", "slicer") slicer_df <- rbindlist(xml_attr(slicer_child, "slicer"))[c("name", "cache", "caption", "rowHeight")] - slicer_df$name <- paste0(slicer_df$name, "_n") + slicer_df$name <- paste0(slicer_df$name, suffix) slicer_child <- df_to_xml("slicer", slicer_df) self$slicers[[newid]] <- xml_node_create("slicers", slicer_child, slicer_attr[[1]]) @@ -1012,6 +1008,10 @@ wbWorkbook <- R6::R6Class( ## and in the worksheets[]$tableParts list. We also need to adjust the ## worksheets_rels and set the content type for the new table + ## TODO need to collect table dxfs styles, apply them to the workbook + ## and update the table.xml file with the new dxfs ids. Maybe we can + ## set these to the default value 0 to avoid broken spreadsheets + # if we have tables to clone, remove every table referece from Relationship rid <- as.integer(sub("\\D+", "", get_relship_id(obj = self$worksheets_rels[[newSheetIndex]], x = "table"))) @@ -1029,23 +1029,27 @@ wbWorkbook <- R6::R6Class( else newid <- 1L - - if (any(stri_join(tbls$tab_name, "_n") %in% self$tables$tab_name)) { + if (any(stri_join(tbls$tab_name, suffix) %in% self$tables$tab_name)) { tbls$tab_name <- stri_join(tbls$tab_name, "1") } # add _n to all table names found - tbls$tab_name <- stri_join(tbls$tab_name, "_n") + tbls$tab_name <- stri_join(tbls$tab_name, suffix) tbls$tab_sheet <- newSheetIndex # modify tab_xml with updated name, displayName and id - tbls$tab_xml <- vapply(seq_len(nrow(tbls)), function(x) { - xml_attr_mod(tbls$tab_xml[x], - xml_attributes = c(name = tbls$tab_name[x], - displayName = tbls$tab_name[x], - id = newid[x]) - ) - }, - NA_character_ + tbls$tab_xml <- vapply( + seq_len(nrow(tbls)), + function(x) { + xml_attr_mod( + tbls$tab_xml[x], + xml_attributes = c( + name = tbls$tab_name[x], + displayName = tbls$tab_name[x], + id = newid[x] + ) + ) + }, + NA_character_ ) # add new tables to old tables @@ -1081,15 +1085,79 @@ wbWorkbook <- R6::R6Class( if (external_wb) { - # FIXME we copy all references from a workbook over to this workbook. - # This is not going to work, if multiple images from different - # workbooks are used. The references are called imageX.jpg and will - # overwrite each other. This needs a better solution if (length(from$media)) { + + # TODO there might be other content types like png, wav etc. if (!any(grepl("Default Extension=\"jpg\"", self$Content_Types))) { self$append("Content_Types", "") } - self$media <- append(self$media, from$media) + + # we pick up the drawing relationship. This is something like: "../media/image1.jpg" + # because we might end up with multiple files with similar names, we have to rename + # the media file and update the drawing relationship + drels <- rbindlist(xml_attr(self$drawings_rels[[new_drawing_sheet]], "Relationship")) + if (ncol(drels) && any(basename(drels$Type) == "image")) { + sel <- basename(drels$Type) == "image" + targets <- basename2(drels[sel]$Target) + media_names <- from$media[grepl(targets, names(from$media))] + + onams <- names(media_names) + mnams <- vector("character", length(onams)) + next_ids <- length(names(self$media)) + seq_along(mnams) + + # we might have multiple media references on a sheet + for (i in seq_along(onams)) { + media_id <- as.integer(gsub("\\D+", "", onams[i])) + # take filetype + number + file extension + # e.g. "image5.jpg" and return "image2.jpg" + mnams[i] <- gsub("(\\d+)\\.(\\w+)", paste0(next_ids[i], ".\\2"), onams[i]) + } + names(media_names) <- mnams + + # update relationship + self$drawings_rels[[new_drawing_sheet]] <- gsub( + pattern = onams, + replacement = mnams, + x = self$drawings_rels[[new_drawing_sheet]], + ) + + # append media + self$media <- append(self$media, media_names) + } + } + + + wrels <- rbindlist(xml_attr(self$worksheets_rels[[newSheetIndex]], "Relationship")) + if (ncol(wrels) && any(sel <- basename(wrels$Type) == "pivotTable")) { + ## Need to collect the pivot table xml below, apply it to the workbook + ## and update the references with the new IDs + # pt <- which(sel) + # self$pivotTables <- from$pivotTables[pt] + # self$pivotTables.xml.rels <- from$pivotTables.xml.rels[pt] + # self$pivotDefinitions <- from$pivotDefinitions[pt] + # self$pivotDefinitionsRels <- from$pivotDefinitionsRels[pt] + # self$pivotRecords <- from$pivotRecords[pt] + # + # self$append( + # "workbook.xml.rels", + # "" + # ) + # + # self$append( + # "Content_Types", + # c( + # "", + # "", + # "" + # ) + # ) + # + # self$workbook$pivotCaches <- "" + # self$styles_mgr$styles$dxfs <- from$styles_mgr$styles$dxfs + # self$styles_mgr$styles$cellStyles <- from$styles_mgr$styles$cellStyles + # self$styles_mgr$styles$cellStyleXfs <- from$styles_mgr$styles$cellStyleXfs + + warning("Cloning pivot tables over workbooks is not yet supported.") } # update sheet styles @@ -1105,8 +1173,6 @@ wbWorkbook <- R6::R6Class( clone_shared_strings(from, old, self, newSheetIndex) } - # message("cloned worksheet into workbook") - invisible(self) }, diff --git a/R/helper-functions.R b/R/helper-functions.R index c4396bcf6..e94eac201 100644 --- a/R/helper-functions.R +++ b/R/helper-functions.R @@ -1403,13 +1403,13 @@ set_cellstyles <- function(wb, style) { } has_fill <- FALSE - if (length(style[[i]]$fill_xml)) { + if (length(style[[i]]$fill_xml) && style[[i]]$fill_xml != wb$styles_mgr$styles$fills[1]) { has_fill <- TRUE wb$styles_mgr$add(style[[i]]$fill_xml, session_id) } has_font <- FALSE - if (length(style[[i]]$font_xml)) { + if (length(style[[i]]$font_xml) && style[[i]]$font_xml != wb$styles_mgr$styles$fonts[1]) { has_font <- TRUE wb$styles_mgr$add(style[[i]]$font_xml, session_id) } @@ -1417,7 +1417,16 @@ set_cellstyles <- function(wb, style) { has_numfmt <- FALSE if (length(style[[i]]$numfmt_xml)) { has_numfmt <- TRUE - wb$styles_mgr$add(style[[i]]$numfmt_xml, session_id) + numfmt_xml <- style[[i]]$numfmt_xml + # assuming all numfmts with ids >= 164. + # We have to create unique numfmt ids when cloning numfmts. Otherwise one + # ids could point to more than one format code and the output would look + # broken. + fmtCode <- xml_attr(numfmt_xml, "numFmt")[[1]][["formatCode"]] + next_id <- max(163L, as.integer(wb$styles_mgr$get_numfmt()$id)) + 1L + numfmt_xml <- create_numfmt(numFmtId = next_id, formatCode = fmtCode) + + wb$styles_mgr$add(numfmt_xml, session_id) } ## create new xf_df. This has to reference updated style ids @@ -1499,4 +1508,6 @@ clone_shared_strings <- function(wb_old, old, wb_new, new) { cc$v[cc$c_t == "s"] <- new_ids wb_new$worksheets[[sheet_id]]$sheet_data$cc <- cc + # print(sprintf("cloned: %s", length(new_ids))) + } diff --git a/inst/WORDLIST b/inst/WORDLIST index 6ae19756b..7e24d3ed2 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -125,7 +125,6 @@ greatful gridLines hasDrawing hdpi -headFoot headerRow hms lastColumn @@ -224,7 +223,6 @@ tableStyle tablename textLength th -threadComments totalRow totalsRowCount twoCellAnchor diff --git a/man/wb_clone_worksheet.Rd b/man/wb_clone_worksheet.Rd index 897d3fc28..1abb6d161 100644 --- a/man/wb_clone_worksheet.Rd +++ b/man/wb_clone_worksheet.Rd @@ -24,6 +24,13 @@ Create a copy of a worksheet in the same \code{wbWorkbook} object. Cloning is possible only to a limited extent. References to sheet names in formulas, charts, pivot tables, etc. may not be updated. Some elements like named ranges and slicers cannot be cloned yet. + +Cloning from another workbook is still an experimental feature and might not +work reliably. Cloning data, media, charts and tables should work. Slicers +and pivot tables as well as everything everything relying on dxfs styles +(e.g. custom table styles and conditional formatting) is currently not +implemented. +Formula references are not updated to reflect interactions between workbooks. } \examples{ # Create a new workbook @@ -34,6 +41,23 @@ wb$add_worksheet("Sheet 1") wb$clone_worksheet("Sheet 1", new = "Sheet 2") # Take advantage of waiver functions wb$clone_worksheet(old = "Sheet 1") + +## cloning from another workbook + +# create a workbook +wb <- wb_workbook()$ +add_worksheet("NOT_SUM")$ + add_data(x = head(iris))$ + add_fill(dims = "A1:B2", color = wb_color("yellow"))$ + add_border(dims = "B2:C3") + +# we will clone this styled chart into another workbook +fl <- system.file("extdata", "oxlsx2_sheet.xlsx", package = "openxlsx2") +wb_from <- wb_load(fl) + +# clone styles and shared strings +wb$clone_worksheet(old = "SUM", new = "SUM", from = wb_from) + } \seealso{ Other workbook wrappers: diff --git a/tests/testthat/test-cloneWorksheet.R b/tests/testthat/test-cloneWorksheet.R index 49e919c04..c86a378de 100644 --- a/tests/testthat/test-cloneWorksheet.R +++ b/tests/testthat/test-cloneWorksheet.R @@ -144,3 +144,99 @@ test_that("wb_set_header_footer() works", { expect_equal(exp, got) }) + +test_that("cloning from workbooks works", { + + ## FIXME these tests should be improved, right now they only check the + ## existance of a worksheet + + # create a second workbook + wb <- wb_workbook()$ + add_worksheet("NOT_SUM")$ + add_data(x = head(iris))$ + add_fill(dims = "A1:B2", color = wb_color("yellow"))$ + add_border(dims = "B2:C3") + + ## styled cells + fl <- system.file("extdata", "oxlsx2_sheet.xlsx", package = "openxlsx2") + wb_in <- wb_load(fl) + + wb$clone_worksheet(old = "SUM", new = "SUM", from = wb_in) + exp <- c("NOT_SUM", "SUM") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + wb$clone_worksheet(old = "SUM", new = "SUM_clone") + exp <- c("NOT_SUM", "SUM", "SUM_clone") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + wb$clone_worksheet(old = "SUM", new = "SUM2", from = wb_in) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + ## clone table + + wb_in <- wb_workbook()$add_worksheet("tab")$add_data_table(x = mtcars) + + wb$clone_worksheet(old = "tab", new = "tab", from = wb_in) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2", "tab") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + # clone it twice + expect_warning(wb$clone_worksheet(old = "tab", new = "tab", from = wb_in)) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2", "tab", "tab (1)") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + ## clone a chart + + skip_if_not_installed("mschart") + library(mschart) + ## Add mschart to worksheet (adds data and chart) + scatter <- ms_scatterchart(data = iris, x = "Sepal.Length", y = "Sepal.Width", group = "Species") + scatter <- chart_settings(scatter, scatterstyle = "marker") + + wb_ms <- wb_workbook() %>% + wb_add_worksheet("chart") %>% + wb_add_mschart(dims = "F4:L20", graph = scatter) + + wb$clone_worksheet(old = "chart", new = "chart_1", from = wb_ms) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2", "tab", "tab (1)", "chart_1") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + wb$clone_worksheet(old = "chart", new = "chart_2", from = wb_ms) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2", "tab", "tab (1)", "chart_1", "chart_2") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + ## clone images + + img <- system.file("extdata", "einstein.jpg", package = "openxlsx2") + + wb_img <- wb_workbook()$ + add_worksheet()$ + add_image("Sheet 1", dims = "C5", file = img, width = 6, height = 5) + + wb$clone_worksheet(old = "Sheet 1", new = "img", from = wb_img) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2", "tab", "tab (1)", "chart_1", "chart_2", "img") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + wb$clone_worksheet(old = "Sheet 1", new = "img2", from = wb_img) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2", "tab", "tab (1)", "chart_1", "chart_2", "img", "img2") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + + ## clone drawing, borders function and shared strings + wb_ex <- wb_load(testfile_path("loadExample.xlsx")) + + wb$clone_worksheet(old = "testing", new = "test", from = wb_ex) + exp <- c("NOT_SUM", "SUM", "SUM_clone", "SUM2", "tab", "tab (1)", "chart_1", "chart_2", "img", "img2", "test") + got <- wb$get_sheet_names() %>% unname() + expect_equal(exp, got) + +})