testsetup()
# wb_workbook() -----------------------------------------------------------
test_that("wb_workbook() is a wrapper", {
# slightly different be
ts <- Sys.time()
expect_identical(formals(wbWorkbook$public_methods$initialize), formals(wb_workbook))
expect_identical(
wbWorkbook$new(datetimeCreated = ts),
wb_workbook(datetimeCreated = ts)
)
})
# wb_add_chartsheet() ------------------------------------------------------
test_that("wb_add_chartsheet() is a wrapper", {
expect_wrapper("add_chartsheet", params = list(sheet = "this"))
})
# wb_add_worksheet() ------------------------------------------------------
test_that("wb_add_worksheet() is a wrapper", {
expect_wrapper("add_worksheet", params = list(sheet = "this"))
})
# wb_remove_worksheet() ---------------------------------------------------
test_that("wb_remove_worksheet() is a wrapper", {
wb <- wbWorkbook$new()$add_worksheet("sheet")
expect_wrapper("remove_worksheet", wb = wb, params = list(sheet = "sheet"))
})
# wb_to_df() ---------------------------------------------------------------
# does not work as expected
test_that("wb_to_df() is a wrapper", {
wb <- wb_workbook()$add_worksheet()$add_data(x = iris)
expect_pseudo_wrapper("to_df")
})
# wb_load() ---------------------------------------------------------------
test_that("wb_load() is a wrapper", {
tmp_xlsx <- temp_xlsx()
wb_workbook()$add_worksheet()$add_data(x = iris)$save(tmp_xlsx)
expect_wrapper("load", params = list(file = tmp_xlsx), ignore_wb = TRUE)
})
# wb_save() ---------------------------------------------------------------
test_that("wb_save() is a wrapper", {
# returns the file path instead
expect_wrapper("save", params = NULL, ignore = c("file", "path"))
})
# wb_merge_cells(), wb_unmerge_cells() ------------------------------------
test_that("wb_merge_cells(), wb_unmerge_cells() are wrappers", {
wb <- wb_workbook()$add_worksheet("sheet")
params <- list(sheet = "sheet", rows = 1:2, cols = 2)
expect_wrapper("merge_cells", wb = wb, params = params)
expect_wrapper("unmerge_cells", wb = wb, params = params)
})
# wb_freeze_pane() --------------------------------------------------------
test_that("wb_freeze_pane() is a wrapper", {
wb <- wbWorkbook$new()$add_worksheet("sheet")
expect_wrapper("freeze_pane", wb = wb, params = list(sheet = "sheet"))
})
# wb_clone_worksheet() ----------------------------------------------------
test_that("wb_clone_worksheet() is a wrapper", {
wb <- wbWorkbook$new()$add_worksheet("sheet")
expect_wrapper("clone_worksheet", wb = wb, params = list(old = "sheet", new = "new"))
})
# wb_freeze_pane() --------------------------------------------------------
test_that("wb_freeze_pane() is a wrapper", {
wb <- wbWorkbook$new()$add_worksheet("sheet")
expect_wrapper("freeze_pane", wb = wb, params = list(sheet = "sheet"))
})
# wb_set_row_heights() --------------------------------------------------------
test_that("wb_set_row_heights() is a wrapper", {
wb <- wbWorkbook$new()$add_worksheet("sheet")
params <- list(sheet = "sheet", rows = 1, heights = 5)
expect_wrapper("set_row_heights", wb = wb, params = params)
})
# wb_remove_row_heights() -----------------------------------------------------
test_that("wb_remove_row_heights() is a wrapper", {
wb <- wbWorkbook$new()$add_worksheet("a")
wb$set_row_heights("a", 1:3, 20)
params <- list(sheet = "a", rows = 2)
expect_wrapper("remove_row_heights", wb = wb, params = params)
})
# wb_group_rows(), wb_ungroup_rows() ------------------------------------------
test_that("wb_group_rows(), wb_ungroup_rows() are wrappers", {
wb <- wbWorkbook$new()$add_worksheet("sheet")
params <- list(sheet = "sheet", rows = 1)
expect_wrapper("group_rows", wb = wb, params = params)
wb$group_rows(sheet = "sheet", rows = 1)
expect_wrapper("ungroup_rows", wb = wb, params = params)
})
# wb_group_cols(), wb_ungroup_cols() ------------------------------------------
test_that("wb_group_cols(), wb_ungroup_cols() are wrapper", {
wb <- wbWorkbook$new()$add_worksheet("sheet")
params <- list(sheet = "sheet", cols = 1)
# TODO add step to actual create columns?
suppressMessages(expect_wrapper("group_cols", wb = wb, params = params))
suppressMessages(wb$group_cols(sheet = "sheet", cols = 1))
expect_wrapper("ungroup_cols", wb = wb, params = params)
})
# wb_set_creators() ------------------------------------------------------------
test_that("wb_set_creators() is a wrapper", {
expect_wrapper("set_creators", params = list(creators = "myself"))
})
# wb_remove_creators() ---------------------------------------------------------
test_that("wb_remove_creators() is a wrapper", {
wb <- wb_workbook(creator = "myself")
expect_wrapper("remove_creators", wb = wb, params = list(creators = "myself"))
})
# wb_set_properties() ----------------------------------------------------------
test_that("wb_set_properties() is a wrapper", {
wb <- wb_workbook(subject = "xyz")
expect_wrapper("set_properties", wb = wb, params = list(subject = "a new subject"))
})
# wb_set_properties() ---------------------------------------------------------
test_that("wb_get_properties() is a wrapper", {
wb <- wb_workbook(subject = "xyz")
expect_wrapper("get_properties", wb = wb)
})
# wb_add_mips() ---------------------------------------------------------------
test_that("wb_add_mips() is a wrapper", {
wb <- wb_workbook()
xml <- "true"
expect_wrapper("add_mips", wb = wb, params = list(xml = xml))
})
# wb_get_mips() ---------------------------------------------------------------
test_that("wb_get_mips() is a wrapper", {
xml <- "true"
wb <- wb_workbook()$add_mips(xml = xml)
expect_wrapper("get_mips", wb = wb)
})
# wb_set_last_modified_by() ---------------------------------------------------
test_that("wb_set_last_modified_by() is a wrapper", {
wb <- wb_workbook()
expect_wrapper("set_last_modified_by", params = list(name = "myself"))
})
# wb_page_setup() -------------------------------------------------------------
test_that("wb_page_setup() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
expect_wrapper("page_setup", wb = wb, params = list(sheet = "a"))
})
# wb_set_base_font() ----------------------------------------------------------
test_that("wb_set_base_font() is a wrapper", {
params <- list(fontColour = "red", fontSize = 20)
expect_wrapper("set_base_font", params = params)
})
test_that("wb_get_base_font() is a wrapper", {
wb <- wb_workbook()
expect_wrapper("get_base_font", wb = wb)
expect_wrapper("get_base_font", wb = wb)
})
test_that("wb_set_base_colors() is a wrapper", {
params <- list(theme = 2)
expect_wrapper("set_base_colors", params = params)
expect_wrapper("set_base_colours", params = params)
})
test_that("wb_get_base_color() is a wrapper", {
wb <- wb_workbook()
expect_wrapper("get_base_colors", wb = wb)
expect_wrapper("get_base_colours", wb = wb)
})
# wb_set_bookview() -----------------------------------------------------------
test_that("wb_set_bookview() is a wrapper", {
params <- list(activeTab = "1")
expect_wrapper("set_bookview", params = params)
})
# wb_set_header_footer() ------------------------------------------------------
test_that("wb_set_header_footer() is a wrapper", {
wb <- wb_workbook(creator = "myself")$add_worksheet("a")
expect_wrapper("set_header_footer", wb = wb, params = list(sheet = "a"))
})
# wb_set_col_widths(), wb_remove_col_widths() -----------------------------
test_that("wb_set_col_widths() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
expect_wrapper("set_col_widths", wb = wb, params = list(sheet = "a", cols = 1:3))
expect_wrapper("remove_col_widths", wb = wb, params = list(sheet = "a", cols = 1:3))
})
# wb_add_image() ----------------------------------------------------------
test_that("wb_add_image() is a wrapper", {
path <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
wb <- wb_workbook()$add_worksheet("a")
expect_wrapper("add_image", wb = wb, params = list(file = path, sheet = "a"))
})
# wb_add_plot() -----------------------------------------------------------
test_that("wb_add_plot() is a wrapper", {
# workaround: this filename is inserted to the wrapper function
op <- options("openxlsx2.temp_png" = tempfile(pattern = "figureImage", fileext = ".png"))
on.exit(options(op), add = TRUE)
# create a device we can dev.copy() from
grDevices::pdf(NULL) # do not create "Rplots.pdf"
grDevices::dev.control("enable")
plot(1:5, 1:5)
wb <- wb_workbook()$add_worksheet("a")
expect_wrapper(
"add_plot",
"wb_add_plot",
wb = wb,
params = list(sheet = "a")
)
# # check that it is actually working
# wb$add_plot(sheet = "a")$save("~/test.xlsx")
grDevices::dev.off()
})
test_that("wb_add_drawing is a wrapper", {
fl <- testfile_path("loadExample.xlsx")
wb <- wb_load(file = fl)
xml <- wb$drawings[[2]]
wb <- wb_workbook()$add_worksheet()
expect_wrapper("add_drawing", wb = wb, params = list(xml = xml))
})
# wb_get_tables(), wb_remove_tables() -------------------------------------
test_that("wb_get_tables(), wb_remove_tables() are wrappers", {
wb <- wb_workbook()
wb$add_worksheet(sheet = "Sheet 1")
wb$add_data_table(sheet = "Sheet 1", x = iris)
wb$add_data_table(sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10)
expect_wrapper("get_tables", wb = wb, params = list(sheet = 1))
expect_wrapper("remove_tables", wb = wb, params = list(sheet = 1, table = "mtcars"))
})
# wb_add_filter(), wb_remove_filter() -------------------------------------
test_that("wb_add_filter(), wb_remove_filter() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
params <- list(sheet = "a", cols = 1, rows = 1)
expect_wrapper("add_filter", wb = wb, params = params)
wb$add_filter("a", 1, 1)
expect_wrapper("remove_filter", wb = wb, params = list(sheet = "a"))
})
# wb_grid_lines() ---------------------------------------------------------
test_that("wb_set_grid_lines() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
expect_wrapper("set_grid_lines", wb = wb, params = list(sheet = 1, show = TRUE))
})
# wb_add_named_region(), wb_remove_named_region() -------------------------
test_that("wb_add_named_region(), wb_remove_named_region() wb_get_named_regions() are wrappers", {
wb <- wb_workbook()$add_worksheet("a")
params <- list(sheet = 1, dims = "A1", name = "cool")
expect_wrapper("add_named_region", wb = wb, params = params)
# now add the named region so that we can remove it
wb$add_named_region(sheet = 1, dims = "A1", name = "cool")
expect_wrapper("get_named_regions", wb = wb)
expect_wrapper("remove_named_region", wb = wb, params = list(name = "cool"))
})
# wb_set_order() ----------------------------------------------------------
test_that("wb_set_order() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")$add_worksheet("b")$add_worksheet("c")
expect_wrapper("set_order", wb = wb, params = list(sheets = 3:1))
})
# wb_get_sheet_visibility(), wb_set_sheet_visibility() --------------------
test_that("wb_get_sheet_visibility(), wb_set_sheet_visibility() are wrappers", {
wb <- wb_workbook()$add_worksheet("a")$add_worksheet("b")$add_worksheet("c")
expect_wrapper("get_sheet_visibility", wb = wb)
expect_wrapper("set_sheet_visibility", wb = wb, params = list(sheet = 2:3, value = c(FALSE, FALSE)))
})
# wb_add_data_validation() ------------------------------------------------
test_that("wb_add_data_validation() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
params <- list(sheet = 1, dims = "A1", type = "whole", operator = "between", value = c(0, 1))
expect_wrapper("add_data_validation", wb = wb, params = params)
})
# wb_protect(), wb_protect_worksheet() ------------------------------------
test_that("wb_protect() is a wrapper", {
expect_wrapper("protect")
})
test_that("wb_protect_worksheet() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
params <- list(sheet = "a", properties = c("deleteRows", "autoFilter"))
expect_wrapper("protect_worksheet", wb = wb, params = params)
})
# wb_add_page_break() -----------------------------------------------------
test_that("wb_add_page_break() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
expect_wrapper("add_page_break", wb = wb, params = list(sheet = 1, row = 2))
})
# wb_clean_sheet() --------------------------------------------------------
test_that("wb_clean_sheet() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")
params <- list(sheet = "a")
expect_wrapper("clean_sheet", wb = wb, params = params)
})
## disable test bailing in covr in GitHub action
# # wb_open() ---------------------------------------------------------------
#
# test_that("wb_open() is a wrapper", {
# wb <- wb_workbook()$add_worksheet("a")
# expect_error(
# expect_wrapper("open", wb = wb),
# "wbWorkbook$open$path vs wb_open$path",
# fixed = TRUE
# )
# })
# wb_add_data(), wb_add_data_table(), wb_add_formula() --------------------
test_that("wb_add_data() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper("add_data", wb = wb, params = list(sheet = 1, x = data.frame(x = 1)))
})
test_that("wb_add_data_table() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper("add_data_table", wb = wb, params = list(sheet = 1, x = data.frame(x = 1)))
})
test_that("wb_add_pivot_table() is a wrapper", {
wb <- wb_workbook()$add_worksheet()$add_data(x = mtcars)
df <- wb_data(wb)
expect_wrapper("add_pivot_table", wb = wb, params = list(x = df, data = "disp"))
})
test_that("wb_add_slicer() is a wrapper", {
wb <- wb_workbook()$add_worksheet()$add_data(x = mtcars)
df <- wb_data(wb)
wb$add_pivot_table(x = df, data = "disp", slicer = "vs", pivot_table = "pivot1")
expect_wrapper("add_slicer", wb = wb, params = list(x = df, slicer = "vs", pivot_table = "pivot1"))
})
test_that("wb_add_formula() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
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)
expect_wrapper("copy_cells", wb = wb, params = list(sheet = 1, data = dat, dims = "B1"))
})
# wb_add_comment() --------------------------------------------------------
test_that("wb_add_comment() is a wrapper", {
c1 <- create_comment(text = "this is a comment", author = "")
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"add_comment",
wb = wb,
params = list(comment = c1, dims = "A1")
)
op <- options("openxlsx2.creator" = "user")
on.exit(options(op), add = TRUE)
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"add_comment",
wb = wb,
params = list(comment = "a new comment", dims = "A1")
)
})
test_that("wb_get_comment() is a wrapper", {
c1 <- wb_comment(text = "this is a comment", author = "")
wb <- wb_workbook()$add_worksheet("Sheet 1")$add_comment(dims = "B10", comment = c1)
expect_wrapper(
"get_comment",
wb = wb
)
})
# wb_remove_comment() -----------------------------------------------------
test_that("wb_remove_comment() is a wrapper", {
c1 <- create_comment(text = "this is a comment", author = "")
wb <- wb_workbook()$
add_worksheet()$
add_comment(dims = "A1", comment = c1)
expect_wrapper(
"remove_comment",
wb = wb,
params = list(dims = "A1")
)
})
# wb_add_thread() ---------------------------------------------------------
test_that("wb_add_thread() is a wrapper", {
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"add_person",
wb = wb,
params = list(name = "me")
)
wb <- wb_workbook()$add_worksheet()$add_person("me")
expect_wrapper(
"get_person",
wb = wb,
params = list(name = "me")
)
wb <- wb_workbook()$add_worksheet()$add_person("me")
me_id <- wb$get_person("me")$id
expect_wrapper(
"add_thread",
wb = wb,
params = list(comment = "test", person_id = me_id)
)
})
test_that("wb_get_thread() is a wrapper", {
wb <- wb_workbook()$add_worksheet()$add_person("me")
me_id <- wb$get_person("me")$id
wb$add_thread(comment = "test", person_id = me_id)
expect_wrapper(
"get_thread",
wb = wb
)
})
# wb_add_form_control() ---------------------------------------------------
test_that("wb_add_form_control() is a wrapper", {
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"add_form_control",
wb = wb
)
})
# wb_add_conditional_formatting() -----------------------------------------
test_that("wb_add_conditional_formatting() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
params <- list(sheet = 1, cols = 1, rows = 1, type = "topN")
expect_wrapper(
"add_conditional_formatting",
wb = wb,
params = params,
ignore_fields = "styles_mgr"
)
})
# wb_set_sheet_names() ----------------------------------------------------
test_that("wb_set_sheet_names() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")$add_worksheet("b")
expect_wrapper("set_sheet_names", wb = wb, params = list(new = c("c", "d")))
})
# wb_get_sheet_names() ----------------------------------------------------
test_that("wb_get_sheet_names() is a wrapper", {
wb <- wb_workbook()$add_worksheet("a")$add_worksheet("b")
expect_wrapper("get_sheet_names", wb = wb)
})
# wb_clean_sheet() --------------------------------------------------------
test_that("wb_clean_sheet() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper("clean_sheet", wb = wb, params = list(sheet = 1))
})
# wb_add_border() ---------------------------------------------------------
test_that("wb_add_border() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper(
"add_border",
wb = wb,
params = list(sheet = 1)
)
})
# wb_add_fill() -----------------------------------------------------------
test_that("wb_add_fill() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper(
"add_fill",
wb = wb,
params = list(sheet = 1)
)
})
# wb_add_font() -----------------------------------------------------------
test_that("wb_add_font() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper(
"add_font",
wb = wb,
params = list(sheet = 1)
)
})
# wb_add_numfmt() ---------------------------------------------------------
test_that("wb_add_numfmt() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper(
"add_numfmt",
wb = wb,
params = list(sheet = 1, numfmt = 1)
)
})
# wb_add_cell_style() -----------------------------------------------------
test_that("wb_add_cell_style() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper(
"add_cell_style",
wb = wb,
params = list(sheet = 1)
)
})
# wb_add_named_style() ----------------------------------------------------
test_that("wb_add_named_style() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper(
"add_named_style",
wb = wb,
params = list(name = "Title")
)
})
# wb_add_dxfs_style() -----------------------------------------------------
test_that("wb_add_dxfs_style() is a wrapper", {
wb <- wb_workbook()$add_worksheet(1)
expect_wrapper(
"add_dxfs_style",
wb = wb,
params = list(name = "dxfs")
)
})
# wb_clone_sheet_style() --------------------------------------------------
test_that("wb_clone_sheet_style() is a wrapper", {
wb <- wb_workbook()$
add_worksheet(1)$add_data(x = mtcars)$
add_worksheet(2)$add_data(x = mtcars)
wb$add_fill(sheet = 1, dims = "D5:J23", color = wb_colour(hex = "FFFFFF00"))
expect_wrapper(
"clone_sheet_style",
wb = wb,
params = list(from = 1, to = 2)
)
})
# wb_add_sparklines() -----------------------------------------------------
test_that("wb_add_sparklines() is a wrapper", {
wb <- wb_workbook()$add_worksheet()$add_data(x = mtcars)
expect_wrapper(
"add_sparklines",
wb = wb,
params = list(sparklines = create_sparklines("Sheet 1", "A3:L3", "M3", type = "column", first = "1"))
)
})
# wb_set_sheetview() ------------------------------------------------------
test_that("wb_set_sheetview() is a wrapper", {
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"set_sheetview",
wb = wb,
params = list(rightToLeft = TRUE)
)
})
# wb_add_style() ----------------------------------------------------------
test_that("wb_add_style() is a wrapper", {
# with name
style <- create_numfmt(numFmtId = "165", formatCode = "#.#")
wb <- wb_workbook()
expect_wrapper(
"add_style",
wb = wb,
params = list(style = style, style_name = "numfmt")
)
# without name
wb <- wb_workbook()
numfmt <- create_numfmt(numFmtId = "165", formatCode = "#.#")
expect_wrapper(
"add_style",
wb = wb,
params = list(style = numfmt)
)
})
# wb_set_cell_style_across() ----------------------------------------------
test_that("wb_add_style() is a wrapper", {
wb <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_add_fill(dims = "C3", color = wb_color("yellow"))
expect_wrapper(
"set_cell_style_across",
wb = wb,
params = list(style = "C3", cols = "C:D", rows = 3:4)
)
})
# wb_get_cell_style() -----------------------------------------------------
test_that("wb_get_cell_style() is a wrapper", {
# set a style in A1
wb <- wb_workbook()$add_worksheet()$add_numfmt(dims = "A1", numfmt = "#.0")
expect_wrapper(
"get_cell_style",
wb = wb,
params = list(dims = "A1")
)
})
# wb_set_cell_style() -----------------------------------------------------
test_that("wb_set_cell_style() is a wrapper", {
# set a style in b1
wb <- wb_workbook()$add_worksheet()$
add_numfmt(dims = "B1", numfmt = "#,0")
# get style from b1 to assign it to a1
numfmt <- wb$get_cell_style(dims = "B1")
expect_wrapper(
"set_cell_style",
wb = wb,
params = list(dims = "A1", style = numfmt)
)
})
# wb_add_chart_xml() ------------------------------------------------------
test_that("wb_add_chart_xml() is a wrapper", {
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"add_chart_xml",
wb = wb,
params = list(dims = "F4:L20", xml = "")
)
})
# wb_add_mschart() --------------------------------------------------------
test_that("wb_add_mschart() is a wrapper", {
skip_if_not_installed("mschart")
require(mschart)
### Scatter
scatter <- ms_scatterchart(data = iris, x = "Sepal.Length",
y = "Sepal.Width", group = "Species")
scatter <- chart_settings(scatter, scatterstyle = "marker")
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"add_mschart",
wb = wb,
params = list(dims = "F4:L20", graph = scatter)
)
})
# wb_add_ignore_error() ---------------------------------------------------
test_that("add_ignore_error is a wrapper", {
wb <- wb_workbook()$add_worksheet()
expect_wrapper(
"add_ignore_error",
wb = wb,
params = list(dims = "F4:L20", formula = TRUE)
)
})