[hl] helper to remove hyperlinks

R/class-workbook-wrappers.R

@@ -745,7 +745,7 @@ wb_add_formula <- function(
 
 #' wb_add_hyperlink
 #'
-#' Helper to add shared hyperlinks into a worksheet
+#' Helper to add shared hyperlinks into a worksheet or remove shared hyperlinks from a worksheet
 #'
 #' @details
 #' There are multiple ways to add hyperlinks into a worksheet. One way is to construct a formula with [create_hyperlink()] another is to assign a class `hyperlink` to a column of a data frame.
@@ -767,6 +767,8 @@ wb_add_formula <- function(
 #'   add_data(x = "openxlsx2 on CRAN")$
 #'   add_hyperlink(target = "https://cran.r-project.org/package=openxlsx2",
 #'                 tooltip = "The canonical form to link to our CRAN page.")
+#'
+#' wb$remove_hyperlink()
 wb_add_hyperlink <- function(
     wb,
     sheet       = current_sheet(),
@@ -789,6 +791,11 @@ wb_add_hyperlink <- function(
   )
 }
 
+#' @rdname wb_add_hyperlink
+wb_remove_hyperlink <- function(wb, sheet = current_sheet(), dims = NULL) {
+  assert_workbook(wb)
+  wb$clone()$remove_hyperlink(sheet = sheet, dims = dims)
+}
 
 #' Update a data table position in a worksheet
 #'

R/class-workbook.R

@@ -2589,6 +2589,43 @@ wbWorkbook <- R6::R6Class(
       invisible(self)
     },
 
+    #' @description remove hyperlink
+    #' @param sheet sheet
+    #' @param dims dims
+    #' @return The `wbWorkbook` object
+    remove_hyperlink = function(sheet = current_sheet(), dims = NULL) {
+
+      sheet <- self$validate_sheet(sheet)
+
+      # get all hyperlinks
+      hls    <- self$worksheets[[sheet]]$hyperlinks
+
+      if (length(hls)) {
+        hls_df <- rbindlist(xml_attr(hls, "hyperlink"))
+
+        if (is.null(dims)) {
+          # remove all hyperlinks
+          self$worksheets[[sheet]]$hyperlinks <- character()
+          refs <- hls_df$ref
+        } else {
+          # get cells in dims, get required cells, replace these and reduce refs
+          ddims <- dims_to_dataframe(dims = dims, fill = TRUE)
+          sel <- which(hls_df$ref %in% unname(unlist(ddims)))
+          self$worksheets[[sheet]]$hyperlinks <- hls_df$ref[-sel]
+          refs <- hls_df$ref[sel]
+        }
+
+        # TODO remove "r:id" reference from worksheets_rels
+
+        # reset font style
+        for (ref in refs) {
+          self$add_cell_style(font_id = 0)
+        }
+      }
+
+      invisible(self)
+    },
+
     #' @description add style
     #' @param style style
     #' @param style_name style_name
@@ -7889,6 +7926,13 @@ wbWorkbook <- R6::R6Class(
         styles       = styles,
         merged_cells = merged_cells
       )
+
+      if (numbers || characters)
+        self$remove_hyperlink(
+          sheet = sheet,
+          dims  = dims
+        )
+
       invisible(self)
     },
 

tests/testthat/test-class-hyperlink.R

@@ -136,4 +136,7 @@ test_that("hyperlinks work", {
     add_data(x = "https://cran.r-project.org/package=openxlsx2")
   expect_silent(wb$add_hyperlink())
 
+  wb$remove_hyperlink(dims = "A1")
+  expect_equal(character(), wb$worksheets[[1]]$hyperlinks)
+
 })

tests/testthat/test-class-workbook-wrappers.R

@@ -426,15 +426,20 @@ test_that("wb_remove_timeline() is a wrapper", {
 })
 
 test_that("wb_add_formula() is a wrapper", {
-  wb <- wb_workbook()$add_worksheet(1)
+  wb <- wb_workbook()$add_worksheet()
   expect_wrapper("add_formula",    wb = wb, params = list(sheet = 1, x = "=TODAY()"))
 })
 
 test_that("wb_add_hyperlink() is a wrapper", {
-  wb <- wb_workbook()$add_worksheet(1)$add_data(x = "http://github.com/JanMarvin/openxlsx2")
+  wb <- wb_workbook()$add_worksheet()$add_data(x = "http://github.com/JanMarvin/openxlsx2")
   expect_wrapper("add_hyperlink", wb = wb, params = list(sheet = 1, col_names = FALSE))
 })
 
+test_that("wb_remove_hyperlink() is a wrapper", {
+  wb <- wb_workbook()$add_worksheet()
+  expect_wrapper("remove_hyperlink", wb = wb)
+})
+
 test_that("wb_update_table() is a wrapper", {
   wb <- wb_workbook()$add_worksheet()$add_data_table(x = iris[1:10, ])
   expect_wrapper("update_table", wb = wb, params = list(sheet = 1, tabname = "Table1", dims = "A1:D4"))