tests/testthat/test-class-workbook.R
In JanMarvin/openxlsx2: Read, Write and Edit 'xlsx' Files
testsetup()
test_that("Workbook class", {
expect_null(assert_workbook(wb_workbook()))
})
test_that("wb_set_col_widths works", {
# TODO use wb$wb_set_col_widths()
wb <- wbWorkbook$new()
wb$add_worksheet("test")
wb$add_data("test", mtcars)
# set column width to 12
expect_silent(wb$set_col_widths("test", widths = 12L, cols = seq_along(mtcars)))
expect_equal(
wb$worksheets[[1]]$cols_attr,
"<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"12.711\"/>"
)
# wrong sheet
expect_error(wb$set_col_widths("test2", widths = 12L, cols = seq_along(mtcars)))
# reset the column with, we do not provide an option ot remove the column entry
expect_silent(wb$set_col_widths("test", cols = seq_along(mtcars)))
expect_equal(
wb$worksheets[[1]]$cols_attr,
"<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.141\"/>"
)
# create column width for column 25
expect_silent(wb$set_col_widths("test", cols = "Y", widths = 22))
expect_equal(
c("<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.141\"/>",
"<col min=\"12\" max=\"24\" width=\"8.43\"/>",
"<col min=\"25\" max=\"25\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"22.711\"/>"),
wb$worksheets[[1]]$cols_attr
)
wb <- wb_workbook()$
add_worksheet()$
set_col_widths(cols = 1:10, widths = (8:17) + .5)$
add_data(x = rbind(8:17), col_names = FALSE)
exp <- c(
"<col min=\"1\" max=\"1\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.211\"/>",
"<col min=\"2\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"10.211\"/>",
"<col min=\"3\" max=\"3\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"11.211\"/>",
"<col min=\"4\" max=\"4\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"12.211\"/>",
"<col min=\"5\" max=\"5\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"13.211\"/>",
"<col min=\"6\" max=\"6\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"14.211\"/>",
"<col min=\"7\" max=\"7\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"15.211\"/>",
"<col min=\"8\" max=\"8\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"16.211\"/>",
"<col min=\"9\" max=\"9\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"17.211\"/>",
"<col min=\"10\" max=\"10\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"18.211\"/>"
)
got <- wb$worksheets[[1]]$cols_attr
expect_equal(exp, got)
wb <- wb_workbook()$add_worksheet()
wb$worksheets[[1]]$cols_attr <- c(
"<col min=\"1\" max=\"17\" width=\"30.77734375\" style=\"16\" customWidth=\"1\"/>",
"<col min=\"18\" max=\"16384\" width=\"8.88671875\" style=\"16\"/>"
)
expect_silent(wb$set_col_widths(cols = 19, widths = 9))
})
test_that("set_col_widths informs when inconsistent lengths are supplied", {
wb <- wbWorkbook$new()
wb$add_worksheet("test")
expect_warning(wb$set_col_widths(cols = c(1, 2, 3), widths = c(2, 3)), "compatible length")
expect_error(wb$set_col_widths(cols = "Y", widths = 1:2), "More widths than column")
expect_error(wb$set_col_widths("test", cols = "Y", hidden = 1:2), "hidden argument is longer")
expect_warning(wb$set_col_widths(cols = c("X", "Y", "Z"), hidden = c(1, 0)), "compatible length")
})
test_that("merged cells are excluded from col width `auto` calculation", {
wb <- wb_workbook()$add_worksheet()$
add_data(x = "the `cars` dataset", dims = "A1")$
merge_cells(dims = "A1:B1")$
add_data(x = head(cars), dims = "A2")$
set_col_widths(cols = "A:B", width = "auto")
exp <- c(
"<col min=\"1\" max=\"1\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"6.711\"/>",
"<col min=\"2\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"5.711\"/>"
)
got <- wb$worksheets[[1]]$cols_attr
expect_equal(exp, got)
})
test_that("option maxWidth works", {
op <- options("openxlsx2.maxWidth" = 6)
on.exit(options(op), add = TRUE)
wb <- wb_workbook()$add_worksheet()$add_data(x = data.frame(
x = paste0(letters, collapse = ""),
y = paste0(letters, collapse = "")
))$set_col_widths(cols = 1:2, widths = "auto")
exp <- "<col min=\"1\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"6\"/>"
got <- wb$worksheets[[1]]$cols_attr
expect_equal(exp, got)
})
# order -------------------------------------------------------------------
test_that("$set_order() works", {
wb <- wb_workbook()
wb$add_worksheet("a")
wb$add_worksheet("b")
wb$add_worksheet("c")
expect_identical(wb$sheetOrder, 1:3)
exp <- letters[1:3]
names(exp) <- exp
expect_identical(wb$get_sheet_names(), exp)
wb$set_order(3:1)
expect_identical(wb$sheetOrder, 3:1)
exp <- letters[3:1]
names(exp) <- exp
expect_identical(wb$get_sheet_names(), exp)
})
# sheet names -------------------------------------------------------------
test_that("$set_sheet_names() and $get_sheet_names() work", {
wb <- wb_workbook()$add_worksheet()$add_worksheet()
wb$set_sheet_names(new = c("a", "b & c"))
# return a names character vector
res <- wb$get_sheet_names()
exp <- c(a = "a", "b & c" = "b & c")
expect_identical(res, exp)
# return a names character vector
res <- wb$get_sheet_names(escape = TRUE)
exp <- c(a = "a", "b & c" = replace_legal_chars("b & c"))
expect_identical(res, exp)
# should be able to check the original values, too
res <- wb$.__enclos_env__$private$get_sheet_index("b & c")
expect_identical(res, 2L)
# make sure that it works silently
wb <- wb_load(file = system.file("extdata", "oxlsx2_sheet.xlsx", package = "openxlsx2"))
expect_silent(wb$set_sheet_names(old = "SUM", new = "Sheet 1"))
exp <- c(`Sheet 1` = "Sheet 1")
got <- wb$get_sheet_names()
expect_equal(exp, got)
})
# data validation ---------------------------------------------------------
test_that("data validation", {
temp <- temp_xlsx()
df <- data.frame(
"d" = as.Date("2016-01-01") + -5:5,
"t" = as.POSIXct("2016-01-01") + -5:5 * 10000
)
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = iris)$
# whole numbers are fine
add_data_validation(dims = "A2:C151", type = "whole",
operator = "between", value = c(1, 9)
)$
# text width 7-9 is fine
add_data_validation(dims = "E2:E151", type = "textLength",
operator = "between", value = c(7, 9)
)$
## Date and Time cell validation
add_worksheet("Sheet 2")$
add_data_table(x = df)$
# date >= 2016-01-01 is fine
add_data_validation(dims = "A2:A12", type = "date",
operator = "greaterThanOrEqual", value = as.Date("2016-01-01")
)$
# a few timestamps are fine
add_data_validation(dims = "B2:B12", type = "time",
operator = "between", value = df$t[c(4, 8)]
)$
## validate list: validate inputs on one sheet with another
add_worksheet("Sheet 3")$
add_data_table(x = iris[1:30, ])$
add_worksheet("Sheet 4")$
add_data(x = sample(iris$Sepal.Length, 10))$
add_data_validation("Sheet 3", dims = "A2:A31", type = "list",
value = "'Sheet 4'!$A$1:$A$10")
exp <- c(
"<dataValidation type=\"whole\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:C151\"><formula1>1</formula1><formula2>9</formula2></dataValidation>",
"<dataValidation type=\"textLength\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"E2:E151\"><formula1>7</formula1><formula2>9</formula2></dataValidation>"
)
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
exp <- c(
"<dataValidation type=\"date\" operator=\"greaterThanOrEqual\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A12\"><formula1>42370</formula1></dataValidation>",
"<dataValidation type=\"time\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"B2:B12\"><formula1>42369.7685185185</formula1><formula2>42370.2314814815</formula2></dataValidation>"
)
got <- wb$worksheets[[2]]$dataValidations
expect_equal(exp, got)
exp <- c(
"<dataValidation type=\"list\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A31\"><formula1>'Sheet 4'!$A$1:$A$10</formula1></dataValidation>"
)
got <- wb$worksheets[[3]]$dataValidations
expect_equal(exp, got)
wb$save(temp)
wb2 <- wb_load(temp)
# wb2$add_data_validation("Sheet 3", col = 2, rows = 2:31, type = "list",
# value = "'Sheet 4'!$A$1:$A$10")
# wb2$save(temp)
expect_equal(
wb$worksheets[[1]]$dataValidations,
wb2$worksheets[[1]]$dataValidations
)
expect_equal(
wb$worksheets[[2]]$dataValidations,
wb2$worksheets[[2]]$dataValidations
)
expect_equal(
wb$worksheets[[3]]$dataValidations,
wb2$worksheets[[3]]$dataValidations
)
expect_warning(
wb2$add_data_validation("Sheet 3", cols = 2, rows = 2:31, type = "list",
value = "'Sheet 4'!$A$1:$A$10"),
"'cols/rows' is deprecated."
)
exp <- c(
"<dataValidation type=\"list\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A31\"><formula1>'Sheet 4'!$A$1:$A$10</formula1></dataValidation>",
"<dataValidation type=\"list\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"B2:B31\"><formula1>'Sheet 4'!$A$1:$A$10</formula1></dataValidation>"
)
got <- wb2$worksheets[[3]]$dataValidations
expect_equal(exp, got)
### tests if conditions
# test col2int
expect_warning(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
# whole numbers are fine
add_data_validation(cols = "A", rows = 2:151, type = "whole",
operator = "between", value = c(1, 9)
),
"'cols/rows' is deprecated."
)
exp <- "<dataValidation type=\"whole\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A151\"><formula1>1</formula1><formula2>9</formula2></dataValidation>"
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
# to many values
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
add_data_validation(dims = "A2:A151", type = "whole",
operator = "between", value = c(1, 9, 19)
),
"length <= 2"
)
# wrong type
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
add_data_validation(dims = "A2:A151", type = "even",
operator = "between", value = c(1, 9)
),
"Invalid 'type' argument!"
)
# wrong operator
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
add_data_validation(dims = "A2:A151", type = "whole",
operator = "lower", value = c(1, 9)
),
"Invalid 'operator' argument!"
)
# wrong value for date
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
# whole numbers are fine
add_data_validation(dims = "A2:A12", type = "date",
operator = "greaterThanOrEqual", value = 7
),
"If type == 'date' value argument must be a Date vector"
)
# wrong value for time
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
# whole numbers are fine
add_data_validation(dims = "A2:A12", type = "time",
operator = "greaterThanOrEqual", value = 7
),
"If type == 'time' value argument must be a POSIXct or POSIXlt vector."
)
# some more options
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data(x = c(-1:1), colNames = FALSE)$
# whole numbers are fine
add_data_validation(dims = "A1:A3", type = "whole",
operator = "greaterThan", value = c(0),
errorStyle = "information", errorTitle = "ERROR!",
error = "Some error ocurred!",
promptTitle = "PROMPT!",
prompt = "Choose something!"
)
exp <- "<dataValidation type=\"whole\" operator=\"greaterThan\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A1:A3\" errorStyle=\"information\" errorTitle=\"ERROR!\" error=\"Some error ocurred!\" promptTitle=\"PROMPT!\" prompt=\"Choose something!\"><formula1>0</formula1></dataValidation>"
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
# add custom data
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data(x = data.frame(x = 1, y = 2), colNames = FALSE)$
# whole numbers are fine
add_data_validation(dims = "A1:A3", type = "custom", value = "A1=B1")
exp <- "<dataValidation type=\"custom\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A1:A3\"><formula1>A1=B1</formula1></dataValidation>"
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
})
test_that("clone worksheet", {
## Dummy tests - not sure how to test these from R ##
# # clone chartsheet ----------------------------------------------------
fl <- testfile_path("mtcars_chart.xlsx")
wb <- wb_load(fl)
# wb$get_sheet_names() # chartsheet has no named name?
expect_silent(wb$clone_worksheet(1, "Clone 1"))
expect_s3_class(wb$worksheets[[5]], "wbChartSheet")
# wb$open()
# clone pivot table and drawing -----------------------------------------
fl <- testfile_path("loadExample.xlsx")
wb <- wb_load(fl)
expect_silent(wb$clone_worksheet(4, "Clone 1"))
# sheets 4 & 5 both reference the same pivot table in different drawing
# once the file is opened, both pivot tables behave independently
exp <- c(
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable\" Target=\"../pivotTables/pivotTable2.xml\"/>",
"<Relationship Id=\"rId2\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing\" Target=\"../drawings/drawing5.xml\"/>"
)
got <- wb$worksheets_rels[[5]]
expect_equal(exp, got)
# wb$open()
# clone drawing ---------------------------------------------------------
wb <- wb_load(fl)
expect_silent(wb$clone_worksheet("testing", "Clone1"))
expect_false(identical(wb$worksheets_rels[2], wb$worksheets_rels[5]))
# wb$open()
# clone sheet with table ------------------------------------------------
fl <- testfile_path("tableStyles.xlsx")
wb <- wb_load(fl)
expect_silent(wb$clone_worksheet(1, "clone"))
expect_false(identical(wb$tables$tab_xml[1], wb$tables$tab_xml[2]))
# wb$open()
# clone sheet with chart ------------------------------------------------
fl <- testfile_path("mtcars_chart.xlsx")
wb <- wb_load(fl)
wb$clone_worksheet(2, "Clone 1")
expect_match(wb$charts$chart[2], "test")
expect_match(wb$charts$chart[3], "'Clone 1'")
# wb$open()
# clone slicer ----------------------------------------------------------
fl <- testfile_path("loadExample.xlsx")
wb <- wb_load(fl)
expect_warning(wb$clone_worksheet("IrisSample", "Clone1"),
"Cloning slicers is not yet supported. It will not appear on the sheet.")
# wb$open()
})
test_that("set and remove row heights work", {
## add row heights
wb <- wb_workbook()$
add_worksheet()$
set_row_heights(
rows = c(1, 4, 22, 2, 19),
heights = c(24, 28, 32, 42, 33)
)
exp <- structure(
list(
customHeight = c("1", "1", "1", "1", "1"),
ht = c("24", "42", "28", "33", "32"),
r = c("1", "2", "4", "19", "22")
),
row.names = c(1L, 2L, 4L, 19L, 22L),
class = "data.frame"
)
got <- wb$worksheets[[1]]$sheet_data$row_attr[c(1, 2, 4, 19, 22), c("customHeight", "ht", "r")]
expect_equal(exp, got)
## remove row heights
wb$remove_row_heights(rows = 1:21)
exp <- structure(
list(
customHeight = c("", "", "", "", "1"),
ht = c("", "", "", "", "32"),
r = c("1", "2", "4", "19", "22")
),
row.names = c(1L, 2L, 4L, 19L, 22L),
class = "data.frame"
)
got <- wb$worksheets[[1]]$sheet_data$row_attr[c(1, 2, 4, 19, 22), c("customHeight", "ht", "r")]
expect_equal(exp, got)
expect_warning(
wb$add_worksheet()$remove_row_heights(rows = 1:3),
"There are no initialized rows on this sheet"
)
wb <- wb_workbook()$
add_worksheet()$
add_data(x = mtcars)$
set_row_heights(rows = 5:15, hidden = TRUE)
exp <- structure(
c(22L, `1` = 11L),
dim = 2L,
dimnames = structure(
list(
c("", "1")
),
names = ""
),
class = "table"
)
got <- table(wb$worksheets[[1]]$sheet_data$row_attr$hidden)
expect_equal(exp, got)
})
test_that("set and remove row heights work", {
rows <- c(99999, 100000, 100001)
wb <- wb_workbook()$
add_worksheet()$
add_data(x = 1:3, dims = "A99999:A100001")$
set_row_heights(
rows = rows,
heights = c(24, 28, 32)
)
exp <- c("99999", "100000", "100001")
got <- wb$worksheets[[1]]$sheet_data$row_attr$r
expect_equal(exp, got)
wb$remove_row_heights(rows = rows)
})
test_that("add_drawing works", {
skip_if_not_installed("rvg")
skip_if_not_installed("ggplot2")
require(rvg)
require(ggplot2)
tmp <- tempfile(fileext = "drawing.xml")
## rvg example
dml_xlsx(file = tmp, fonts = list(sans = "Bradley Hand"))
print(
ggplot(data = iris,
mapping = aes(x = Sepal.Length, y = Petal.Width)) +
geom_point() + labs(title = "With font Bradley Hand") +
theme_minimal(base_family = "sans", base_size = 18)
)
dev.off()
wb <- wb_workbook()$
add_worksheet()$
add_drawing(xml = tmp)$
add_drawing(xml = tmp, dims = "A1:H10")$
add_drawing(xml = tmp, dims = "L1")$
add_drawing(xml = tmp, dims = NULL)$
add_drawing(xml = tmp, dims = "L19")
expect_length(wb$drawings, 1L)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_silent(wb$add_image(file = img))
})
test_that("add_drawing works", {
skip_if_not_installed("mschart")
require(mschart)
# write data starting at B2
wb <- wb_workbook()$add_worksheet()$
add_data(x = mtcars, dims = "B2")$
add_data(x = data.frame(name = rownames(mtcars)), dims = "A2")
# create wb_data object this will tell this mschart from this PR to create a file corresponding to openxlsx2
dat <- wb_data(wb, 1)
expect_equal(c(32L, 12L), dim(dat))
dat <- wb_data(wb, 1, dims = "A2:G6")
exp <- structure(
list(
name = c("Mazda RX4", "Mazda RX4 Wag", "Datsun 710", "Hornet 4 Drive"),
mpg = c(21, 21, 22.8, 21.4),
cyl = c(6, 6, 4, 6),
disp = c(160, 160, 108, 258),
hp = c(110, 110, 93, 110),
drat = c(3.9, 3.9, 3.85, 3.08),
wt = c(2.62, 2.875, 2.32, 3.215)
),
row.names = 3:6,
class = c("wb_data", "data.frame"),
dims = structure(
list(
A = c("A2", "A3", "A4", "A5", "A6"),
B = c("B2", "B3", "B4", "B5", "B6"),
C = c("C2", "C3", "C4", "C5", "C6"),
D = c("D2", "D3", "D4", "D5", "D6"),
E = c("E2", "E3", "E4", "E5", "E6"),
F = c("F2", "F3", "F4", "F5", "F6"),
G = c("G2", "G3", "G4", "G5", "G6")
),
row.names = 2:6,
class = "data.frame"),
sheet = "Sheet 1")
expect_equal(exp, dat)
# call ms_scatterplot
scatter_plot <- ms_scatterchart(
data = dat,
x = "mpg",
y = c("disp", "hp"),
labels = c("disp", "hp")
)
# add the scatterplots to the data
wb <- wb %>%
wb_add_mschart(dims = "F4:L20", graph = scatter_plot)
expect_equal(NROW(wb$charts), 1L)
chart_01 <- ms_linechart(
data = us_indus_prod,
x = "date", y = "value",
group = "type"
)
wb$add_worksheet()
wb$add_mschart(dims = "F4:L20", graph = chart_01)
exp <- list(
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/chart\" Target=\"../charts/chart1.xml\"/>",
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/chart\" Target=\"../charts/chart2.xml\"/>"
)
got <- wb$drawings_rels
expect_equal(exp, got)
# write data starting at B2
wb <- wb_workbook()$
add_worksheet()$add_data(x = mtcars)$
add_worksheet()$add_data(x = mtcars)$
add_worksheet()$add_data(x = mtcars)$
add_worksheet()$add_data(x = mtcars)$
add_mschart(dims = "F4:L20", 2, graph = chart_01)$
add_mschart(dims = "F4:L20", 3, graph = chart_01)
exp <- list(
character(0),
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing\" Target=\"../drawings/drawing1.xml\"/>",
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing\" Target=\"../drawings/drawing2.xml\"/>",
character(0)
)
got <- wb$worksheets_rels
expect_equal(exp, got)
## write different anchors
wb <- wb_workbook()$
add_worksheet()$add_data(x = mtcars)
scatter_plot <- ms_scatterchart(
data = wb_data(wb),
x = "mpg",
y = c("disp", "hp")
)
wb$
add_mschart(graph = scatter_plot)$
add_mschart(dims = "A1", graph = scatter_plot)$
add_mschart(dims = "F4:L20", graph = scatter_plot)
drawings <- as.character(wb$drawings)
expect_match(drawings, "absoluteAnchor")
expect_match(drawings, "oneCellAnchor")
expect_match(drawings, "twoCellAnchor")
})
test_that("add_chartsheet works", {
skip_if_not_installed("mschart")
require(mschart)
wb <- wb_workbook()$
add_worksheet("A & B")$
add_data(x = mtcars)$
add_chartsheet(tabColour = "red")
dat <- wb_data(wb, 1, dims = "A1:E6")
# call ms_scatterplot
data_plot <- ms_scatterchart(
data = dat,
x = "mpg",
y = c("disp", "hp"),
labels = c("disp", "hp")
)
wb$add_mschart(graph = data_plot)
expect_equal(nrow(wb$charts), 1)
expect_match(wb$charts$chart, "A & B")
expect_true(wb$is_chartsheet[[2]])
# add new worksheet and replace chart on chartsheet
wb$add_worksheet()$add_data(x = mtcars)
dat <- wb_data(wb, dims = "A1:E1;A7:E15")
data_plot <- ms_scatterchart(
data = dat,
x = "mpg",
y = c("disp", "hp"),
labels = c("disp", "hp")
)
wb$add_mschart(sheet = 2, graph = data_plot)
expect_equal(nrow(wb$charts), 2L)
exp <- "xdr:absoluteAnchor"
got <- xml_node_name(unlist(wb$drawings), "xdr:wsDr")
expect_equal(exp, got)
})
test_that("multiple charts on a sheet work as expected", {
skip_if_not_installed("mschart")
require(mschart)
## Add mschart to worksheet (adds data and chart)
scatter <- ms_scatterchart(
data = iris,
x = "Sepal.Length",
y = "Sepal.Width",
group = "Species"
)
scatter <- chart_settings(scatter, scatterstyle = "marker")
wb <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_add_mschart(dims = "F4:L20", graph = scatter) %>%
wb_add_mschart(dims = "F24:L40", graph = scatter) %>%
wb_add_worksheet() %>%
wb_add_mschart(dims = "F4:L20", graph = scatter) %>%
wb_add_mschart(dims = "F24:L40", graph = scatter)
exp <- c(TRUE, TRUE)
got <- grepl(pattern = "<c:chart xmlns:c=\"http://schemas.openxmlformats.org/drawingml/2006/chart\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"rId1\"/>", wb$drawings)
expect_equal(exp, got)
got <- grepl(pattern = "<c:chart xmlns:c=\"http://schemas.openxmlformats.org/drawingml/2006/chart\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"rId2\"/>", wb$drawings)
expect_equal(exp, got)
})
test_that("various image functions work as expected", {
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
wb <- wb_workbook()$
add_worksheet()$
add_image(file = img, width = 6, height = 5, dims = NULL)$
add_worksheet()$
add_image(dims = "B2", file = img, rowOffset = 90000, colOffset = 90000)$
add_worksheet()$
add_image(dims = "B2:K8", file = img)
exp <- c("xdr:absoluteAnchor", "xdr:oneCellAnchor", "xdr:twoCellAnchor")
got <- wb$drawings %>% xml_node_name(level1 = "xdr:wsDr")
expect_equal(exp, got)
exp <- "<xdr:from><xdr:col>1</xdr:col><xdr:colOff>90000</xdr:colOff><xdr:row>1</xdr:row><xdr:rowOff>90000</xdr:rowOff></xdr:from>"
got <- wb$drawings[[2]] %>% xml_node("xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
exp <- "<xdr:from><xdr:col>1</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>1</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- wb$drawings[[3]] %>% xml_node("xdr:wsDr", "xdr:twoCellAnchor", "xdr:from")
expect_equal(exp, got)
exp <- "<xdr:to><xdr:col>11</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>8</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:to>"
got <- wb$drawings[[3]] %>% xml_node("xdr:wsDr", "xdr:twoCellAnchor", "xdr:to")
expect_equal(exp, got)
expect_warning(
wb$add_worksheet()$add_image(file = img, width = 6, height = 5, dims = NULL, startRow = 2, startCol = 2),
"'start_col/start_row' is deprecated."
)
})
test_that("image relships work with comment", {
wb <- wb_workbook()
wb$add_worksheet("Sheet 1")
c1 <- wb_comment(text = "this is a comment", author = "", visible = TRUE)
wb$add_comment(dims = "B12", comment = c1)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
wb$add_image("Sheet 1", dims = "C5", file = img, width = 6, height = 5)
exp <- "<drawing r:id=\"rId3\"/>"
got <- wb$worksheets[[1]]$drawing
expect_equal(exp, got)
})
test_that("start_col/start_row works as expected", {
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, start_row = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>0</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, startRow = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>0</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, start_col = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>0</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, startCol = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>0</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, start_col = 5, start_row = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, startCol = 5, startRow = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
})
test_that("workbook themes work", {
wb <- wb_workbook()$add_worksheet()
exp <- "Aptos Narrow"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
wb <- wb_workbook(theme = "Office 2013 - 2022 Theme")$add_worksheet()
exp <- "Calibri"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
wb <- wb_workbook(theme = "Old Office Theme")$add_worksheet()
exp <- "Calibri"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
wb <- wb_workbook(theme = 1)$add_worksheet()
exp <- "Rockwell"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
expect_message(
wb <- wb_workbook(theme = "Foo")$add_worksheet(),
"theme Foo not found falling back to default theme"
)
exp <- "Aptos Narrow"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
})
test_that("changing sheet names works with named regions", {
filename <- testfile_path("namedRegions2.xlsx")
wb <- wb_load(filename)
wb$set_sheet_names("Sheet1", "new name")
wb$set_sheet_names("Sheet with space", "Sheet_without_space")
exp <- c(
"<definedName name=\"barref\" localSheetId=\"0\">'Sheet_without_space'!$B$4</definedName>",
"<definedName name=\"barref\" localSheetId=\"1\">'new name'!$B$4</definedName>"
)
got <- wb$workbook$definedNames[seq_len(2)]
expect_equal(exp, got)
})
test_that("numfmt in pivot tables works", {
## example code
df <- data.frame(
Plant = c("A", "C", "C", "B", "B", "C", "C", "C", "A", "C"),
Location = c("E", "F", "E", "E", "F", "E", "E", "G", "E", "F"),
Status = c("good", "good", "good", "good", "good", "good", "good", "good", "good", "bad"),
Units = c(0.95, 0.95, 0.95, 0.95, 0.89, 0.89, 0.94, 0.94, 0.9, 0.9),
stringsAsFactors = FALSE
)
## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, startCol = 1, startRow = 2)
df <- wb_data(wb, 1, dims = "A2:D10")
wb$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units")$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units",
params = list(numfmt = c(formatCode = "#,###0"), sort_row = "ascending"))$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units",
params = list(numfmt = c(numfmt = 10), sort_row = "descending"))
exp <- c(
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\"/>",
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\" numFmtId=\"165\"/>",
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\" numFmtId=\"10\"/>"
)
got <- xml_node(wb$pivotTables, "pivotTableDefinition", "dataFields", "dataField")
expect_equal(exp, got)
## sort by column and row
df <- mtcars
## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, start_col = 1, start_row = 2)
df <- wb_data(wb)
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"), params = list(sort_row = 1, sort_col = -2))
wb$add_pivot_table(df, dims = "A3", rows = "gear",
filter = c("cyl"), data = c("vs", "am"),
params = list(sort_row = "descending"))
exp <- c(
"<pivotField axis=\"axisRow\" showAll=\"0\" sortType=\"ascending\"><items count=\"4\"><item x=\"1\"/><item x=\"0\"/><item x=\"2\"/><item t=\"default\"/></items><autoSortScope><pivotArea dataOnly=\"0\" outline=\"0\" fieldPosition=\"0\"><references count=\"1\"><reference field=\"4294967294\" count=\"1\" selected=\"0\"><x v=\"0\"/></reference></references></pivotArea></autoSortScope></pivotField>",
"<pivotField axis=\"axisCol\" showAll=\"0\" sortType=\"descending\"><items count=\"4\"><item x=\"1\"/><item x=\"0\"/><item x=\"2\"/><item t=\"default\"/></items><autoSortScope><pivotArea dataOnly=\"0\" outline=\"0\" fieldPosition=\"0\"><references count=\"1\"><reference field=\"4294967294\" count=\"1\" selected=\"0\"><x v=\"1\"/></reference></references></pivotArea></autoSortScope></pivotField>"
)
got <- xml_node(wb$pivotTables[1], "pivotTableDefinition", "pivotFields", "pivotField")[c(2, 10)]
expect_equal(exp, got)
expect_warning(
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"), params = list(sort_row = 1, sort_col = -7)),
"invalid sort position found"
)
expect_error(
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"),
params = list(numfmt = c(numfmt = 10))),
"length of numfmt and data does not match"
)
### add sortType only to those pivot fields that are sorted
## sort by column and row
df <- mtcars
## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, start_col = 1, start_row = 2)
df <- wb_data(wb)
wb$add_pivot_table(
df,
dims = "A3",
rows = c("cyl", "am"),
cols = c("gear", "carb"),
data = c("disp", "mpg"),
params = list(sort_row = 1,
sort_col = -2)
)
exp <- c("", "ascending", "", "", "", "", "", "", "", "descending", "")
got <- rbindlist(xml_attr(wb$pivotTables, "pivotTableDefinition", "pivotFields", "pivotField"))$sortType
expect_equal(exp, got)
})
test_that("sort_item with pivot tables works", {
wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_add_data(x = mtcars)
df <- wb_data(wb, sheet = 1)
expect_silent(
wb_add_pivot_table(wb, df, dims = "A3",
filter = "am", rows = "cyl", cols = "gear", data = "disp",
params = list(sort_item = list(gear = c(3, 2, 1)))
)
)
expect_warning(
wb_add_pivot_table(wb, df, dims = "A3",
filter = "am", rows = "cyl", cols = "gear", data = "disp",
params = list(sort_item = list(gear = seq_len(4)))
),
"Length of sort order for 'gear' does not match required length. Is 4, needs 3."
)
})
test_that("wbWorkbook print works", {
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_worksheet("Sheet 1 (1)")$
add_worksheet("Sheet & NoSheet")
exp <- c("A Workbook object.",
" ",
"Worksheets:",
" Sheets: Sheet 1, Sheet 1 (1), Sheet & NoSheet ",
" Write order: 1, 2, 3")
got <- capture.output(wb)
expect_equal(exp, got)
})
test_that("genBaseWorkbook() works", {
# kinda superfluous. if it wouldn't work openxlsx2 would be broken
exp <- c(
"fileVersion", "fileSharing", "workbookPr", "alternateContent",
"revisionPtr", "absPath", "workbookProtection", "bookViews",
"sheets", "functionGroups", "externalReferences", "definedNames",
"calcPr", "oleSize", "customWorkbookViews", "pivotCaches", "smartTagPr",
"smartTagTypes", "webPublishing", "fileRecoveryPr", "webPublishObjects",
"extLst"
)
expect_equal(
names(genBaseWorkbook()),
exp
)
})
test_that("subsetting wb_data() works", {
wb <- wb_workbook()$
add_worksheet()$
add_data(x = head(esoph, 3))
df1 <- wb_data(wb)
exp <- data.frame(alcgp = rep("0-39g/day", 3), stringsAsFactors = FALSE)
got <- df1[, 2, drop = FALSE]
expect_equal(exp, got, ignore_attr = TRUE)
exp <- rep("0-39g/day", 3)
got <- unclass(df1[, 2])
expect_equal(exp, got)
exp <- structure(
list(
agegp = c("25-34", "25-34"),
alcgp = c("0-39g/day", "0-39g/day")
),
row.names = 2:3,
dims = structure(
list(
A = c("A1", "A2", "A3"),
B = c("B1", "B2", "B3")
),
row.names = c(NA, 3L),
class = "data.frame"),
sheet = "Sheet 1"
)
got <- unclass(df1[1:2, 1:2])
expect_equal(exp, got)
expect_null(attributes(df1[c("agegp")]))
exp <- list(
names = "agegp",
row.names = 2:4,
class = c("wb_data", "data.frame"),
dims = structure(
list(A = c("A1", "A2", "A3", "A4")),
row.names = c(NA, 4L),
class = "data.frame"
),
sheet = "Sheet 1"
)
got <- attributes(df1[c("agegp"), drop = FALSE])
expect_equal(exp, got)
exp <- list(
names = c("alcgp", "tobgp", "ncases"),
row.names = 2:4,
class = c("wb_data", "data.frame"),
dims = structure(
list(
B = c("B1", "B2", "B3", "B4"),
C = c("C1", "C2", "C3", "C4"),
D = c("D1", "D2", "D3", "D4")
),
row.names = c(NA, 4L),
class = "data.frame"
),
sheet = "Sheet 1"
)
got <- attributes(df1[c("alcgp", "tobgp", "ncases")])
expect_equal(exp, got)
exp <- list(
names = c("agegp", "alcgp", "tobgp", "ncases", "ncontrols"),
row.names = 3:4,
class = c("wb_data", "data.frame"),
dims = structure(
list(
A = c("A1", "A3", "A4"),
B = c("B1", "B3", "B4"),
C = c("C1", "C3", "C4"),
D = c("D1", "D3", "D4"),
E = c("E1", "E3", "E4")
),
row.names = c(1L, 3L, 4L),
class = "data.frame"
),
sheet = "Sheet 1"
)
got <- attributes(df1[-1, ])
expect_equal(exp, got)
exp <- list(
names = c("agegp", "alcgp", "tobgp", "ncases", "ncontrols"),
row.names = 2:3,
class = c("wb_data", "data.frame"),
dims = structure(
list(
A = c("A1", "A2", "A3"),
B = c("B1", "B2", "B3"),
C = c("C1", "C2", "C3"),
D = c("D1", "D2", "D3"),
E = c("E1", "E2", "E3")
),
row.names = c(NA, 3L),
class = "data.frame"
),
sheet = "Sheet 1")
got <- attributes(df1[-nrow(df1), ])
expect_equal(exp, got)
})
test_that("adding mips section works", {
# helper function to mock a mips section
create_fake_mips <- function() {
guid <- st_guid()
lid <- tolower(gsub("[{}]", "", guid))
mips_xml <- sprintf(
'<property fmtid="%s" pid="2" name="MSIP_Label_%s_Enabled">
<vt:lpwstr>true</vt:lpwstr>
</property>
<property fmtid="%s" pid="3" name="MSIP_Label_%s_SetDate">
<vt:lpwstr>2024-04-07T14:27:12Z</vt:lpwstr>
</property>
<property fmtid="%s" pid="4" name="MSIP_Label_%s_Method">
<vt:lpwstr>Privileged</vt:lpwstr>
</property>
<property fmtid="%s" pid="5" name="MSIP_Label_%s_Name">
<vt:lpwstr>General</vt:lpwstr>
</property>
<property fmtid="%s" pid="6" name="MSIP_Label_%s_SiteId">
<vt:lpwstr>%s</vt:lpwstr>
</property>
<property fmtid="%s" pid="7" name="MSIP_Label_%s_ActionId">
<vt:lpwstr>%s</vt:lpwstr>
</property>
<property fmtid="%s" pid="8" name="MSIP_Label_%s_ContentBits">
<vt:lpwstr>0</vt:lpwstr>
</property>',
guid, lid,
guid, lid,
guid, lid,
guid, lid,
guid, lid, lid,
guid, lid, lid,
guid, lid
)
read_xml(mips_xml, pointer = FALSE)
}
fmips <- create_fake_mips()
wb <- wb_workbook()$add_worksheet()$add_mips(xml = fmips)
expect_message(wb_get_mips(wb, quiet = FALSE), "Found MIPS section: General")
expect_equal(fmips, wb$get_mips())
tmp <- temp_xlsx()
wb$save(tmp)
expect_equal(fmips, wb_load(tmp)$get_mips())
wb <- wb_load(tmp)
expect_message(wb$add_mips(xml = fmips), "File has duplicated custom section")
expect_equal(fmips, wb$get_mips())
op <- options("openxlsx2.mips_xml_string" = fmips)
on.exit(options(op), add = TRUE)
wb <- wb_workbook()$add_worksheet()$add_mips(xml = fmips)
wb <- wb_workbook()$add_worksheet()$add_mips()
expect_equal(fmips, wb$get_mips())
wb <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_set_properties(
custom = list(
Software = "openxlsx2",
Version = 1.5,
ReleaseDate = as.Date("2024-03-26"),
CRAN = TRUE,
DEV = FALSE
)
)
wb <- wb_workbook()$add_worksheet()$
set_properties(
custom = list(int = 1L)
)
expect_silent(wb$add_mips())
exp <- "3"
got <- rbindlist(xml_attr(wb$get_mips(single_xml = FALSE)[1], "property"))$pid
expect_equal(exp, got)
})
test_that("handling mips in docMetadata works", {
tmp <- temp_xlsx()
xml <- '<clbl:labelList xmlns:clbl=\"http://schemas.microsoft.com/office/2020/mipLabelMetadata\"><clbl:label foo="bar"/></clbl:labelList>'
wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_add_mips(xml = xml)
wb$docMetadata
wb$save(tmp)
rm(wb)
wb <- wb_load(tmp)
expect_equal(xml, wb$docMetadata)
})
test_that("using and removing secondary bookviews works", {
wb <- wb_workbook() %>% wb_add_worksheet()
# set the first and second bookview (horizontal split)
wb <- wb %>%
wb_set_bookview(window_height = 17600, window_width = 15120, x_window = 15120, y_window = 760) %>%
wb_set_bookview(window_height = 17600, window_width = 15040, x_window = 0, y_window = 760, view = 2)
exp <- structure(
list(windowHeight = c("17600", "17600"), windowWidth = c("15120", "15040"),
xWindow = c("15120", "0"), yWindow = c("760", "760")),
row.names = c(NA, 2L), class = "data.frame")
got <- wb %>% wb_get_bookview()
expect_equal(exp, got)
# remove the first view
exp <- structure(
list(windowHeight = c("17600"), windowWidth = c("15040"),
xWindow = c("0"), yWindow = c("760")),
row.names = c(NA, 1L), class = "data.frame")
got <- wb %>% wb_remove_bookview(view = 1) %>% wb_get_bookview()
expect_equal(exp, got)
# keep only the first view
exp <- structure(
list(windowHeight = c("17600"), windowWidth = c("15120"),
xWindow = c("15120"), yWindow = c("760")),
row.names = c(NA, 1L), class = "data.frame")
got <- wb %>% wb_remove_bookview(view = -1) %>% wb_get_bookview()
expect_equal(exp, got)
wb <- wb_workbook() %>% wb_add_worksheet()
exp <- structure(list(), row.names = c(NA, 1L), names = character(0), class = "data.frame")
got <- wb %>% wb_remove_bookview(view = 1) %>% wb_get_bookview()
expect_equal(exp, got)
expect_error(
wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_set_bookview(view = 3),
"There is more than one workbook view missing. Available: 1. Requested: 3"
)
})
JanMarvin/openxlsx2 documentation built on April 17, 2025, 6:12 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
testsetup()
test_that("Workbook class", {
expect_null(assert_workbook(wb_workbook()))
})
test_that("wb_set_col_widths works", {
# TODO use wb$wb_set_col_widths()
wb <- wbWorkbook$new()
wb$add_worksheet("test")
wb$add_data("test", mtcars)
# set column width to 12
expect_silent(wb$set_col_widths("test", widths = 12L, cols = seq_along(mtcars)))
expect_equal(
wb$worksheets[[1]]$cols_attr,
"<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"12.711\"/>"
)
# wrong sheet
expect_error(wb$set_col_widths("test2", widths = 12L, cols = seq_along(mtcars)))
# reset the column with, we do not provide an option ot remove the column entry
expect_silent(wb$set_col_widths("test", cols = seq_along(mtcars)))
expect_equal(
wb$worksheets[[1]]$cols_attr,
"<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.141\"/>"
)
# create column width for column 25
expect_silent(wb$set_col_widths("test", cols = "Y", widths = 22))
expect_equal(
c("<col min=\"1\" max=\"11\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.141\"/>",
"<col min=\"12\" max=\"24\" width=\"8.43\"/>",
"<col min=\"25\" max=\"25\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"22.711\"/>"),
wb$worksheets[[1]]$cols_attr
)
wb <- wb_workbook()$
add_worksheet()$
set_col_widths(cols = 1:10, widths = (8:17) + .5)$
add_data(x = rbind(8:17), col_names = FALSE)
exp <- c(
"<col min=\"1\" max=\"1\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"9.211\"/>",
"<col min=\"2\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"10.211\"/>",
"<col min=\"3\" max=\"3\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"11.211\"/>",
"<col min=\"4\" max=\"4\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"12.211\"/>",
"<col min=\"5\" max=\"5\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"13.211\"/>",
"<col min=\"6\" max=\"6\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"14.211\"/>",
"<col min=\"7\" max=\"7\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"15.211\"/>",
"<col min=\"8\" max=\"8\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"16.211\"/>",
"<col min=\"9\" max=\"9\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"17.211\"/>",
"<col min=\"10\" max=\"10\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"18.211\"/>"
)
got <- wb$worksheets[[1]]$cols_attr
expect_equal(exp, got)
wb <- wb_workbook()$add_worksheet()
wb$worksheets[[1]]$cols_attr <- c(
"<col min=\"1\" max=\"17\" width=\"30.77734375\" style=\"16\" customWidth=\"1\"/>",
"<col min=\"18\" max=\"16384\" width=\"8.88671875\" style=\"16\"/>"
)
expect_silent(wb$set_col_widths(cols = 19, widths = 9))
})
test_that("set_col_widths informs when inconsistent lengths are supplied", {
wb <- wbWorkbook$new()
wb$add_worksheet("test")
expect_warning(wb$set_col_widths(cols = c(1, 2, 3), widths = c(2, 3)), "compatible length")
expect_error(wb$set_col_widths(cols = "Y", widths = 1:2), "More widths than column")
expect_error(wb$set_col_widths("test", cols = "Y", hidden = 1:2), "hidden argument is longer")
expect_warning(wb$set_col_widths(cols = c("X", "Y", "Z"), hidden = c(1, 0)), "compatible length")
})
test_that("merged cells are excluded from col width `auto` calculation", {
wb <- wb_workbook()$add_worksheet()$
add_data(x = "the `cars` dataset", dims = "A1")$
merge_cells(dims = "A1:B1")$
add_data(x = head(cars), dims = "A2")$
set_col_widths(cols = "A:B", width = "auto")
exp <- c(
"<col min=\"1\" max=\"1\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"6.711\"/>",
"<col min=\"2\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"5.711\"/>"
)
got <- wb$worksheets[[1]]$cols_attr
expect_equal(exp, got)
})
test_that("option maxWidth works", {
op <- options("openxlsx2.maxWidth" = 6)
on.exit(options(op), add = TRUE)
wb <- wb_workbook()$add_worksheet()$add_data(x = data.frame(
x = paste0(letters, collapse = ""),
y = paste0(letters, collapse = "")
))$set_col_widths(cols = 1:2, widths = "auto")
exp <- "<col min=\"1\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"6\"/>"
got <- wb$worksheets[[1]]$cols_attr
expect_equal(exp, got)
})
# order -------------------------------------------------------------------
test_that("$set_order() works", {
wb <- wb_workbook()
wb$add_worksheet("a")
wb$add_worksheet("b")
wb$add_worksheet("c")
expect_identical(wb$sheetOrder, 1:3)
exp <- letters[1:3]
names(exp) <- exp
expect_identical(wb$get_sheet_names(), exp)
wb$set_order(3:1)
expect_identical(wb$sheetOrder, 3:1)
exp <- letters[3:1]
names(exp) <- exp
expect_identical(wb$get_sheet_names(), exp)
})
# sheet names -------------------------------------------------------------
test_that("$set_sheet_names() and $get_sheet_names() work", {
wb <- wb_workbook()$add_worksheet()$add_worksheet()
wb$set_sheet_names(new = c("a", "b & c"))
# return a names character vector
res <- wb$get_sheet_names()
exp <- c(a = "a", "b & c" = "b & c")
expect_identical(res, exp)
# return a names character vector
res <- wb$get_sheet_names(escape = TRUE)
exp <- c(a = "a", "b & c" = replace_legal_chars("b & c"))
expect_identical(res, exp)
# should be able to check the original values, too
res <- wb$.__enclos_env__$private$get_sheet_index("b & c")
expect_identical(res, 2L)
# make sure that it works silently
wb <- wb_load(file = system.file("extdata", "oxlsx2_sheet.xlsx", package = "openxlsx2"))
expect_silent(wb$set_sheet_names(old = "SUM", new = "Sheet 1"))
exp <- c(`Sheet 1` = "Sheet 1")
got <- wb$get_sheet_names()
expect_equal(exp, got)
})
# data validation ---------------------------------------------------------
test_that("data validation", {
temp <- temp_xlsx()
df <- data.frame(
"d" = as.Date("2016-01-01") + -5:5,
"t" = as.POSIXct("2016-01-01") + -5:5 * 10000
)
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = iris)$
# whole numbers are fine
add_data_validation(dims = "A2:C151", type = "whole",
operator = "between", value = c(1, 9)
)$
# text width 7-9 is fine
add_data_validation(dims = "E2:E151", type = "textLength",
operator = "between", value = c(7, 9)
)$
## Date and Time cell validation
add_worksheet("Sheet 2")$
add_data_table(x = df)$
# date >= 2016-01-01 is fine
add_data_validation(dims = "A2:A12", type = "date",
operator = "greaterThanOrEqual", value = as.Date("2016-01-01")
)$
# a few timestamps are fine
add_data_validation(dims = "B2:B12", type = "time",
operator = "between", value = df$t[c(4, 8)]
)$
## validate list: validate inputs on one sheet with another
add_worksheet("Sheet 3")$
add_data_table(x = iris[1:30, ])$
add_worksheet("Sheet 4")$
add_data(x = sample(iris$Sepal.Length, 10))$
add_data_validation("Sheet 3", dims = "A2:A31", type = "list",
value = "'Sheet 4'!$A$1:$A$10")
exp <- c(
"<dataValidation type=\"whole\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:C151\"><formula1>1</formula1><formula2>9</formula2></dataValidation>",
"<dataValidation type=\"textLength\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"E2:E151\"><formula1>7</formula1><formula2>9</formula2></dataValidation>"
)
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
exp <- c(
"<dataValidation type=\"date\" operator=\"greaterThanOrEqual\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A12\"><formula1>42370</formula1></dataValidation>",
"<dataValidation type=\"time\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"B2:B12\"><formula1>42369.7685185185</formula1><formula2>42370.2314814815</formula2></dataValidation>"
)
got <- wb$worksheets[[2]]$dataValidations
expect_equal(exp, got)
exp <- c(
"<dataValidation type=\"list\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A31\"><formula1>'Sheet 4'!$A$1:$A$10</formula1></dataValidation>"
)
got <- wb$worksheets[[3]]$dataValidations
expect_equal(exp, got)
wb$save(temp)
wb2 <- wb_load(temp)
# wb2$add_data_validation("Sheet 3", col = 2, rows = 2:31, type = "list",
# value = "'Sheet 4'!$A$1:$A$10")
# wb2$save(temp)
expect_equal(
wb$worksheets[[1]]$dataValidations,
wb2$worksheets[[1]]$dataValidations
)
expect_equal(
wb$worksheets[[2]]$dataValidations,
wb2$worksheets[[2]]$dataValidations
)
expect_equal(
wb$worksheets[[3]]$dataValidations,
wb2$worksheets[[3]]$dataValidations
)
expect_warning(
wb2$add_data_validation("Sheet 3", cols = 2, rows = 2:31, type = "list",
value = "'Sheet 4'!$A$1:$A$10"),
"'cols/rows' is deprecated."
)
exp <- c(
"<dataValidation type=\"list\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A31\"><formula1>'Sheet 4'!$A$1:$A$10</formula1></dataValidation>",
"<dataValidation type=\"list\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"B2:B31\"><formula1>'Sheet 4'!$A$1:$A$10</formula1></dataValidation>"
)
got <- wb2$worksheets[[3]]$dataValidations
expect_equal(exp, got)
### tests if conditions
# test col2int
expect_warning(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
# whole numbers are fine
add_data_validation(cols = "A", rows = 2:151, type = "whole",
operator = "between", value = c(1, 9)
),
"'cols/rows' is deprecated."
)
exp <- "<dataValidation type=\"whole\" operator=\"between\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A2:A151\"><formula1>1</formula1><formula2>9</formula2></dataValidation>"
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
# to many values
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
add_data_validation(dims = "A2:A151", type = "whole",
operator = "between", value = c(1, 9, 19)
),
"length <= 2"
)
# wrong type
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
add_data_validation(dims = "A2:A151", type = "even",
operator = "between", value = c(1, 9)
),
"Invalid 'type' argument!"
)
# wrong operator
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
add_data_validation(dims = "A2:A151", type = "whole",
operator = "lower", value = c(1, 9)
),
"Invalid 'operator' argument!"
)
# wrong value for date
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
# whole numbers are fine
add_data_validation(dims = "A2:A12", type = "date",
operator = "greaterThanOrEqual", value = 7
),
"If type == 'date' value argument must be a Date vector"
)
# wrong value for time
expect_error(
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data_table(x = head(iris))$
# whole numbers are fine
add_data_validation(dims = "A2:A12", type = "time",
operator = "greaterThanOrEqual", value = 7
),
"If type == 'time' value argument must be a POSIXct or POSIXlt vector."
)
# some more options
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data(x = c(-1:1), colNames = FALSE)$
# whole numbers are fine
add_data_validation(dims = "A1:A3", type = "whole",
operator = "greaterThan", value = c(0),
errorStyle = "information", errorTitle = "ERROR!",
error = "Some error ocurred!",
promptTitle = "PROMPT!",
prompt = "Choose something!"
)
exp <- "<dataValidation type=\"whole\" operator=\"greaterThan\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A1:A3\" errorStyle=\"information\" errorTitle=\"ERROR!\" error=\"Some error ocurred!\" promptTitle=\"PROMPT!\" prompt=\"Choose something!\"><formula1>0</formula1></dataValidation>"
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
# add custom data
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_data(x = data.frame(x = 1, y = 2), colNames = FALSE)$
# whole numbers are fine
add_data_validation(dims = "A1:A3", type = "custom", value = "A1=B1")
exp <- "<dataValidation type=\"custom\" allowBlank=\"1\" showInputMessage=\"1\" showErrorMessage=\"1\" sqref=\"A1:A3\"><formula1>A1=B1</formula1></dataValidation>"
got <- wb$worksheets[[1]]$dataValidations
expect_equal(exp, got)
})
test_that("clone worksheet", {
## Dummy tests - not sure how to test these from R ##
# # clone chartsheet ----------------------------------------------------
fl <- testfile_path("mtcars_chart.xlsx")
wb <- wb_load(fl)
# wb$get_sheet_names() # chartsheet has no named name?
expect_silent(wb$clone_worksheet(1, "Clone 1"))
expect_s3_class(wb$worksheets[[5]], "wbChartSheet")
# wb$open()
# clone pivot table and drawing -----------------------------------------
fl <- testfile_path("loadExample.xlsx")
wb <- wb_load(fl)
expect_silent(wb$clone_worksheet(4, "Clone 1"))
# sheets 4 & 5 both reference the same pivot table in different drawing
# once the file is opened, both pivot tables behave independently
exp <- c(
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable\" Target=\"../pivotTables/pivotTable2.xml\"/>",
"<Relationship Id=\"rId2\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing\" Target=\"../drawings/drawing5.xml\"/>"
)
got <- wb$worksheets_rels[[5]]
expect_equal(exp, got)
# wb$open()
# clone drawing ---------------------------------------------------------
wb <- wb_load(fl)
expect_silent(wb$clone_worksheet("testing", "Clone1"))
expect_false(identical(wb$worksheets_rels[2], wb$worksheets_rels[5]))
# wb$open()
# clone sheet with table ------------------------------------------------
fl <- testfile_path("tableStyles.xlsx")
wb <- wb_load(fl)
expect_silent(wb$clone_worksheet(1, "clone"))
expect_false(identical(wb$tables$tab_xml[1], wb$tables$tab_xml[2]))
# wb$open()
# clone sheet with chart ------------------------------------------------
fl <- testfile_path("mtcars_chart.xlsx")
wb <- wb_load(fl)
wb$clone_worksheet(2, "Clone 1")
expect_match(wb$charts$chart[2], "test")
expect_match(wb$charts$chart[3], "'Clone 1'")
# wb$open()
# clone slicer ----------------------------------------------------------
fl <- testfile_path("loadExample.xlsx")
wb <- wb_load(fl)
expect_warning(wb$clone_worksheet("IrisSample", "Clone1"),
"Cloning slicers is not yet supported. It will not appear on the sheet.")
# wb$open()
})
test_that("set and remove row heights work", {
## add row heights
wb <- wb_workbook()$
add_worksheet()$
set_row_heights(
rows = c(1, 4, 22, 2, 19),
heights = c(24, 28, 32, 42, 33)
)
exp <- structure(
list(
customHeight = c("1", "1", "1", "1", "1"),
ht = c("24", "42", "28", "33", "32"),
r = c("1", "2", "4", "19", "22")
),
row.names = c(1L, 2L, 4L, 19L, 22L),
class = "data.frame"
)
got <- wb$worksheets[[1]]$sheet_data$row_attr[c(1, 2, 4, 19, 22), c("customHeight", "ht", "r")]
expect_equal(exp, got)
## remove row heights
wb$remove_row_heights(rows = 1:21)
exp <- structure(
list(
customHeight = c("", "", "", "", "1"),
ht = c("", "", "", "", "32"),
r = c("1", "2", "4", "19", "22")
),
row.names = c(1L, 2L, 4L, 19L, 22L),
class = "data.frame"
)
got <- wb$worksheets[[1]]$sheet_data$row_attr[c(1, 2, 4, 19, 22), c("customHeight", "ht", "r")]
expect_equal(exp, got)
expect_warning(
wb$add_worksheet()$remove_row_heights(rows = 1:3),
"There are no initialized rows on this sheet"
)
wb <- wb_workbook()$
add_worksheet()$
add_data(x = mtcars)$
set_row_heights(rows = 5:15, hidden = TRUE)
exp <- structure(
c(22L, `1` = 11L),
dim = 2L,
dimnames = structure(
list(
c("", "1")
),
names = ""
),
class = "table"
)
got <- table(wb$worksheets[[1]]$sheet_data$row_attr$hidden)
expect_equal(exp, got)
})
test_that("set and remove row heights work", {
rows <- c(99999, 100000, 100001)
wb <- wb_workbook()$
add_worksheet()$
add_data(x = 1:3, dims = "A99999:A100001")$
set_row_heights(
rows = rows,
heights = c(24, 28, 32)
)
exp <- c("99999", "100000", "100001")
got <- wb$worksheets[[1]]$sheet_data$row_attr$r
expect_equal(exp, got)
wb$remove_row_heights(rows = rows)
})
test_that("add_drawing works", {
skip_if_not_installed("rvg")
skip_if_not_installed("ggplot2")
require(rvg)
require(ggplot2)
tmp <- tempfile(fileext = "drawing.xml")
## rvg example
dml_xlsx(file = tmp, fonts = list(sans = "Bradley Hand"))
print(
ggplot(data = iris,
mapping = aes(x = Sepal.Length, y = Petal.Width)) +
geom_point() + labs(title = "With font Bradley Hand") +
theme_minimal(base_family = "sans", base_size = 18)
)
dev.off()
wb <- wb_workbook()$
add_worksheet()$
add_drawing(xml = tmp)$
add_drawing(xml = tmp, dims = "A1:H10")$
add_drawing(xml = tmp, dims = "L1")$
add_drawing(xml = tmp, dims = NULL)$
add_drawing(xml = tmp, dims = "L19")
expect_length(wb$drawings, 1L)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_silent(wb$add_image(file = img))
})
test_that("add_drawing works", {
skip_if_not_installed("mschart")
require(mschart)
# write data starting at B2
wb <- wb_workbook()$add_worksheet()$
add_data(x = mtcars, dims = "B2")$
add_data(x = data.frame(name = rownames(mtcars)), dims = "A2")
# create wb_data object this will tell this mschart from this PR to create a file corresponding to openxlsx2
dat <- wb_data(wb, 1)
expect_equal(c(32L, 12L), dim(dat))
dat <- wb_data(wb, 1, dims = "A2:G6")
exp <- structure(
list(
name = c("Mazda RX4", "Mazda RX4 Wag", "Datsun 710", "Hornet 4 Drive"),
mpg = c(21, 21, 22.8, 21.4),
cyl = c(6, 6, 4, 6),
disp = c(160, 160, 108, 258),
hp = c(110, 110, 93, 110),
drat = c(3.9, 3.9, 3.85, 3.08),
wt = c(2.62, 2.875, 2.32, 3.215)
),
row.names = 3:6,
class = c("wb_data", "data.frame"),
dims = structure(
list(
A = c("A2", "A3", "A4", "A5", "A6"),
B = c("B2", "B3", "B4", "B5", "B6"),
C = c("C2", "C3", "C4", "C5", "C6"),
D = c("D2", "D3", "D4", "D5", "D6"),
E = c("E2", "E3", "E4", "E5", "E6"),
F = c("F2", "F3", "F4", "F5", "F6"),
G = c("G2", "G3", "G4", "G5", "G6")
),
row.names = 2:6,
class = "data.frame"),
sheet = "Sheet 1")
expect_equal(exp, dat)
# call ms_scatterplot
scatter_plot <- ms_scatterchart(
data = dat,
x = "mpg",
y = c("disp", "hp"),
labels = c("disp", "hp")
)
# add the scatterplots to the data
wb <- wb %>%
wb_add_mschart(dims = "F4:L20", graph = scatter_plot)
expect_equal(NROW(wb$charts), 1L)
chart_01 <- ms_linechart(
data = us_indus_prod,
x = "date", y = "value",
group = "type"
)
wb$add_worksheet()
wb$add_mschart(dims = "F4:L20", graph = chart_01)
exp <- list(
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/chart\" Target=\"../charts/chart1.xml\"/>",
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/chart\" Target=\"../charts/chart2.xml\"/>"
)
got <- wb$drawings_rels
expect_equal(exp, got)
# write data starting at B2
wb <- wb_workbook()$
add_worksheet()$add_data(x = mtcars)$
add_worksheet()$add_data(x = mtcars)$
add_worksheet()$add_data(x = mtcars)$
add_worksheet()$add_data(x = mtcars)$
add_mschart(dims = "F4:L20", 2, graph = chart_01)$
add_mschart(dims = "F4:L20", 3, graph = chart_01)
exp <- list(
character(0),
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing\" Target=\"../drawings/drawing1.xml\"/>",
"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing\" Target=\"../drawings/drawing2.xml\"/>",
character(0)
)
got <- wb$worksheets_rels
expect_equal(exp, got)
## write different anchors
wb <- wb_workbook()$
add_worksheet()$add_data(x = mtcars)
scatter_plot <- ms_scatterchart(
data = wb_data(wb),
x = "mpg",
y = c("disp", "hp")
)
wb$
add_mschart(graph = scatter_plot)$
add_mschart(dims = "A1", graph = scatter_plot)$
add_mschart(dims = "F4:L20", graph = scatter_plot)
drawings <- as.character(wb$drawings)
expect_match(drawings, "absoluteAnchor")
expect_match(drawings, "oneCellAnchor")
expect_match(drawings, "twoCellAnchor")
})
test_that("add_chartsheet works", {
skip_if_not_installed("mschart")
require(mschart)
wb <- wb_workbook()$
add_worksheet("A & B")$
add_data(x = mtcars)$
add_chartsheet(tabColour = "red")
dat <- wb_data(wb, 1, dims = "A1:E6")
# call ms_scatterplot
data_plot <- ms_scatterchart(
data = dat,
x = "mpg",
y = c("disp", "hp"),
labels = c("disp", "hp")
)
wb$add_mschart(graph = data_plot)
expect_equal(nrow(wb$charts), 1)
expect_match(wb$charts$chart, "A & B")
expect_true(wb$is_chartsheet[[2]])
# add new worksheet and replace chart on chartsheet
wb$add_worksheet()$add_data(x = mtcars)
dat <- wb_data(wb, dims = "A1:E1;A7:E15")
data_plot <- ms_scatterchart(
data = dat,
x = "mpg",
y = c("disp", "hp"),
labels = c("disp", "hp")
)
wb$add_mschart(sheet = 2, graph = data_plot)
expect_equal(nrow(wb$charts), 2L)
exp <- "xdr:absoluteAnchor"
got <- xml_node_name(unlist(wb$drawings), "xdr:wsDr")
expect_equal(exp, got)
})
test_that("multiple charts on a sheet work as expected", {
skip_if_not_installed("mschart")
require(mschart)
## Add mschart to worksheet (adds data and chart)
scatter <- ms_scatterchart(
data = iris,
x = "Sepal.Length",
y = "Sepal.Width",
group = "Species"
)
scatter <- chart_settings(scatter, scatterstyle = "marker")
wb <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_add_mschart(dims = "F4:L20", graph = scatter) %>%
wb_add_mschart(dims = "F24:L40", graph = scatter) %>%
wb_add_worksheet() %>%
wb_add_mschart(dims = "F4:L20", graph = scatter) %>%
wb_add_mschart(dims = "F24:L40", graph = scatter)
exp <- c(TRUE, TRUE)
got <- grepl(pattern = "<c:chart xmlns:c=\"http://schemas.openxmlformats.org/drawingml/2006/chart\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"rId1\"/>", wb$drawings)
expect_equal(exp, got)
got <- grepl(pattern = "<c:chart xmlns:c=\"http://schemas.openxmlformats.org/drawingml/2006/chart\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"rId2\"/>", wb$drawings)
expect_equal(exp, got)
})
test_that("various image functions work as expected", {
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
wb <- wb_workbook()$
add_worksheet()$
add_image(file = img, width = 6, height = 5, dims = NULL)$
add_worksheet()$
add_image(dims = "B2", file = img, rowOffset = 90000, colOffset = 90000)$
add_worksheet()$
add_image(dims = "B2:K8", file = img)
exp <- c("xdr:absoluteAnchor", "xdr:oneCellAnchor", "xdr:twoCellAnchor")
got <- wb$drawings %>% xml_node_name(level1 = "xdr:wsDr")
expect_equal(exp, got)
exp <- "<xdr:from><xdr:col>1</xdr:col><xdr:colOff>90000</xdr:colOff><xdr:row>1</xdr:row><xdr:rowOff>90000</xdr:rowOff></xdr:from>"
got <- wb$drawings[[2]] %>% xml_node("xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
exp <- "<xdr:from><xdr:col>1</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>1</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- wb$drawings[[3]] %>% xml_node("xdr:wsDr", "xdr:twoCellAnchor", "xdr:from")
expect_equal(exp, got)
exp <- "<xdr:to><xdr:col>11</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>8</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:to>"
got <- wb$drawings[[3]] %>% xml_node("xdr:wsDr", "xdr:twoCellAnchor", "xdr:to")
expect_equal(exp, got)
expect_warning(
wb$add_worksheet()$add_image(file = img, width = 6, height = 5, dims = NULL, startRow = 2, startCol = 2),
"'start_col/start_row' is deprecated."
)
})
test_that("image relships work with comment", {
wb <- wb_workbook()
wb$add_worksheet("Sheet 1")
c1 <- wb_comment(text = "this is a comment", author = "", visible = TRUE)
wb$add_comment(dims = "B12", comment = c1)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
wb$add_image("Sheet 1", dims = "C5", file = img, width = 6, height = 5)
exp <- "<drawing r:id=\"rId3\"/>"
got <- wb$worksheets[[1]]$drawing
expect_equal(exp, got)
})
test_that("start_col/start_row works as expected", {
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, start_row = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>0</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, startRow = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>0</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, start_col = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>0</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, startCol = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>0</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, start_col = 5, start_row = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
expect_warning(wb <- wb_workbook()$add_worksheet()$add_image(file = img, startCol = 5, startRow = 5), "'start_col/start_row' is deprecated.")
exp <- "<xdr:from><xdr:col>4</xdr:col><xdr:colOff>0</xdr:colOff><xdr:row>4</xdr:row><xdr:rowOff>0</xdr:rowOff></xdr:from>"
got <- xml_node(wb$drawings[[1]], "xdr:wsDr", "xdr:oneCellAnchor", "xdr:from")
expect_equal(exp, got)
})
test_that("workbook themes work", {
wb <- wb_workbook()$add_worksheet()
exp <- "Aptos Narrow"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
wb <- wb_workbook(theme = "Office 2013 - 2022 Theme")$add_worksheet()
exp <- "Calibri"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
wb <- wb_workbook(theme = "Old Office Theme")$add_worksheet()
exp <- "Calibri"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
wb <- wb_workbook(theme = 1)$add_worksheet()
exp <- "Rockwell"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
expect_message(
wb <- wb_workbook(theme = "Foo")$add_worksheet(),
"theme Foo not found falling back to default theme"
)
exp <- "Aptos Narrow"
got <- wb$get_base_font()$name$val
expect_equal(exp, got)
})
test_that("changing sheet names works with named regions", {
filename <- testfile_path("namedRegions2.xlsx")
wb <- wb_load(filename)
wb$set_sheet_names("Sheet1", "new name")
wb$set_sheet_names("Sheet with space", "Sheet_without_space")
exp <- c(
"<definedName name=\"barref\" localSheetId=\"0\">'Sheet_without_space'!$B$4</definedName>",
"<definedName name=\"barref\" localSheetId=\"1\">'new name'!$B$4</definedName>"
)
got <- wb$workbook$definedNames[seq_len(2)]
expect_equal(exp, got)
})
test_that("numfmt in pivot tables works", {
## example code
df <- data.frame(
Plant = c("A", "C", "C", "B", "B", "C", "C", "C", "A", "C"),
Location = c("E", "F", "E", "E", "F", "E", "E", "G", "E", "F"),
Status = c("good", "good", "good", "good", "good", "good", "good", "good", "good", "bad"),
Units = c(0.95, 0.95, 0.95, 0.95, 0.89, 0.89, 0.94, 0.94, 0.9, 0.9),
stringsAsFactors = FALSE
)
## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, startCol = 1, startRow = 2)
df <- wb_data(wb, 1, dims = "A2:D10")
wb$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units")$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units",
params = list(numfmt = c(formatCode = "#,###0"), sort_row = "ascending"))$
add_pivot_table(df, dims = "A3", rows = "Plant",
filter = c("Location", "Status"), data = "Units",
params = list(numfmt = c(numfmt = 10), sort_row = "descending"))
exp <- c(
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\"/>",
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\" numFmtId=\"165\"/>",
"<dataField name=\"Sum of Units\" fld=\"3\" baseField=\"0\" baseItem=\"0\" numFmtId=\"10\"/>"
)
got <- xml_node(wb$pivotTables, "pivotTableDefinition", "dataFields", "dataField")
expect_equal(exp, got)
## sort by column and row
df <- mtcars
## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, start_col = 1, start_row = 2)
df <- wb_data(wb)
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"), params = list(sort_row = 1, sort_col = -2))
wb$add_pivot_table(df, dims = "A3", rows = "gear",
filter = c("cyl"), data = c("vs", "am"),
params = list(sort_row = "descending"))
exp <- c(
"<pivotField axis=\"axisRow\" showAll=\"0\" sortType=\"ascending\"><items count=\"4\"><item x=\"1\"/><item x=\"0\"/><item x=\"2\"/><item t=\"default\"/></items><autoSortScope><pivotArea dataOnly=\"0\" outline=\"0\" fieldPosition=\"0\"><references count=\"1\"><reference field=\"4294967294\" count=\"1\" selected=\"0\"><x v=\"0\"/></reference></references></pivotArea></autoSortScope></pivotField>",
"<pivotField axis=\"axisCol\" showAll=\"0\" sortType=\"descending\"><items count=\"4\"><item x=\"1\"/><item x=\"0\"/><item x=\"2\"/><item t=\"default\"/></items><autoSortScope><pivotArea dataOnly=\"0\" outline=\"0\" fieldPosition=\"0\"><references count=\"1\"><reference field=\"4294967294\" count=\"1\" selected=\"0\"><x v=\"1\"/></reference></references></pivotArea></autoSortScope></pivotField>"
)
got <- xml_node(wb$pivotTables[1], "pivotTableDefinition", "pivotFields", "pivotField")[c(2, 10)]
expect_equal(exp, got)
expect_warning(
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"), params = list(sort_row = 1, sort_col = -7)),
"invalid sort position found"
)
expect_error(
wb$add_pivot_table(df, dims = "A3", rows = "cyl", cols = "gear",
data = c("vs", "am"),
params = list(numfmt = c(numfmt = 10))),
"length of numfmt and data does not match"
)
### add sortType only to those pivot fields that are sorted
## sort by column and row
df <- mtcars
## Create the workbook and the pivot table
wb <- wb_workbook()$
add_worksheet("Data")$
add_data(x = df, start_col = 1, start_row = 2)
df <- wb_data(wb)
wb$add_pivot_table(
df,
dims = "A3",
rows = c("cyl", "am"),
cols = c("gear", "carb"),
data = c("disp", "mpg"),
params = list(sort_row = 1,
sort_col = -2)
)
exp <- c("", "ascending", "", "", "", "", "", "", "", "descending", "")
got <- rbindlist(xml_attr(wb$pivotTables, "pivotTableDefinition", "pivotFields", "pivotField"))$sortType
expect_equal(exp, got)
})
test_that("sort_item with pivot tables works", {
wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_add_data(x = mtcars)
df <- wb_data(wb, sheet = 1)
expect_silent(
wb_add_pivot_table(wb, df, dims = "A3",
filter = "am", rows = "cyl", cols = "gear", data = "disp",
params = list(sort_item = list(gear = c(3, 2, 1)))
)
)
expect_warning(
wb_add_pivot_table(wb, df, dims = "A3",
filter = "am", rows = "cyl", cols = "gear", data = "disp",
params = list(sort_item = list(gear = seq_len(4)))
),
"Length of sort order for 'gear' does not match required length. Is 4, needs 3."
)
})
test_that("wbWorkbook print works", {
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_worksheet("Sheet 1 (1)")$
add_worksheet("Sheet & NoSheet")
exp <- c("A Workbook object.",
" ",
"Worksheets:",
" Sheets: Sheet 1, Sheet 1 (1), Sheet & NoSheet ",
" Write order: 1, 2, 3")
got <- capture.output(wb)
expect_equal(exp, got)
})
test_that("genBaseWorkbook() works", {
# kinda superfluous. if it wouldn't work openxlsx2 would be broken
exp <- c(
"fileVersion", "fileSharing", "workbookPr", "alternateContent",
"revisionPtr", "absPath", "workbookProtection", "bookViews",
"sheets", "functionGroups", "externalReferences", "definedNames",
"calcPr", "oleSize", "customWorkbookViews", "pivotCaches", "smartTagPr",
"smartTagTypes", "webPublishing", "fileRecoveryPr", "webPublishObjects",
"extLst"
)
expect_equal(
names(genBaseWorkbook()),
exp
)
})
test_that("subsetting wb_data() works", {
wb <- wb_workbook()$
add_worksheet()$
add_data(x = head(esoph, 3))
df1 <- wb_data(wb)
exp <- data.frame(alcgp = rep("0-39g/day", 3), stringsAsFactors = FALSE)
got <- df1[, 2, drop = FALSE]
expect_equal(exp, got, ignore_attr = TRUE)
exp <- rep("0-39g/day", 3)
got <- unclass(df1[, 2])
expect_equal(exp, got)
exp <- structure(
list(
agegp = c("25-34", "25-34"),
alcgp = c("0-39g/day", "0-39g/day")
),
row.names = 2:3,
dims = structure(
list(
A = c("A1", "A2", "A3"),
B = c("B1", "B2", "B3")
),
row.names = c(NA, 3L),
class = "data.frame"),
sheet = "Sheet 1"
)
got <- unclass(df1[1:2, 1:2])
expect_equal(exp, got)
expect_null(attributes(df1[c("agegp")]))
exp <- list(
names = "agegp",
row.names = 2:4,
class = c("wb_data", "data.frame"),
dims = structure(
list(A = c("A1", "A2", "A3", "A4")),
row.names = c(NA, 4L),
class = "data.frame"
),
sheet = "Sheet 1"
)
got <- attributes(df1[c("agegp"), drop = FALSE])
expect_equal(exp, got)
exp <- list(
names = c("alcgp", "tobgp", "ncases"),
row.names = 2:4,
class = c("wb_data", "data.frame"),
dims = structure(
list(
B = c("B1", "B2", "B3", "B4"),
C = c("C1", "C2", "C3", "C4"),
D = c("D1", "D2", "D3", "D4")
),
row.names = c(NA, 4L),
class = "data.frame"
),
sheet = "Sheet 1"
)
got <- attributes(df1[c("alcgp", "tobgp", "ncases")])
expect_equal(exp, got)
exp <- list(
names = c("agegp", "alcgp", "tobgp", "ncases", "ncontrols"),
row.names = 3:4,
class = c("wb_data", "data.frame"),
dims = structure(
list(
A = c("A1", "A3", "A4"),
B = c("B1", "B3", "B4"),
C = c("C1", "C3", "C4"),
D = c("D1", "D3", "D4"),
E = c("E1", "E3", "E4")
),
row.names = c(1L, 3L, 4L),
class = "data.frame"
),
sheet = "Sheet 1"
)
got <- attributes(df1[-1, ])
expect_equal(exp, got)
exp <- list(
names = c("agegp", "alcgp", "tobgp", "ncases", "ncontrols"),
row.names = 2:3,
class = c("wb_data", "data.frame"),
dims = structure(
list(
A = c("A1", "A2", "A3"),
B = c("B1", "B2", "B3"),
C = c("C1", "C2", "C3"),
D = c("D1", "D2", "D3"),
E = c("E1", "E2", "E3")
),
row.names = c(NA, 3L),
class = "data.frame"
),
sheet = "Sheet 1")
got <- attributes(df1[-nrow(df1), ])
expect_equal(exp, got)
})
test_that("adding mips section works", {
# helper function to mock a mips section
create_fake_mips <- function() {
guid <- st_guid()
lid <- tolower(gsub("[{}]", "", guid))
mips_xml <- sprintf(
'<property fmtid="%s" pid="2" name="MSIP_Label_%s_Enabled">
<vt:lpwstr>true</vt:lpwstr>
</property>
<property fmtid="%s" pid="3" name="MSIP_Label_%s_SetDate">
<vt:lpwstr>2024-04-07T14:27:12Z</vt:lpwstr>
</property>
<property fmtid="%s" pid="4" name="MSIP_Label_%s_Method">
<vt:lpwstr>Privileged</vt:lpwstr>
</property>
<property fmtid="%s" pid="5" name="MSIP_Label_%s_Name">
<vt:lpwstr>General</vt:lpwstr>
</property>
<property fmtid="%s" pid="6" name="MSIP_Label_%s_SiteId">
<vt:lpwstr>%s</vt:lpwstr>
</property>
<property fmtid="%s" pid="7" name="MSIP_Label_%s_ActionId">
<vt:lpwstr>%s</vt:lpwstr>
</property>
<property fmtid="%s" pid="8" name="MSIP_Label_%s_ContentBits">
<vt:lpwstr>0</vt:lpwstr>
</property>',
guid, lid,
guid, lid,
guid, lid,
guid, lid,
guid, lid, lid,
guid, lid, lid,
guid, lid
)
read_xml(mips_xml, pointer = FALSE)
}
fmips <- create_fake_mips()
wb <- wb_workbook()$add_worksheet()$add_mips(xml = fmips)
expect_message(wb_get_mips(wb, quiet = FALSE), "Found MIPS section: General")
expect_equal(fmips, wb$get_mips())
tmp <- temp_xlsx()
wb$save(tmp)
expect_equal(fmips, wb_load(tmp)$get_mips())
wb <- wb_load(tmp)
expect_message(wb$add_mips(xml = fmips), "File has duplicated custom section")
expect_equal(fmips, wb$get_mips())
op <- options("openxlsx2.mips_xml_string" = fmips)
on.exit(options(op), add = TRUE)
wb <- wb_workbook()$add_worksheet()$add_mips(xml = fmips)
wb <- wb_workbook()$add_worksheet()$add_mips()
expect_equal(fmips, wb$get_mips())
wb <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_set_properties(
custom = list(
Software = "openxlsx2",
Version = 1.5,
ReleaseDate = as.Date("2024-03-26"),
CRAN = TRUE,
DEV = FALSE
)
)
wb <- wb_workbook()$add_worksheet()$
set_properties(
custom = list(int = 1L)
)
expect_silent(wb$add_mips())
exp <- "3"
got <- rbindlist(xml_attr(wb$get_mips(single_xml = FALSE)[1], "property"))$pid
expect_equal(exp, got)
})
test_that("handling mips in docMetadata works", {
tmp <- temp_xlsx()
xml <- '<clbl:labelList xmlns:clbl=\"http://schemas.microsoft.com/office/2020/mipLabelMetadata\"><clbl:label foo="bar"/></clbl:labelList>'
wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_add_mips(xml = xml)
wb$docMetadata
wb$save(tmp)
rm(wb)
wb <- wb_load(tmp)
expect_equal(xml, wb$docMetadata)
})
test_that("using and removing secondary bookviews works", {
wb <- wb_workbook() %>% wb_add_worksheet()
# set the first and second bookview (horizontal split)
wb <- wb %>%
wb_set_bookview(window_height = 17600, window_width = 15120, x_window = 15120, y_window = 760) %>%
wb_set_bookview(window_height = 17600, window_width = 15040, x_window = 0, y_window = 760, view = 2)
exp <- structure(
list(windowHeight = c("17600", "17600"), windowWidth = c("15120", "15040"),
xWindow = c("15120", "0"), yWindow = c("760", "760")),
row.names = c(NA, 2L), class = "data.frame")
got <- wb %>% wb_get_bookview()
expect_equal(exp, got)
# remove the first view
exp <- structure(
list(windowHeight = c("17600"), windowWidth = c("15040"),
xWindow = c("0"), yWindow = c("760")),
row.names = c(NA, 1L), class = "data.frame")
got <- wb %>% wb_remove_bookview(view = 1) %>% wb_get_bookview()
expect_equal(exp, got)
# keep only the first view
exp <- structure(
list(windowHeight = c("17600"), windowWidth = c("15120"),
xWindow = c("15120"), yWindow = c("760")),
row.names = c(NA, 1L), class = "data.frame")
got <- wb %>% wb_remove_bookview(view = -1) %>% wb_get_bookview()
expect_equal(exp, got)
wb <- wb_workbook() %>% wb_add_worksheet()
exp <- structure(list(), row.names = c(NA, 1L), names = character(0), class = "data.frame")
got <- wb %>% wb_remove_bookview(view = 1) %>% wb_get_bookview()
expect_equal(exp, got)
expect_error(
wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_set_bookview(view = 3),
"There is more than one workbook view missing. Available: 1. Requested: 3"
)
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.