provide first draft wb_update_table

NAMESPACE

@@ -125,6 +125,7 @@ export(wb_to_df)
 export(wb_ungroup_cols)
 export(wb_ungroup_rows)
 export(wb_unmerge_cells)
+export(wb_update_table)
 export(wb_workbook)
 export(wb_ws)
 export(write_comment)

R/class-workbook-wrappers.R

@@ -338,6 +338,17 @@ wb_add_formula <- function(
   )
 }
 
+#' update a data_table
+#' @param wb workbook
+#' @param sheet a worksheet
+#' @param dims cell used as start
+#' @param tabname a tablename
+#' @export
+wb_update_table <- function(wb, sheet = current_sheet(), dims = "A1", tabname) {
+  assert_workbook(wb)
+  wb$clone()$update_table(sheet = sheet, dims = dims, tabname = tabname)
+}
+
 #' copy cells around
 #' @param wb workbook
 #' @param sheet a worksheet

R/class-workbook.R

@@ -2227,6 +2227,71 @@ wbWorkbook <- R6::R6Class(
       invisible(self)
     },
 
+    #' @description update a data_table
+    #' @param sheet a worksheet
+    #' @param dims cell used as start
+    #' @param tabname a tablename
+    #' @return The `wbWorksheet` object, invisibly
+    update_table = function(sheet = current_sheet(), dims = "A1", tabname) {
+
+      sheet <- private$get_sheet_index(sheet)
+
+      tabs <- self$get_tables(sheet = sheet)
+      sel <- row.names(tabs[tabs$tab_name %in% tabname])
+
+      wb_tabs <- self$tables[rownames(self$tables) %in% sel, ]
+
+      xml <- wb_tabs$tab_xml
+      tab_nams <- xml_node_name(xml, "table")
+
+      tab_attr <- xml_attr(xml, "table")[[1]]
+      tab_attr[["ref"]] <- dims
+
+      tab_autofilter <- xml_node(xml, "table", "autoFilter")
+      tab_autofilter <- xml_attr_mod(tab_autofilter, xml_attributes = c(ref = dims))
+
+
+      tab_tabColumns <- xml_node(xml, "table", "tableColumns")
+      tab_cols <- names(self$to_df(sheet = sheet, dims = dims))
+
+      fun <- function(tab_cols) {
+        tabCols <- NULL
+        for (i in seq_along(tab_cols)) {
+          tmp <- xml_node_create(
+            "tableColumn",
+            xml_attributes = c(id = as.character(i), name = tab_cols[i])
+          )
+          tabCols <- c(tabCols, tmp)
+        }
+
+        xml_node_create(
+          "tableColumns",
+          xml_attributes = c(count = as.character(length(tabCols))),
+          xml_children = tabCols
+        )
+      }
+      tab_tabColumns <- fun(tab_cols)
+
+      tab_tabStyleIn <- xml_node(xml, "table", "tableStyleInfo")
+
+      xml <- xml_node_create(
+        "table",
+        xml_attributes = tab_attr,
+        xml_children = c(
+          tab_autofilter,
+          tab_tabColumns,
+          tab_tabStyleIn
+        )
+      )
+
+      wb_tabs$tab_xml <- xml
+      wb_tabs$tab_ref <- dims
+
+      self$tables[rownames(self$tables) %in% sel, ] <- wb_tabs
+
+      invisible(self)
+    },
+
     ### copy cells ----
 
     #' @description
@@ -4995,7 +5060,7 @@ wbWorkbook <- R6::R6Class(
       attr(self$worksheets[[sheet]]$tableParts, "tableName") <- worksheet_table_names[-to_remove]
 
       ## now delete data
-      self$clean_sheet(sheet = sheet, dims = refs)
+      # self$clean_sheet(sheet = sheet, dims = refs)
       invisible(self)
     },
 

R/get-named-regions.R

@@ -58,6 +58,7 @@ wb_get_named_regions_tab <- function(wb) {
 #' @description Return a vector of named regions in a xlsx file or
 #' Workbook object
 #' @param x An xlsx file or Workbook object
+#' @param tables add tables too
 #' @seealso [wb_add_named_region()] [wb_remove_named_region()]
 #' @examples
 #' ## create named regions
@@ -102,7 +103,7 @@ get_named_regions <- function(x) {
 
 #' @rdname named_region
 #' @export
-wb_get_named_regions <- function(x) {
+wb_get_named_regions <- function(x, tables = FALSE) {
   if (inherits(x, "wbWorkbook")) {
     wb <- x
   } else {
@@ -115,9 +116,19 @@ wb_get_named_regions <- function(x) {
     z <- get_nr_from_definedName(wb)
   }
 
-  if (!is.null(wb$tables)) {
+  if (tables && !is.null(wb$tables)) {
     tb <- wb_get_named_regions_tab(wb)
-    z <- merge(z, tb, all = TRUE, sort = FALSE)
+
+    if (is.null(z)) {
+      z <- tb
+    } else {
+      z <- merge(z, tb, all = TRUE, sort = FALSE)
+    }
+
+  }
+
+  if (NROW(z) == 0) {
+    z <- NULL
   }
 
   z

R/wb_functions.R

@@ -405,7 +405,7 @@ wb_to_df <- function(
 
   if (!missing(named_region)) {
 
-    nr <- wb_get_named_regions(wb)
+    nr <- wb_get_named_regions(wb, tables = TRUE)
 
     if ((named_region %in% nr$name) && missing(sheet)) {
       sel   <- nr[nr$name == named_region, ][1, ]

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

@@ -345,6 +345,11 @@ test_that("wb_add_formula() is a wrapper", {
   expect_wrapper("add_formula",    wb = wb, params = list(sheet = 1, x = "=TODAY()"))
 })
 
+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"))
+})
+
 test_that("wb_copy_cells() is a wrapper", {
   wb <- wb_workbook()$add_worksheet(1)$add_data(x = "1")
   dat <- wb_data(wb, 1, dims = "A1", colNames = FALSE)

tests/testthat/test-tables.R

@@ -174,3 +174,21 @@ test_that("custom table styles work", {
   expect_error(wb$add_data_table(x = mtcars, tableStyle = "RedTableStyle1"), "Invalid table style.")
 
 })
+
+test_that("updating table works", {
+
+  wb <- wb_workbook()
+  wb$add_worksheet()$add_data_table(x = mtcars)
+  wb$add_worksheet()$add_data_table(x = mtcars[1:2])
+
+  wb_to_df(wb, named_region = "Table2")
+
+  wb$add_data(dims = "C1", x = mtcars[-1:-2], name = "test")
+
+  wb <- wb_update_table(wb, "Table2", sheet = 2, dims = "A1:J4")
+
+  exp <- mtcars[1:3, 1:10]
+  got <- wb_to_df(wb, named_region = "Table2")
+  expect_equal(exp, got, ignore_attr = TRUE)
+
+})