test_that("Worksheet Class works", { expect_null(assert_worksheet(wb_worksheet())) }) test_that("test data validation list and sparklines", { set.seed(123) # sparklines has a random uri string options("openxlsx2_seed" = NULL) s1 <- create_sparklines("Sheet 1", "A3:K3", "L3") s2 <- create_sparklines("Sheet 1", "A4:K4", "L4") wb <- wb_workbook()$ add_worksheet()$add_data(x = iris[1:30, ])$ add_worksheet()$add_data(sheet = 2, x = sample(iris$Sepal.Length, 10))$ add_data_validation(sheet = 1, dims = "A2:A11", type = "list", value = '"O1,O2"')$ add_sparklines(sheet = 1, sparklines = s1)$ add_data_validation(sheet = 1, dims = "A12:A21", type = "list", value = '"O2,O3"')$ add_sparklines(sheet = 1, sparklines = s2) exp <- c( "'Sheet 1'!A3:K3L3'Sheet 1'!A4:K4L4" ) got <- wb$worksheets[[1]]$extLst expect_equal(exp, got) }) test_that("sparkline waivers work", { sl <- create_sparklines(dims = "A2:L2", sqref = "M2", markers = "1") wb <- wb_workbook()$add_worksheet("Sparklines 1") sl_xml <- replace_waiver(sl, wb) exp <- "'Sparklines 1'!A2:L2M2" got <- xml_node(sl_xml, "x14:sparklineGroup", "x14:sparklines", "x14:sparkline") expect_equal(exp, got) }) test_that("old and new data validations", { temp <- temp_xlsx() wb <- wb_workbook()$ add_worksheet()$ add_data(x = sample(c("O1", "O2"), 10, TRUE))$ add_data(dims = "B1", x = sample(c("O1", "O2"), 10, TRUE))$ add_data_validation(sheet = 1, dims = "B1:B10", type = "list", value = '"O1,O2"') # add data validations list as x14. this was the default in openxlsx and openxlsx2 <= 0.3 wb$worksheets[[1]]$extLst <- "\"O1,O2\"A2:A11" wb$save(temp) # make sure that it loads wb2 <- wb_load(temp) # test for equality expect_equal( wb$worksheets[[1]]$dataValidations, wb2$worksheets[[1]]$dataValidations ) expect_equal( wb$worksheets[[1]]$extLst, wb2$worksheets[[1]]$extLst ) }) test_that("set_sheetview", { wb <- wb_workbook()$add_worksheet() exp <- "" got <- wb$worksheets[[1]]$sheetViews expect_equal(exp, got) exp <- "" op <- options("openxlsx2.rightToLeft" = TRUE) on.exit(options(op), add = TRUE) wb <- wb_workbook()$add_worksheet() got <- wb$worksheets[[1]]$sheetViews expect_equal(exp, got) options("openxlsx2.rightToLeft" = "1") wb <- wb_workbook()$add_worksheet() got <- wb$worksheets[[1]]$sheetViews expect_equal(exp, got) }) test_that("print options work", { temp <- temp_xlsx() wb <- wb_workbook() %>% wb_add_worksheet(gridLines = FALSE) %>% wb_add_data(x = iris) %>% wb_add_worksheet(gridLines = TRUE) %>% wb_add_data(x = mtcars) exp <- character() got <- wb$worksheets[[1]]$printOptions expect_equal(exp, got) exp <- "" got <- wb$worksheets[[2]]$printOptions expect_equal(exp, got) wb$save(temp) wb <- wb_load(temp) got <- wb$worksheets[[2]]$printOptions expect_equal(exp, got) }) test_that("ignore_error works", { wb <- wb_workbook()$add_worksheet() wb$add_data(dims = "B1", x = t(c(1, 2, 3)), colNames = FALSE) wb$add_formula(dims = "A1", x = "SUM(B1:C1)") # 1 wb$worksheets[[1]]$ignore_error(dims = "A1", formulaRange = TRUE) exp <- "" got <- wb$worksheets[[1]]$ignoredErrors expect_equal(exp, got) # 2 wb$worksheets[[1]]$ignore_error(dims = "A2", calculatedColumn = TRUE, emptyCellReference = TRUE, evalError = TRUE, formula = TRUE, formulaRange = TRUE, listDataValidation = TRUE, numberStoredAsText = TRUE, twoDigitTextYear = TRUE, unlockedFormula = TRUE) exp <- "" got <- wb$worksheets[[1]]$ignoredErrors expect_equal(exp, got) }) test_that("tab_color works", { # worksheet wb <- wb_workbook()$ add_worksheet(tab_color = "red")$ add_worksheet(tab_color = wb_color("red")) expect_equal( wb$worksheets[[1]]$sheetPr, wb$worksheets[[2]]$sheetPr ) # chartsheet wb <- wb_workbook()$ add_chartsheet(tab_color = "red")$ add_chartsheet(tab_color = wb_color("red")) expect_equal( wb$worksheets[[1]]$sheetPr, wb$worksheets[[2]]$sheetPr ) # use color theme wb <- wb_workbook()$ add_worksheet(tab_color = wb_color(theme = 4))$ add_chartsheet(tab_color = wb_color(theme = 4)) expect_equal( wb$worksheets[[1]]$sheetPr, wb$worksheets[[2]]$sheetPr ) # error with invalid tab_color. blau is German for blue. expect_error( wb <- wb_workbook()$ add_worksheet(tab_color = "blau"), "Invalid tab_color in add_worksheet" ) expect_error( wb <- wb_workbook()$ add_chartsheet(tab_color = "blau"), "Invalid tab_color in add_chartsheet" ) }) test_that("setting and loading header/footer attributes works", { wb <- wb_workbook() %>% wb_add_worksheet() %>% wb_set_header_footer( header = c(NA, "Header", NA), scale_with_doc = TRUE, align_with_margins = TRUE ) %>% wb_page_setup(orientation = "landscape", fit_to_width = 1) %>% wb_set_sheetview(view = "pageLayout", zoom_scale = 40) %>% wb_add_data(x = as.data.frame(matrix(1:500, ncol = 25))) temp <- temp_xlsx() wb$save(temp) rm(wb) wb <- wb_load(temp) expect_true(wb$worksheets[[1]]$scale_with_doc) expect_true(wb$worksheets[[1]]$align_with_margins) }) test_that("updating page header / footer works", { wb <- wb_workbook()$add_worksheet()$set_sheetview(view = "pageLayout") wb$add_data(x = matrix(1, nrow = 150, ncol = 1)) first_hf <- wb$worksheets[[1]]$headerFooter wb$set_header_footer( header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), even_header = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), even_footer = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), first_header = c("TOP", "OF FIRST", "PAGE"), first_footer = c("BOTTOM", "OF FIRST", "PAGE") ) second_hf <- wb$worksheets[[1]]$headerFooter wb$set_header_footer( header = NA, footer = NA, even_header = NA, even_footer = NA, first_header = c("FIRST ONLY L", NA, "FIRST ONLY R"), first_footer = c("FIRST ONLY L", NA, "FIRST ONLY R") ) third_hf <- wb$worksheets[[1]]$headerFooter wb$set_header_footer( first_header = c("FIRST ONLY L", NA, "FIRST ONLY R"), first_footer = c("FIRST ONLY L", NA, "FIRST ONLY R") ) fourth_hf <- wb$worksheets[[1]]$headerFooter expect_equal(NULL, first_hf) exp <- list(oddHeader = list("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), oddFooter = list("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), evenHeader = list("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), evenFooter = list("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), firstHeader = list("TOP", "OF FIRST", "PAGE"), firstFooter = list("BOTTOM", "OF FIRST", "PAGE")) expect_equal(exp, second_hf) exp <- list(oddHeader = list("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), oddFooter = list("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), evenHeader = list("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), evenFooter = list("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), firstHeader = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R"), firstFooter = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R")) expect_equal(exp, third_hf) exp <- list(oddHeader = list(), oddFooter = list(), evenHeader = list(), evenFooter = list(), firstHeader = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R"), firstFooter = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R")) expect_equal(exp, fourth_hf) expect_error(wb$set_header_footer(header = c("foo", "bar")), "must have length 3 where elements correspond to positions: left, center, right.") })