[copy_cells] copy hyperlinks and fix handling of transposed cells (#850)

R/class-workbook.R

@@ -2890,6 +2890,9 @@ wbWorkbook <- R6::R6Class(
     ) {
 
       assert_class(data, "wb_data")
+      from_sheet   <- attr(data, "sheet")
+      from_dims_df <- attr(data, "dims")
+
       sheet <- private$get_sheet_index(sheet)
 
       to_ncol <- ncol(data) - 1
@@ -2901,22 +2904,20 @@ wbWorkbook <- R6::R6Class(
       to_cols <- seq.int(start_col, start_col + to_ncol)
       to_rows <- seq.int(start_row, start_row + to_nrow)
 
-      to_dims    <- rowcol_to_dims(to_rows, to_cols)
-      to_dims_i  <- dims_to_dataframe(to_dims, fill = FALSE)
-      to_dims_f  <- dims_to_dataframe(to_dims, fill = TRUE)
-
       if (transpose) {
-        to_dims_i <- as.data.frame(t(to_dims_i))
-        to_dims_f  <- as.data.frame(t(to_dims_f))
+        to_cols <- seq.int(start_col, start_col + to_nrow)
+        to_rows <- seq.int(start_row, start_row + to_ncol)
+        from_dims_df <- as.data.frame(t(from_dims_df))
       }
 
-      to_dims_f <- unname(unlist(to_dims_f))
+      to_dims       <- rowcol_to_dims(to_rows, to_cols)
+      to_dims_df_i  <- dims_to_dataframe(to_dims, fill = FALSE)
+      to_dims_df_f  <- dims_to_dataframe(to_dims, fill = TRUE)
 
-      from_sheet <- attr(data, "sheet")
-      from_dims  <- attr(data, "dims")
+      to_dims_f <- unname(unlist(to_dims_df_f))
 
       from_sheet <- wb_validate_sheet(self, from_sheet)
-      from_dims  <- as.character(unlist(from_dims))
+      from_dims  <- as.character(unlist(from_dims_df))
       cc <- self$worksheets[[from_sheet]]$sheet_data$cc
 
       # TODO improve this. It should use v or inlineStr from cc
@@ -2949,11 +2950,43 @@ wbWorkbook <- R6::R6Class(
         to_cc[c("f")] <- paste0(shQuote(from_sheet_name, type = "sh"), "!", from_cells)
       }
 
+      # uninitialized cells are NA_character_
+      to_cc[is.na(to_cc)] <- ""
+
       cc <- self$worksheets[[sheet]]$sheet_data$cc
       cc[match(to_dims_f, cc$r), ] <- to_cc
 
       self$worksheets[[sheet]]$sheet_data$cc <- cc
 
+      ### add hyperlinks ---
+      hyperlink_in_wb <- vapply(
+        self$worksheets[[from_sheet]]$hyperlinks,
+        function(x) x$ref,
+        NA_character_
+      )
+
+      if (any(sel <- hyperlink_in_wb %in% from_dims)) {
+
+        has_hl <- apply(from_dims_df, 2, function(x) x %in% hyperlink_in_wb)
+
+        old <- from_dims_df[has_hl]
+        new <- to_dims_df_f[has_hl]
+
+        for (hls in match(hyperlink_in_wb, old)) {
+
+          # prepare the updated link
+          hl <- self$worksheets[[from_sheet]]$hyperlinks[[hls]]$clone()
+          hl$ref <- new[which(old == hl$ref)]
+
+          # assign it
+          self$worksheets[[sheet]]$hyperlinks <- append(
+            self$worksheets[[sheet]]$hyperlinks,
+            hl
+          )
+        }
+
+      }
+
       invisible(self)
     },
 

tests/testthat/test-cloneWorksheet.R

@@ -105,6 +105,28 @@ test_that("copy cells", {
 
 })
 
+test_that("copy_cells works with hyperlinks and empty cells in transpose", {
+
+  fl <- testfile_path("Single_hyperlink.xlsx")
+  wb_in <- wb_load(fl)
+
+  dat <- wb_data(wb_in, 1, dims = "A1:B2", col_names = FALSE)
+  wb_in$copy_cells(data = dat, dims = "A3")
+
+  dat <- wb_data(wb_in, 1, dims = "A1:B3", col_names = FALSE)
+  wb_in$copy_cells(data = dat, dims = "D1", transpose = TRUE)
+
+  exp <- c("A1", "A3", "D1", "F1")
+  got <- vapply(wb_in$worksheets[[1]]$hyperlinks, function(x) x$ref, "")
+  expect_equal(exp, got)
+
+  cc <- wb_in$worksheets[[1]]$sheet_data$cc
+  exp <- rep("0", 4)
+  got <- cc$v[cc$r %in% c("A1", "A3", "D1", "F1")]
+  expect_equal(exp, got)
+
+})
+
 test_that("cloning comments works", {
 
   tmp <- temp_xlsx()