Skip to content

Commit 3368e26

Browse files
JanMarvinJanMarvin
authored
allow custom table styles (#594)
* allow custom table styles * fix reading dxf ids * cleanup. table style check now allows custom table styles * consolidate two test functions * fix some minor dxf details * update test * update NEWS * fix wb_color test. return only non empty character vector
1 parent 1fb2701 commit 3368e26

7 files changed

+100
-55
lines changed

‎NEWS.md

+2
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,8 @@
44

55
* The `dims` argument of `wb_add_formula()` can be used to create a array references. A new `cm` argument was added which might be useful, if formulas previously created addition `@` in spreadsheet software. Examples how to use formulas were added to a new vignette. [593](https://github.com/JanMarvin/openxlsx2/pull/593)
66

7+
* Allow using custom data table styles. This fixes a few minor style inconsistencies. [594](https://github.com/JanMarvin/openxlsx2/pull/594)
8+
79

810
***************************************************************************
911

‎R/class-color.R

+7-5
Original file line numberDiff line numberDiff line change
@@ -20,13 +20,15 @@ wb_color <- function(
2020
if (!is.null(name)) hex <- validate_color(name)
2121

2222
z <- c(
23-
auto = auto,
24-
indexed = indexed,
25-
rgb = hex,
26-
theme = theme,
27-
tint = tint
23+
auto = as_xml_attr(auto),
24+
indexed = as_xml_attr(indexed),
25+
rgb = as_xml_attr(hex),
26+
theme = as_xml_attr(theme),
27+
tint = as_xml_attr(tint)
2828
)
2929

30+
z <- z[z != ""]
31+
3032
if (is.null(z))
3133
z <- c(name = "black")
3234

‎R/class-style_mgr.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -171,7 +171,7 @@ style_mgr <- R6::R6Class("wbStylesMgr", {
171171
dxfs <- self$styles$dxfs
172172
if (length(dxfs)) {
173173
typ <- xml_node_name(dxfs)
174-
id <- rownames(read_xf(read_xml(dxfs)))
174+
id <- rownames(read_dxf(read_xml(dxfs)))
175175
name <- paste0(typ, "-", id)
176176

177177
self$dxf <- data.frame(

‎R/wb_styles.R

+4-4
Original file line numberDiff line numberDiff line change
@@ -235,7 +235,7 @@ create_font <- function(
235235
charset <- xml_node_create("charset", xml_attributes = c("val" = charset))
236236
}
237237

238-
if (!is.null(color) && all(color != "")) {
238+
if (!is.null(color) && !all(color == "")) {
239239
# alt xml_attributes(theme:)
240240
color <- xml_node_create("color", xml_attributes = color)
241241
}
@@ -331,11 +331,11 @@ create_fill <- function(
331331

332332
standardize_color_names(...)
333333

334-
if (!is.null(bgColor) && all(bgColor != "")) {
334+
if (!is.null(bgColor) && !all(bgColor == "")) {
335335
bgColor <- xml_node_create("bgColor", xml_attributes = bgColor)
336336
}
337337

338-
if (!is.null(fgColor) && all(fgColor != "")) {
338+
if (!is.null(fgColor) && !all(fgColor == "")) {
339339
fgColor <- xml_node_create("fgColor", xml_attributes = fgColor)
340340
}
341341

@@ -707,7 +707,7 @@ create_dxfs_style <- function(
707707
u = text_underline,
708708
family = "", scheme = "")
709709

710-
if (!is.null(bgFill) && bgFill != "")
710+
if (!is.null(bgFill) && !all(bgFill == ""))
711711
fill <- create_fill(patternType = "solid", bgColor = bgFill)
712712
else
713713
fill <- NULL

‎R/write.R

+3-3
Original file line numberDiff line numberDiff line change
@@ -883,13 +883,13 @@ write_data_table <- function(
883883
}
884884

885885
## If 0 rows append a blank row
886-
validNames <- c("none", paste0("TableStyleLight", seq_len(21)), paste0("TableStyleMedium", seq_len(28)), paste0("TableStyleDark", seq_len(11)))
886+
cstm_tableStyles <- rbindlist(xml_attr(wb$styles_mgr$styles$tableStyles, "tableStyles", "tableStyle"))$name
887+
validNames <- c("none", paste0("TableStyleLight", seq_len(21)), paste0("TableStyleMedium", seq_len(28)), paste0("TableStyleDark", seq_len(11)), cstm_tableStyles)
887888
if (!tolower(tableStyle) %in% tolower(validNames)) {
888889
stop("Invalid table style.")
889-
} else {
890-
tableStyle <- grep(paste0("^", tableStyle, "$"), validNames, ignore.case = TRUE, value = TRUE)
891890
}
892891

892+
tableStyle <- grep(paste0("^", tableStyle, "$"), validNames, ignore.case = TRUE, value = TRUE)
893893
tableStyle <- tableStyle[!is.na(tableStyle)]
894894
if (length(tableStyle) == 0) {
895895
stop("Unknown table style.")

‎tests/testthat/test-table_overlaps.R ‎tests/testthat/test-tables.R

+83
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
12
test_that("write_datatable over tables", {
23

34
overwrite_table_error <- "Cannot overwrite existing table with another table"
@@ -91,3 +92,85 @@ test_that("write_data over tables", {
9192
wb$add_data_table(sheet = 1, x = head(iris)[, 1:3], startCol = 1, startRow = 30)
9293
wb$add_data(sheet = 1, x = tail(iris), startCol = 1, startRow = 31, colNames = FALSE)
9394
})
95+
96+
test_that("Validate Table Names", {
97+
wb <- wb_add_worksheet(wb_workbook(), "Sheet 1")
98+
99+
## case
100+
expect_equal(wb_validate_table_name(wb, "test"), "test")
101+
expect_equal(wb_validate_table_name(wb, "TEST"), "test")
102+
expect_equal(wb_validate_table_name(wb, "Test"), "test")
103+
104+
## length
105+
expect_error(wb_validate_table_name(wb, paste(sample(LETTERS, size = 300, replace = TRUE), collapse = "")), regexp = "tableName must be less than 255 characters")
106+
107+
## look like cell ref
108+
expect_error(wb_validate_table_name(wb, "R1C2"), regexp = "tableName cannot be the same as a cell reference, such as R1C1", fixed = TRUE)
109+
expect_error(wb_validate_table_name(wb, "A1"), regexp = "tableName cannot be the same as a cell reference", fixed = TRUE)
110+
111+
expect_error(wb_validate_table_name(wb, "R06821C9682"), regexp = "tableName cannot be the same as a cell reference, such as R1C1", fixed = TRUE)
112+
expect_error(wb_validate_table_name(wb, "ABD918751"), regexp = "tableName cannot be the same as a cell reference", fixed = TRUE)
113+
114+
expect_error(wb_validate_table_name(wb, "A$100"), regexp = "'$' character cannot exist in a tableName", fixed = TRUE)
115+
expect_error(wb_validate_table_name(wb, "A12$100"), regexp = "'$' character cannot exist in a tableName", fixed = TRUE)
116+
117+
tbl_nm <- "性別"
118+
expect_equal(wb_validate_table_name(wb, tbl_nm), tbl_nm)
119+
})
120+
121+
test_that("Existing Table Names", {
122+
wb <- wb_add_worksheet(wb_workbook(), "Sheet 1")
123+
124+
## Existing names - case in-sensitive
125+
wb$add_data_table(sheet = 1, x = head(iris), tableName = "Table1")
126+
expect_error(wb_validate_table_name(wb, "Table1"), regexp = "table with name 'table1' already exists", fixed = TRUE)
127+
expect_error(wb$add_data_table(sheet = 1, x = head(iris), tableName = "Table1", startCol = 10), regexp = "table with name 'table1' already exists", fixed = TRUE)
128+
129+
expect_error(wb_validate_table_name(wb, "TABLE1"), regexp = "table with name 'table1' already exists", fixed = TRUE)
130+
expect_error(wb$add_data_table(sheet = 1, x = head(iris), tableName = "TABLE1", startCol = 20), regexp = "table with name 'table1' already exists", fixed = TRUE)
131+
132+
expect_error(wb_validate_table_name(wb, "table1"), regexp = "table with name 'table1' already exists", fixed = TRUE)
133+
expect_error(wb$add_data_table(sheet = 1, x = head(iris), tableName = "table1", startCol = 30), regexp = "table with name 'table1' already exists", fixed = TRUE)
134+
})
135+
136+
test_that("custom table styles work", {
137+
138+
# at the moment we have no interface to add custom table styles
139+
wb <- wb_workbook() %>%
140+
wb_add_worksheet()
141+
142+
# create dxf elements to be used in the table style
143+
tabCol1 <- create_dxfs_style(bgFill = wb_color(theme = 7))
144+
tabCol2 <- create_dxfs_style(bgFill = wb_color(theme = 5))
145+
tabBrd1 <- create_dxfs_style(border = TRUE)
146+
tabCol3 <- create_dxfs_style(bgFill = wb_color(hex = "FFC00000"), font_color = wb_color("white"))
147+
148+
# dont forget to assign them to the workbook
149+
wb$add_style(tabCol1)
150+
wb$add_style(tabCol2)
151+
wb$add_style(tabBrd1)
152+
wb$add_style(tabCol3)
153+
154+
# tweak a working style with 4 elements
155+
wb$styles_mgr$styles$tableStyles <-
156+
sprintf(
157+
"<tableStyles count=\"1\" defaultTableStyle=\"TableStyleMedium2\" defaultPivotStyle=\"PivotStyleLight16\">
158+
<tableStyle name=\"RedTableStyle\" pivot=\"0\" count=\"%s\" xr9:uid=\"{91A57EDA-14C5-4643-B7E3-C78161B6BBA4}\">
159+
<tableStyleElement type=\"wholeTable\" dxfId=\"%s\"/>
160+
<tableStyleElement type=\"headerRow\" dxfId=\"%s\"/>
161+
<tableStyleElement type=\"firstRowStripe\" dxfId=\"%s\"/>
162+
<tableStyleElement type=\"secondColumnStripe\" dxfId=\"%s\"/>
163+
</tableStyle>
164+
</tableStyles>",
165+
length(c(tabCol1, tabCol2, tabCol3, tabBrd1)),
166+
wb$styles_mgr$get_dxf_id("tabBrd1"),
167+
wb$styles_mgr$get_dxf_id("tabCol3"),
168+
wb$styles_mgr$get_dxf_id("tabCol1"),
169+
wb$styles_mgr$get_dxf_id("tabCol2")
170+
)
171+
172+
expect_silent(wb$add_data_table(x = mtcars, tableStyle = "RedTableStyle"))
173+
wb$add_worksheet()
174+
expect_error(wb$add_data_table(x = mtcars, tableStyle = "RedTableStyle1"), "Invalid table style.")
175+
176+
})

‎tests/testthat/test-validate_table_name.R

-42
This file was deleted.

0 commit comments

Comments
 (0)