[wb_comment] modify the background color

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('<v:shape id="_x0000_s%s" type="#_x0000_t202" style=\'position:absolute;', id),
     sprintf('margin-left:107.25pt;margin-top:172.5pt;width:147pt;height:96pt;z-index:1;
-          visibility:%s;mso-wrap-style:tight\' fillcolor="#ffffe1" o:insetmode="auto">', visible),
+          visibility:%s;mso-wrap-style:tight\' fillcolor="%s" o:insetmode="auto">', visible, fillcolor),
     '<v:fill color2="#ffffe1"/>
             <v:shadow color="black" obscured="t"/>
             <v:path o:connecttype="none"/>

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 <- '<o:shapelayout v:ext="edit"><o:idmap v:ext="edit" data="1"/></o:shapelayout><v:shapetype id="_x0000_t202" coordsize="21600,21600" o:spt="202" path="m,l,21600r21600,l21600,xe"><v:stroke joinstyle="miter"/><v:path gradientshapeok="t" o:connecttype="rect"/></v:shapetype>'
   vml_xml <- paste0(vml_xml, vml_comment)
 

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 chanell is ignored.
 #'
 #' @param wb A workbook object
 #' @param sheet A worksheet of the workbook

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)