Update table

NAMESPACE

@@ -127,6 +127,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)

NEWS.md

@@ -14,6 +14,8 @@
 
 * Add new wrapper to ignore worksheet errors `wb_add_ignore_error()`. [617](https://github.com/JanMarvin/openxlsx2/pull/617)
 
+* Add new wrapper to update table references `wb_update_table()`. [606](https://github.com/JanMarvin/openxlsx2/pull/606)
+
 ## Fixes
 
 * Improve handling of non standard `OutDec` options. [611](https://github.com/JanMarvin/openxlsx2/pull/611)

R/class-workbook-wrappers.R

@@ -339,6 +339,21 @@ 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
+#' @details Be aware that this function does not alter any filter. Excluding or adding rows does not make rows appear nor will it hide them.
+#' @examples
+#' wb <- wb_workbook()$add_worksheet()$add_data_table(x = mtcars)
+#' wb$update_table(tabname = "Table1", dims = "A1:J4")
+#' @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
@@ -1880,6 +1895,7 @@ wb_get_tables <- function(wb, sheet = current_sheet()) {
 #' @param wb A workbook object
 #' @param sheet A name or index of a worksheet
 #' @param table Name of table to remove. See [wb_get_tables()]
+#' @param remove_data Removes the data as well
 #' @return character vector of table names on the specified sheet
 #' @examples
 #'
@@ -1904,9 +1920,9 @@ wb_get_tables <- function(wb, sheet = current_sheet()) {
 #' wb$remove_tables(sheet = 1, table = "iris")
 #' wb$add_data_table(sheet = 1, x = iris, tableName = "iris", startCol = 1)
 #' @export
-wb_remove_tables <- function(wb, sheet = current_sheet(), table) {
+wb_remove_tables <- function(wb, sheet = current_sheet(), table, remove_data = TRUE) {
   assert_workbook(wb)
-  wb$clone()$remove_tables(sheet = sheet, table = table)
+  wb$clone()$remove_tables(sheet = sheet, table = table, remove_data = remove_data)
 }
 
 

R/class-workbook.R

@@ -2239,6 +2239,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
@@ -4955,22 +5020,16 @@ wbWorkbook <- R6::R6Class(
       if (is.na(sheet)) stop("No such sheet in workbook")
 
       sel <- self$tables$tab_sheet == sheet & self$tables$tab_act == 1
-      tables <- self$tables$tab_name[sel]
-      refs <- self$tables$tab_ref[sel]
-
-      if (length(tables)) {
-        attr(tables, "refs") <- refs
-      }
-
-      return(tables)
+      self$tables[sel, c("tab_name", "tab_ref")]
     },
 
 
     #' @description remove tables
     #' @param sheet sheet
     #' @param table table
+    #' @param remove_data removes the data as well
     #' @returns The `wbWorkbook` object
-    remove_tables = function(sheet = current_sheet(), table) {
+    remove_tables = function(sheet = current_sheet(), table, remove_data = TRUE) {
       if (length(table) != 1) {
         stop("table argument must be length 1")
       }
@@ -5007,17 +5066,10 @@ wbWorkbook <- R6::R6Class(
       self$worksheets[[sheet]]$tableParts <- self$worksheets[[sheet]]$tableParts[-to_remove]
       attr(self$worksheets[[sheet]]$tableParts, "tableName") <- worksheet_table_names[-to_remove]
 
-
-      ## Now delete data from the worksheet
-      refs <- strsplit(refs, split = ":")[[1]]
-      rows <- as.integer(gsub("[A-Z]", "", refs))
-      rows <- seq(from = rows[1], to = rows[2], by = 1)
-
-      cols <- col2int(refs)
-      cols <- seq(from = cols[1], to = cols[2], by = 1)
-
       ## now delete data
-      delete_data(wb = self, sheet = sheet, rows = rows, cols = cols)
+      if (remove_data)
+        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,15 @@ 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)
+    }
+
   }
 
   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, ]

inst/WORDLIST

@@ -50,7 +50,6 @@ bool
 calc
 calcChain
 cellWatches
-cellXfs
 charset
 chartShapes
 chartsheet
@@ -94,8 +93,11 @@ datatable
 datetime
 datetimes
 defaultGridColor
+defaultPivotStyle
+defaultTableStyle
 detectDates
 df
+difftime
 displayEmptyCellsAs
 drawingHF
 dxf
@@ -171,7 +173,6 @@ nestings
 notBetween
 notEqual
 numFmt
-numFmtId
 numfmt
 numfmts
 oddFooter
@@ -263,6 +264,7 @@ tabSelected
 tableName
 tableParts
 tableStyle
+tablename
 textLength
 th
 threadComments

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)