From eb32e15f372f44b98dcefe5bd0f12ffd33db5ce5 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Mon, 11 Dec 2023 16:12:24 +0100 Subject: [PATCH 1/9] [wb_comment] modify the background color --- R/baseXML.R | 4 ++-- R/class-comment.R | 20 ++++++++++++++++++-- R/class-workbook-wrappers.R | 2 +- R/class-workbook.R | 7 ++++++- man/comment_internal.Rd | 5 ++++- man/wb_add_comment.Rd | 2 +- man/wb_add_pivot_table.Rd | 3 +++ 7 files changed, 35 insertions(+), 8 deletions(-) diff --git a/R/baseXML.R b/R/baseXML.R index a3ca859d3..9e9210eb7 100644 --- a/R/baseXML.R +++ b/R/baseXML.R @@ -13,7 +13,7 @@ genBaseContent_Type <- function() { ) } -genBaseShapeVML <- function(clientData, id) { +genBaseShapeVML <- function(clientData, id, fillcolor) { if (grepl("visible", clientData, ignore.case = TRUE)) { visible <- "visible" } else { @@ -23,7 +23,7 @@ genBaseShapeVML <- function(clientData, id) { paste0( sprintf('', visible), + visibility:%s;mso-wrap-style:tight\' fillcolor="%s" o:insetmode="auto">', visible, fillcolor), ' diff --git a/R/class-comment.R b/R/class-comment.R index 5035a2565..4915ed18b 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -198,6 +198,7 @@ NULL #' @inheritParams wb_add_comment #' @param comment An object created by [create_comment()] #' @param row,col Row and column of the cell +#' @param color optional background color #' @keywords internal #' @export #' @inherit wb_add_comment examples @@ -207,7 +208,8 @@ write_comment <- function( col = NULL, row = NULL, comment, - dims = rowcol_to_dim(row, col) + dims = rowcol_to_dim(row, col), + color = NULL ) { # TODO add as method: wbWorkbook$addComment(); add param for replace? @@ -264,9 +266,23 @@ write_comment <- function( id <- 1025 + sum(lengths(wb$comments)) + fillcolor <- color %||% "#ffffe1" + # looks like vml accepts only "#RGB" and not "ARGB" + if (is_wbColour(fillcolor)) { + if (names(fillcolor) != "rgb") { + # actually there are more colors like: "lime [11]" and + # "infoBackground [80]" (the default). But no clue how + # these are created. + stop("fillcolor needs to be an RGB color") + } + + fillcolor <- paste0("#", substr(fillcolor, 3, 8)) + } + + # create new commment vml cd <- unapply(comment_list, "[[", "clientData") - vml_xml <- read_xml(genBaseShapeVML(cd, id), pointer = FALSE) + vml_xml <- read_xml(genBaseShapeVML(cd, id, fillcolor), pointer = FALSE) vml_comment <- '' vml_xml <- paste0(vml_xml, vml_comment) diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index 7d0324e9f..a1e2bd12c 100644 --- a/R/class-workbook-wrappers.R +++ b/R/class-workbook-wrappers.R @@ -3162,7 +3162,7 @@ wb_add_dxfs_style <- function( #' Add comment to worksheet #' #' @details -#' If applying a `comment` with a string, it will use [wb_comment()] default values. +#' If applying a `comment` with a string, it will use [wb_comment()] default values. If additional background colors are applied, RGB colors should be provided, either as hex code or with builtin R colors. The alpha chanel is ignored. #' #' @param wb A workbook object #' @param sheet A worksheet of the workbook diff --git a/R/class-workbook.R b/R/class-workbook.R index 788af6f04..a7e74cbcf 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -4135,6 +4135,7 @@ wbWorkbook <- R6::R6Class( col <- list(...)[["col"]] row <- list(...)[["row"]] + color <- list(...)[["color"]] if (!is.null(row) && !is.null(col)) { .Deprecated(old = "col/row", new = "dims", package = "openxlsx2") @@ -4145,11 +4146,15 @@ wbWorkbook <- R6::R6Class( comment <- wb_comment(text = comment, author = getOption("openxlsx2.creator")) } + if (!is.null(color) && !is_wbColour(color)) + stop("color needs to be a wb_color()") + write_comment( wb = self, sheet = sheet, comment = comment, - dims = dims + dims = dims, + color = color ) # has no use: xy invisible(self) diff --git a/man/comment_internal.Rd b/man/comment_internal.Rd index 8c6963d86..4b50137d3 100644 --- a/man/comment_internal.Rd +++ b/man/comment_internal.Rd @@ -12,7 +12,8 @@ write_comment( col = NULL, row = NULL, comment, - dims = rowcol_to_dim(row, col) + dims = rowcol_to_dim(row, col), + color = NULL ) remove_comment( @@ -35,6 +36,8 @@ remove_comment( \item{dims}{Optional row and column as spreadsheet dimension, e.g. "A1"} +\item{color}{optional background color} + \item{gridExpand}{If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) will be removed.} } diff --git a/man/wb_add_comment.Rd b/man/wb_add_comment.Rd index 73333dd00..21e68d706 100644 --- a/man/wb_add_comment.Rd +++ b/man/wb_add_comment.Rd @@ -27,7 +27,7 @@ The Workbook object, invisibly. Add comment to worksheet } \details{ -If applying a \code{comment} with a string, it will use \code{\link[=wb_comment]{wb_comment()}} default values. +If applying a \code{comment} with a string, it will use \code{\link[=wb_comment]{wb_comment()}} default values. If additional background colors are applied, RGB colors should be provided, either as hex code or with builtin R colors. The alpha chanel is ignored. } \examples{ wb <- wb_workbook() diff --git a/man/wb_add_pivot_table.Rd b/man/wb_add_pivot_table.Rd index 09034599a..7a09d8394 100644 --- a/man/wb_add_pivot_table.Rd +++ b/man/wb_add_pivot_table.Rd @@ -56,6 +56,9 @@ to ensure the function works. \code{runTotal}, \code{percentOfRow}, \code{percentOfCol}, \code{percentOfTotal}, \code{index}. The sheet will be empty unless it is opened in spreadsheet software. + +Find more details in the \href{https://janmarvin.github.io/ox2-book/chapters/openxlsx2_pivot_tables.html}{section about pivot tables} +in the openxlsx2 book. } \examples{ wb <- wb_workbook() \%>\% wb_add_worksheet() \%>\% wb_add_data(x = mtcars) From f926e6447bd3715e4182f3e0cb3d5c4b7694c4ff Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 00:40:22 +0100 Subject: [PATCH 2/9] return only one next_relship entry --- R/class-workbook.R | 2 +- tests/testthat/test-class-workbook.R | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/R/class-workbook.R b/R/class-workbook.R index a7e74cbcf..80ee1e48e 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -5064,7 +5064,7 @@ wbWorkbook <- R6::R6Class( } else { relship <- rbindlist(xml_attr(self$worksheets_rels[[sheet]], "Relationship")) relship$typ <- basename(relship$Type) - next_relship <- as.integer(gsub("\\D+", "", relship$Id)) + 1L + next_relship <- max(as.integer(gsub("\\D+", "", relship$Id))) + 1L has_no_drawing <- !any(relship$typ == "drawing") } diff --git a/tests/testthat/test-class-workbook.R b/tests/testthat/test-class-workbook.R index 7e58e2cc5..f408cbdcc 100644 --- a/tests/testthat/test-class-workbook.R +++ b/tests/testthat/test-class-workbook.R @@ -736,6 +736,24 @@ test_that("various image functions work as expected", { }) +test_that("image relships work with comment", { + + wb <- wb_workbook() + wb$add_worksheet("Sheet 1") + + c1 <- wb_comment(text = "this is a comment", author = "", visible = TRUE) + wb$add_comment(dims = "B12", comment = c1) + + img <- system.file("extdata", "einstein.jpg", package = "openxlsx2") + + wb$add_image("Sheet 1", dims = "C5", file = img, width = 6, height = 5) + + exp <- "" + got <- wb$worksheets[[1]]$drawing + expect_equal(exp, got) + +}) + test_that("workbook themes work", { wb <- wb_workbook()$add_worksheet() From e8e436f64141ee4f9b638a39617646ef3e630aaf Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 01:39:28 +0100 Subject: [PATCH 3/9] [add_image] move add_media() to own function --- R/class-workbook.R | 62 +++++++++++++++++++++++++++------------------- man/wbWorkbook.Rd | 18 ++++++++++++++ 2 files changed, 55 insertions(+), 25 deletions(-) diff --git a/R/class-workbook.R b/R/class-workbook.R index 80ee1e48e..bef732e32 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -4663,6 +4663,39 @@ wbWorkbook <- R6::R6Class( ## plots and images ---- + #' @description + #' Add media to worksheet + #' @param file file + add_media = function( + file + ) { + + # TODO tools::file_ext() ... + imageType <- regmatches(file, gregexpr("\\.[a-zA-Z]*$", file)) + imageType <- gsub("^\\.", "", imageType) + mediaNo <- length(self$media) + 1L + + ## update Content_Types + if (!any(grepl(stri_join("image/", imageType), self$Content_Types))) { + self$Content_Types <- + unique(c( + sprintf( + '', + imageType, + imageType + ), + self$Content_Types + )) + } + + ## write file path to media slot to copy across on save + tmp <- file + names(tmp) <- stri_join("image", mediaNo, ".", imageType) + self$append("media", tmp) + + invisible(self) + }, + #' @description #' Insert an image into a sheet #' @param file file @@ -4728,23 +4761,8 @@ wbWorkbook <- R6::R6Class( sheet <- private$get_sheet_index(sheet) - # TODO tools::file_ext() ... - imageType <- regmatches(file, gregexpr("\\.[a-zA-Z]*$", file)) - imageType <- gsub("^\\.", "", imageType) - mediaNo <- length(self$media) + 1L - - ## update Content_Types - if (!any(grepl(stri_join("image/", imageType), self$Content_Types))) { - self$Content_Types <- - unique(c( - sprintf( - '', - imageType, - imageType - ), - self$Content_Types - )) - } + self$add_media(file) + file <- names(self$media)[length(self$media)] if (length(self$worksheets[[sheet]]$relships$drawing)) { sheet_drawing <- self$worksheets[[sheet]]$relships$drawing @@ -4762,11 +4780,6 @@ wbWorkbook <- R6::R6Class( next_id <- "rId1" } - ## write file path to media slot to copy across on save - tmp <- file - names(tmp) <- stri_join("image", mediaNo, ".", imageType) - self$append("media", tmp) - pos <- '' drawingsXML <- stri_join( @@ -4807,10 +4820,9 @@ wbWorkbook <- R6::R6Class( self$drawings_rels[[sheet_drawing]] <- c( old_drawings_rels, sprintf( - '', + '', next_id, - mediaNo, - imageType + file ) ) diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index 0d6eb9c6e..df5ad4ad2 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -146,6 +146,7 @@ worksheet names.} \item \href{#method-wbWorkbook-remove_comment}{\code{wbWorkbook$remove_comment()}} \item \href{#method-wbWorkbook-add_thread}{\code{wbWorkbook$add_thread()}} \item \href{#method-wbWorkbook-add_conditional_formatting}{\code{wbWorkbook$add_conditional_formatting()}} +\item \href{#method-wbWorkbook-add_media}{\code{wbWorkbook$add_media()}} \item \href{#method-wbWorkbook-add_image}{\code{wbWorkbook$add_image()}} \item \href{#method-wbWorkbook-add_plot}{\code{wbWorkbook$add_plot()}} \item \href{#method-wbWorkbook-add_drawing}{\code{wbWorkbook$add_drawing()}} @@ -1716,6 +1717,23 @@ The \code{wbWorkbook} object } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-wbWorkbook-add_media}{}}} +\subsection{Method \code{add_media()}}{ +Add media to worksheet +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{wbWorkbook$add_media(file)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{file}}{file} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-wbWorkbook-add_image}{}}} \subsection{Method \code{add_image()}}{ From 6c0fd49043934ed04d444eeb42ce1a90509d60fc Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 01:51:01 +0100 Subject: [PATCH 4/9] [comment] allow background images --- R/baseXML.R | 19 ++++++++++++------- R/class-comment.R | 20 ++++++++++++++++++-- R/class-workbook.R | 4 +++- 3 files changed, 33 insertions(+), 10 deletions(-) diff --git a/R/baseXML.R b/R/baseXML.R index 9e9210eb7..5853a1bc5 100644 --- a/R/baseXML.R +++ b/R/baseXML.R @@ -13,23 +13,28 @@ genBaseContent_Type <- function() { ) } -genBaseShapeVML <- function(clientData, id, fillcolor) { +genBaseShapeVML <- function(clientData, id, fillcolor, rID) { if (grepl("visible", clientData, ignore.case = TRUE)) { visible <- "visible" } else { visible <- "hidden" } + if (is.null(rID)) + fill <- '' + else + fill <- '' + paste0( sprintf('', visible, fillcolor), - ' - - - -
- ', clientData, "" + fill, + ' + + +
+ ', clientData, "" ) } diff --git a/R/class-comment.R b/R/class-comment.R index 4915ed18b..928cfdd59 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -209,7 +209,8 @@ write_comment <- function( row = NULL, comment, dims = rowcol_to_dim(row, col), - color = NULL + color = NULL, + file = NULL ) { # TODO add as method: wbWorkbook$addComment(); add param for replace? @@ -279,10 +280,25 @@ write_comment <- function( fillcolor <- paste0("#", substr(fillcolor, 3, 8)) } + rID <- NULL + if (!is.null(file)) { + wb$add_media(file = file) + file <- names(wb$media)[length(wb$media)] + rID <- paste0("rId", length(wb$vml_rels) + 1L) + + wb$append( + "vml_rels", + sprintf( + '', + rID, + file + ) + ) + } # create new commment vml cd <- unapply(comment_list, "[[", "clientData") - vml_xml <- read_xml(genBaseShapeVML(cd, id, fillcolor), pointer = FALSE) + vml_xml <- read_xml(genBaseShapeVML(cd, id, fillcolor, rID), pointer = FALSE) vml_comment <- '' vml_xml <- paste0(vml_xml, vml_comment) diff --git a/R/class-workbook.R b/R/class-workbook.R index bef732e32..3c5addd91 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -4136,6 +4136,7 @@ wbWorkbook <- R6::R6Class( col <- list(...)[["col"]] row <- list(...)[["row"]] color <- list(...)[["color"]] + file <- list(...)[["file"]] if (!is.null(row) && !is.null(col)) { .Deprecated(old = "col/row", new = "dims", package = "openxlsx2") @@ -4154,7 +4155,8 @@ wbWorkbook <- R6::R6Class( sheet = sheet, comment = comment, dims = dims, - color = color + color = color, + file = file ) # has no use: xy invisible(self) From 323709024e8134bbcad3d29aa90ea4fc1aaacb54 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 02:46:02 +0100 Subject: [PATCH 5/9] [comments] extend lists to the needed range --- R/baseXML.R | 2 +- R/class-comment.R | 41 +++++++++++++++++++++++++++++++++-------- R/class-workbook.R | 2 +- 3 files changed, 35 insertions(+), 10 deletions(-) diff --git a/R/baseXML.R b/R/baseXML.R index 5853a1bc5..5bed4b3ed 100644 --- a/R/baseXML.R +++ b/R/baseXML.R @@ -23,7 +23,7 @@ genBaseShapeVML <- function(clientData, id, fillcolor, rID) { if (is.null(rID)) fill <- '' else - fill <- '' + fill <- sprintf('', rID) paste0( sprintf('', - rID, - file - ) + vml_relship <- sprintf( + '', + rID, + file ) } + # create new commment vml cd <- unapply(comment_list, "[[", "clientData") vml_xml <- read_xml(genBaseShapeVML(cd, id, fillcolor, rID), pointer = FALSE) @@ -342,10 +340,25 @@ write_comment <- function( ), xml_children = vml_xml ) + if (length(wb$vml) == 0) { + wb$vml <- list() + } wb$vml <- c(wb$vml, vml_xml) wb$worksheets[[sheet]]$relships$vmlDrawing <- next_id - + if (!is.null(rID)) { + if (length(wb$vml_rels) == 0) { + wb$vml_rels <- list() + } + if (length(wb$vml_rels) < next_id) { + wb$vml_rels <- wb$vml_rels[seq_len(next_id)] + } + + wb$vml_rels[[next_id]] <- append( + wb$vml_rels[[next_id]], + vml_relship + ) + } # TODO hardcoded 2. Marvin fears that this is not good enough wb$worksheets[[sheet]]$legacyDrawing <- sprintf('', next_rid) @@ -353,6 +366,12 @@ write_comment <- function( } else { vml_id <- wb$worksheets[[sheet]]$relships$vmlDrawing wb$vml[[vml_id]] <- xml_add_child(wb$vml[[vml_id]], vml_xml) + if (!is.null(rID)) { + wb$vml_rels[[vml_id]] <- append( + wb$vml_rels[[vml_id]], + vml_relship + ) + } } wb$worksheets_rels[[sheet]] <- c( @@ -366,6 +385,12 @@ write_comment <- function( } else { vml_id <- wb$worksheets[[sheet]]$relships$vmlDrawing wb$vml[[vml_id]] <- xml_add_child(wb$vml[[vml_id]], vml_xml) + if (!is.null(rID)) { + wb$vml_rels[[vml_id]] <- append( + wb$vml_rels[[vml_id]], + vml_relship + ) + } } cmmnt_id <- wb$worksheets[[sheet]]$relships$comments diff --git a/R/class-workbook.R b/R/class-workbook.R index 3c5addd91..01cdbb2ec 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -7770,7 +7770,7 @@ wbWorkbook <- R6::R6Class( fl = file.path(dir, sprintf("vmlDrawing%s.vml", i)) ) - if (!is.null(unlist(self$vml_rels)) && length(self$vml_rels) >= i && self$vml_rels[[i]] != "") { + if (!is.null(unlist(self$vml_rels)) && length(self$vml_rels) >= i && !all(self$vml_rels[[i]] == "")) { write_file( head = '', body = pxml(self$vml_rels[[i]]), From 504930ca223f8c58991e146082b0ef4f889bc189 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 02:49:47 +0100 Subject: [PATCH 6/9] update roxygen --- R/class-comment.R | 1 + man/comment_internal.Rd | 5 ++++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/R/class-comment.R b/R/class-comment.R index a8a9712ee..4fdbdb5d6 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -199,6 +199,7 @@ NULL #' @param comment An object created by [create_comment()] #' @param row,col Row and column of the cell #' @param color optional background color +#' @param file optional background image (file extension must be png or jpeg) #' @keywords internal #' @export #' @inherit wb_add_comment examples diff --git a/man/comment_internal.Rd b/man/comment_internal.Rd index 4b50137d3..6319049a8 100644 --- a/man/comment_internal.Rd +++ b/man/comment_internal.Rd @@ -13,7 +13,8 @@ write_comment( row = NULL, comment, dims = rowcol_to_dim(row, col), - color = NULL + color = NULL, + file = NULL ) remove_comment( @@ -38,6 +39,8 @@ remove_comment( \item{color}{optional background color} +\item{file}{optional background image (file extension must be png or jpeg)} + \item{gridExpand}{If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) will be removed.} } From beee3160b131497aff169f5a193d13c9299ab5aa Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 18:13:08 +0100 Subject: [PATCH 7/9] [add_media] move to private --- R/class-comment.R | 2 +- R/class-workbook.R | 65 ++++++++++++++++++++++------------------------ man/wbWorkbook.Rd | 18 ------------- 3 files changed, 32 insertions(+), 53 deletions(-) diff --git a/R/class-comment.R b/R/class-comment.R index 4fdbdb5d6..6b369382c 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -283,7 +283,7 @@ write_comment <- function( rID <- NULL if (!is.null(file)) { - wb$add_media(file = file) + wb$.__enclos_env__$private$add_media(file = file) file <- names(wb$media)[length(wb$media)] rID <- paste0("rId", length(wb$vml_rels) + 1L) diff --git a/R/class-workbook.R b/R/class-workbook.R index 01cdbb2ec..bfcf771b8 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -4665,39 +4665,6 @@ wbWorkbook <- R6::R6Class( ## plots and images ---- - #' @description - #' Add media to worksheet - #' @param file file - add_media = function( - file - ) { - - # TODO tools::file_ext() ... - imageType <- regmatches(file, gregexpr("\\.[a-zA-Z]*$", file)) - imageType <- gsub("^\\.", "", imageType) - mediaNo <- length(self$media) + 1L - - ## update Content_Types - if (!any(grepl(stri_join("image/", imageType), self$Content_Types))) { - self$Content_Types <- - unique(c( - sprintf( - '', - imageType, - imageType - ), - self$Content_Types - )) - } - - ## write file path to media slot to copy across on save - tmp <- file - names(tmp) <- stri_join("image", mediaNo, ".", imageType) - self$append("media", tmp) - - invisible(self) - }, - #' @description #' Insert an image into a sheet #' @param file file @@ -4763,7 +4730,7 @@ wbWorkbook <- R6::R6Class( sheet <- private$get_sheet_index(sheet) - self$add_media(file) + private$add_media(file) file <- names(self$media)[length(self$media)] if (length(self$worksheets[[sheet]]$relships$drawing)) { @@ -7729,6 +7696,36 @@ wbWorkbook <- R6::R6Class( invisible(self) }, + add_media = function( + file + ) { + + # TODO tools::file_ext() ... + imageType <- regmatches(file, gregexpr("\\.[a-zA-Z]*$", file)) + imageType <- gsub("^\\.", "", imageType) + mediaNo <- length(self$media) + 1L + + ## update Content_Types + if (!any(grepl(stri_join("image/", imageType), self$Content_Types))) { + self$Content_Types <- + unique(c( + sprintf( + '', + imageType, + imageType + ), + self$Content_Types + )) + } + + ## write file path to media slot to copy across on save + tmp <- file + names(tmp) <- stri_join("image", mediaNo, ".", imageType) + self$append("media", tmp) + + invisible(self) + }, + get_drawingsref = function() { has_drawing <- which(grepl("drawings", self$worksheets_rels)) diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index df5ad4ad2..0d6eb9c6e 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -146,7 +146,6 @@ worksheet names.} \item \href{#method-wbWorkbook-remove_comment}{\code{wbWorkbook$remove_comment()}} \item \href{#method-wbWorkbook-add_thread}{\code{wbWorkbook$add_thread()}} \item \href{#method-wbWorkbook-add_conditional_formatting}{\code{wbWorkbook$add_conditional_formatting()}} -\item \href{#method-wbWorkbook-add_media}{\code{wbWorkbook$add_media()}} \item \href{#method-wbWorkbook-add_image}{\code{wbWorkbook$add_image()}} \item \href{#method-wbWorkbook-add_plot}{\code{wbWorkbook$add_plot()}} \item \href{#method-wbWorkbook-add_drawing}{\code{wbWorkbook$add_drawing()}} @@ -1717,23 +1716,6 @@ The \code{wbWorkbook} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-wbWorkbook-add_media}{}}} -\subsection{Method \code{add_media()}}{ -Add media to worksheet -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{wbWorkbook$add_media(file)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{file}}{file} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-wbWorkbook-add_image}{}}} \subsection{Method \code{add_image()}}{ From c2b5c8620ada172d729c00f4fada2ab69b19cf1d Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 18:14:26 +0100 Subject: [PATCH 8/9] [tests] add basic test --- tests/testthat/test-class-comment.R | 40 +++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/tests/testthat/test-class-comment.R b/tests/testthat/test-class-comment.R index 74266a10b..a665b20e1 100644 --- a/tests/testthat/test-class-comment.R +++ b/tests/testthat/test-class-comment.R @@ -296,3 +296,43 @@ test_that("thread option works", { expect_equal(exp, got) }) + +test_that("background images work", { + + wb <- wb_workbook() + wb$add_worksheet("Sheet 1") + + # file extension must be png or jpeg, not jpg? + tmp <- tempfile(fileext = ".png") + png(file = tmp, bg = "transparent") + plot(1:10) + rect(1, 5, 3, 7, col = "white") + dev.off() + + # write comment without author + c1 <- wb_comment(text = "this is a comment", author = "", visible = TRUE) + wb$add_comment(dims = "B12", comment = c1, file = tmp) + + wb$add_worksheet() + wb$add_comment(dims = "B12", comment = c1) + + wb$add_worksheet() + + # file extension must be png or jpeg, not jpg? + tmp2 <- tempfile(fileext = ".png") + png(file = tmp2, bg = "transparent") + barplot(1:10) + dev.off() + + # write comment without author + c1 <- wb_comment(text = "this is a comment", author = "", visible = TRUE) + wb$add_comment(dims = "G12", comment = c1, file = tmp2) + wb$add_comment(dims = "G12", sheet = 1, comment = c1, file = tmp2) + + expect_equal(3, length(wb$vml)) + expect_equal(3, length(wb$vml_rels)) + expect_equal(2, length(wb$vml_rels[[1]])) + expect_true(is.null(wb$vml_rels[[2]])) + expect_equal(1, length(wb$vml_rels[[3]])) + +}) From aecda612a0cc97b8e8abba8a011d2ab0ec213bfb Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 12 Dec 2023 18:44:16 +0100 Subject: [PATCH 9/9] update NEWS --- NEWS.md | 4 ++++ R/class-workbook.R | 8 ++++---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index f6a1c72d1..d3cdbaf3a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # openxlsx2 (development version) +## New features + +* Allow further modifications of comments. The background can now be filled with a color or an image. [870](https://github.com/JanMarvin/openxlsx2/pull/870) + ## Fixes * `wb_add_ignore_error()` now returns a `wbWorkbook` diff --git a/R/class-workbook.R b/R/class-workbook.R index bfcf771b8..c14e4f040 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -4133,10 +4133,10 @@ wbWorkbook <- R6::R6Class( ... ) { - col <- list(...)[["col"]] - row <- list(...)[["row"]] - color <- list(...)[["color"]] - file <- list(...)[["file"]] + col <- list(...)[["col"]] + row <- list(...)[["row"]] + color <- list(...)[["color"]] %||% list(...)[["colour"]] + file <- list(...)[["file"]] if (!is.null(row) && !is.null(col)) { .Deprecated(old = "col/row", new = "dims", package = "openxlsx2")