Binary files /tmp/tmpl8lzxd88/cZki4U6tAm/r-cran-openxlsx-4.2.4/build/vignette.rds and /tmp/tmpl8lzxd88/_fcQBeVuZy/r-cran-openxlsx-4.2.5/build/vignette.rds differ diff -Nru r-cran-openxlsx-4.2.4/debian/changelog r-cran-openxlsx-4.2.5/debian/changelog --- r-cran-openxlsx-4.2.4/debian/changelog 2021-08-16 21:39:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/debian/changelog 2021-12-20 15:09:41.000000000 +0000 @@ -1,3 +1,12 @@ +r-cran-openxlsx (4.2.5-1) unstable; urgency=medium + + * New upstream release + + * debian/control: Set Standards-Version: to current version + * debian/control: Set Build-Depends: to current R version + + -- Dirk Eddelbuettel Mon, 20 Dec 2021 09:09:41 -0600 + r-cran-openxlsx (4.2.4-2) unstable; urgency=medium * Simple rebuild for unstable following Debian 11 release diff -Nru r-cran-openxlsx-4.2.4/debian/control r-cran-openxlsx-4.2.5/debian/control --- r-cran-openxlsx-4.2.4/debian/control 2021-08-16 21:38:47.000000000 +0000 +++ r-cran-openxlsx-4.2.5/debian/control 2021-12-20 15:09:41.000000000 +0000 @@ -2,8 +2,8 @@ Section: gnu-r Priority: optional Maintainer: Dirk Eddelbuettel -Build-Depends: debhelper-compat (= 11), r-base-dev (>= 4.1.1), dh-r, r-cran-rcpp, r-cran-zip, r-cran-stringi, r-cran-rlang -Standards-Version: 4.5.1 +Build-Depends: debhelper-compat (= 11), r-base-dev (>= 4.1.2), dh-r, r-cran-rcpp, r-cran-zip, r-cran-stringi, r-cran-rlang +Standards-Version: 4.6.0 Vcs-Browser: https://salsa.debian.org/edd/r-cran-openxlsx Vcs-Git: https://salsa.debian.org/edd/r-cran-openxlsx.git Homepage: https://cran.r-project.org/package=openxlsx diff -Nru r-cran-openxlsx-4.2.4/DESCRIPTION r-cran-openxlsx-4.2.5/DESCRIPTION --- r-cran-openxlsx-4.2.4/DESCRIPTION 2021-06-16 04:20:03.000000000 +0000 +++ r-cran-openxlsx-4.2.5/DESCRIPTION 2021-12-14 14:20:06.000000000 +0000 @@ -1,9 +1,8 @@ Type: Package Package: openxlsx Title: Read, Write and Edit xlsx Files -Version: 4.2.4 -Date: 2021-06-08 -Language: en-US +Version: 4.2.5 +Date: 2021-12-13 Authors@R: c(person(given = "Philipp", family = "Schauberger", @@ -21,29 +20,30 @@ role = "ctb"), person(given = "Jan Marvin", family = "Garbuszus", - email = "jan.garbuszus@ruhr-uni-bochum.de", - role = "ctb"), + role = "ctb", + email = "jan.garbuszus@ruhr-uni-bochum.de"), person(given = "Jordan Mark", family = "Barbone", role = "ctb", email = "jmbarbone@gmail.com", comment = c(ORCID = "0000-0001-9788-3628"))) -Description: Simplifies the creation of Excel .xlsx files by - providing a high level interface to writing, styling and editing - worksheets. Through the use of 'Rcpp', read/write times are comparable - to the 'xlsx' and 'XLConnect' packages with the added benefit of - removing the dependency on Java. +Description: Simplifies the creation of Excel .xlsx files by providing a + high level interface to writing, styling and editing worksheets. + Through the use of 'Rcpp', read/write times are comparable to the + 'xlsx' and 'XLConnect' packages with the added benefit of removing the + dependency on Java. License: MIT + file LICENSE URL: https://ycphs.github.io/openxlsx/index.html, https://github.com/ycphs/openxlsx BugReports: https://github.com/ycphs/openxlsx/issues Depends: R (>= 3.3.0) -Imports: grDevices, methods, Rcpp, stats, utils, zip, stringi -Suggests: knitr, testthat, roxygen2, rmarkdown +Imports: grDevices, methods, Rcpp, stats, stringi, utils, zip +Suggests: knitr, rmarkdown, roxygen2, testthat LinkingTo: Rcpp VignetteBuilder: knitr Encoding: UTF-8 -RoxygenNote: 7.1.1 +Language: en-US +RoxygenNote: 7.1.2 Collate: 'CommentClass.R' 'HyperlinkClass.R' 'RcppExports.R' 'class_definitions.R' 'StyleClass.R' 'WorkbookClass.R' 'asserts.R' 'baseXML.R' 'borderFunctions.R' 'build_workbook.R' @@ -56,7 +56,7 @@ 'worksheet_class.R' 'wrappers.R' 'writeData.R' 'writeDataTable.R' 'writexlsx.R' 'zzz.R' NeedsCompilation: yes -Packaged: 2021-06-15 11:54:54 UTC; philipp +Packaged: 2021-12-13 22:06:56 UTC; PhilippSchauberger Author: Philipp Schauberger [aut, cre], Alexander Walker [aut], Luca Braglia [ctb], @@ -65,4 +65,4 @@ Jordan Mark Barbone [ctb] () Maintainer: Philipp Schauberger Repository: CRAN -Date/Publication: 2021-06-16 04:20:03 UTC +Date/Publication: 2021-12-14 14:20:06 UTC diff -Nru r-cran-openxlsx-4.2.4/inst/doc/Formatting.html r-cran-openxlsx-4.2.5/inst/doc/Formatting.html --- r-cran-openxlsx-4.2.4/inst/doc/Formatting.html 2021-06-15 11:54:53.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/doc/Formatting.html 2021-12-13 22:06:54.000000000 +0000 @@ -1,447 +1,455 @@ - - - - - - - - - - - - - - - - -Formating with xlsx - - - - - - - - - - - - - - - - - - - - - - - - - -

Formating with xlsx

-

Alexander Walker, Philipp Schauberger

-

2021-06-15

- - - -
-

Formatting with writeData and writeDataTable

-
## data.frame to write
-df <- data.frame("Date" = Sys.Date()-0:4,
-                 "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE),
-                 "Currency" = paste("$",-2:2),
-                 "Accounting" = -2:2,
-                 "hLink" = "https://CRAN.R-project.org/", 
-                 "Percentage" = seq(-1, 1, length.out=5),
-                 "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE)
-
-class(df$Currency) <- "currency"
-class(df$Accounting) <- "accounting"
-class(df$hLink) <- "hyperlink"
-class(df$Percentage) <- "percentage"
-class(df$TinyNumber) <- "scientific"
-
-## Formatting can be applied simply through the write functions
-## global options can be set to further simplify things
-options("openxlsx.borderStyle" = "thin")
-options("openxlsx.borderColour" = "#4F81BD")
-
-## create a workbook and add a worksheet
-wb <- createWorkbook()
-addWorksheet(wb, "writeData auto-formatting")
-
-writeData(wb, 1, df, startRow = 2, startCol = 2)
-writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding")
-writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows")
-writeData(wb, 1, df, startRow = 23, startCol = 2, borders ="columns")
-writeData(wb, 1, df, startRow = 30, startCol = 2, borders ="all")
-
-## headerStyles
-hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold",
-                   border = "Bottom", fontColour = "white")
-
-writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1,
-          borders = "rows", borderStyle = "medium")
-
-## to change the display text for a hyperlink column just write over those cells
-writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14)
-
-
-## writing as an Excel Table
-
-addWorksheet(wb, "writeDataTable")
-writeDataTable(wb, 2, df, startRow = 2, startCol = 2)
-writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9")
-writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2")
-writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21")
-
-openXL(wb) ## opens a temp version
-
-
-

Use of pre-defined table styles

-

The ‘tableStyle’ argument in writeDataTable can be any of the predefined tableStyles in Excel.

-

-
-
-

Date Formatting

-
# data.frame of dates
-dates <- data.frame("d1" = Sys.Date() - 0:4)
-for(i in 1:3) dates <- cbind(dates, dates)
-names(dates) <- paste0("d", 1:8)
-
-## Date Formatting
-wb <- createWorkbook()
-addWorksheet(wb, "Date Formatting", gridLines = FALSE)
-writeData(wb, 1, dates) ## write without styling
-
-## openxlsx converts columns of class "Date" to Excel dates with the format given by
-getOption("openxlsx.dateFormat", "mm/dd/yyyy")
-
-## this can be set via (for example)
-options("openxlsx.dateFormat" = "yyyy/mm/dd")
-## custom date formats can be made up of any combination of:
-##   d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy
-
-## numFmt == "DATE" will use the date format specified by the above
-addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) 
-
-## some custom date format examples
-sty <- createStyle(numFmt = "yyyy/mm/dd")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "yyyy/mmm/dd")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "yy / mmmm / dd")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "ddddd")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "yyyy-mmm-dd")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "mm/ dd yyyy")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "mm/dd/yy")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE)
-
-setColWidths(wb, 1, cols = 1:10, widths = 23)
-
-## The default date format used in writeData and writeDataTable can be set with:
-options("openxlsx.dateFormat" = "dd/mm/yyyy")
-writeData(wb, "Date Formatting", dates, startRow  = 8, borders = "rows")
-options("openxlsx.dateFormat" = "yyyy-mm-dd")
-writeData(wb, "Date Formatting", dates, startRow  = 15)
-
-saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE)
-
-
-

DateTime Formatting

-

The conversion from POSIX to Excel datetimes is dependent on the timezone you are in. If POSIX values are being written incorrectly, try setting the timezone with (for example)

-
Sys.setenv(TZ = "Australia/Sydney")
-
-dateTimes <- data.frame("d1" = Sys.time() - 0:4*10000)
-for(i in 1:2) dateTimes <- cbind(dateTimes, dateTimes)
-names(dateTimes) <- paste0("d", 1:4)
-
-## POSIX Formatting
-wb <- createWorkbook()
-addWorksheet(wb, "DateTime Formatting", gridLines = FALSE)
-writeData(wb, 1, dateTimes) ## write without styling
-
-## openxlsx converts columns of class "POSIxt" to Excel datetimes with the format given by
-getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss")
-
-## this can be set via (for example)
-options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss")
-## custom datetime formats can be made up of any combination of:
-## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM
-
-## numFmt == "LONGDATE" will use the date format specified by the above
-long_date_style <- createStyle(numFmt = "LONGDATE")
-addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE) 
-
-## some custom date format examples
-sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "hh:mm:ss AM/PM")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE)
-
-sty <- createStyle(numFmt = "hh:mm:ss")
-addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE)
-
-setColWidths(wb, 1, cols = 1:4, widths = 30)
-
-## The default date format used in writeData and writeDataTable can be set with:
-options("openxlsx.datetimeFormat" = "yyyy/mm/dd hh:mm:ss")
-writeData(wb, "DateTime Formatting", dateTimes, startRow  = 8, borders = "rows")
-
-options("openxlsx.datetimeFormat" = "hh:mm:ss AM/PM")
-writeDataTable(wb, "DateTime Formatting", dateTimes, startRow  = 15)
-
-saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE)
-openXL("DateTime Formatting.xlsx")
-
-
-

Conditional Formatting

-
wb <- createWorkbook()
-addWorksheet(wb, "cellIs")
-addWorksheet(wb, "Moving Row")
-addWorksheet(wb, "Moving Col")
-addWorksheet(wb, "Dependent on 1")
-addWorksheet(wb, "Duplicates")
-addWorksheet(wb, "containsText")
-addWorksheet(wb, "colourScale", zoom = 30)
-addWorksheet(wb, "databar")
-
-negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
-posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE")
-
-## rule applies to all each cell in range
-writeData(wb, "cellIs", -5:5)
-writeData(wb, "cellIs", LETTERS[1:11], startCol=2)
-conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="!=0", style = negStyle)
-conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="==0", style = posStyle)
-
-## highlight row dependent on first cell in row
-writeData(wb, "Moving Row", -5:5)
-writeData(wb, "Moving Row", LETTERS[1:11], startCol=2)
-conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1<0", style = negStyle)
-conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1>0", style = posStyle)
-
-## highlight column dependent on first cell in column
-writeData(wb, "Moving Col", -5:5)
-writeData(wb, "Moving Col", LETTERS[1:11], startCol=2)
-conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1<0", style = negStyle)
-conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1>0", style = posStyle)
-
-## highlight entire range cols X rows dependent only on cell A1
-writeData(wb, "Dependent on 1", -5:5)
-writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2)
-conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1<0", style = negStyle)
-conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1>0", style = posStyle)
-
-## highlight duplicates using default style
-writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE))
-conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates")
-
-## cells containing text
-fn <- function(x) paste(sample(LETTERS, 10), collapse = "-")
-writeData(wb, "containsText", sapply(1:10, fn))
-conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A")
-
-## colourscale colours cells based on cell value
-df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4)
-writeData(wb, "colourScale", df, colNames=FALSE)  ## write data.frame
-
-## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours())
-## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL.
-conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df),
-   style = c("black", "white"), 
-   rule = c(0, 255), 
-   type = "colourScale")
-
-setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07)
-setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) 
-
-## Databars
-writeData(wb, "databar", -5:5)
-conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours
-
-saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE)
-
-openXL(wb)
-
-
-

Numeric Formatting

-

numeric columns styling can be set using the numFmt parameter in createStyle or a default can be set with, for example, options(“openxlsx.numFmt” = “#,#0.00”)

-
options("openxlsx.numFmt" = NULL)
-wb <- createWorkbook()
-addWorksheet(wb, "Sheet 1")
-df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5)) ## data.frame to write
-df[ ,6:7] <- df[ ,6:7]*1E6
-
-## Set column 1 class to "comma" to get comma separated thousands
-class(df$X1) <- "comma"
-
-writeData(wb, 1, df)
-s <- createStyle(numFmt = "0.0")
-addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE)
-
-s <- createStyle(numFmt = "0.00")
-addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE)
-
-s <- createStyle(numFmt = "0.000")
-addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE)
-
-s <- createStyle(numFmt = "#,##0")
-addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE)
-
-s <- createStyle(numFmt = "#,##0.00")
-addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE)
-
-s <- createStyle(numFmt = "$ #,##0.00")
-addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE)
-
-## set a default number format for numeric columns of data.frames
-options("openxlsx.numFmt" = "$* #,#0.00")
-writeData(wb, 1, x = data.frame("Using Default Options" = rep(2345.1235, 5)), startCol = 9)
-
-setColWidths(wb, 1, cols = 1:10, widths = 15)
-
-## Using default numFmt to round to 2 dp (Any numeric column will be affected)
-addWorksheet(wb, "Sheet 2")
-df <- iris; df[, 1:4] <- df[1:4] + runif(1)
-writeDataTable(wb, sheet = 2, x = df)
-writeData(wb, sheet = 2, x = df, startCol = 7)
-writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows")
-
-## To stop auto-formatting numerics set
-options("openxlsx.numFmt" = NULL)
-addWorksheet(wb, "Sheet 3")
-writeDataTable(wb, sheet = 3, x = df)
-
-openXL(wb)
-
- - - - - - - - - - - + + + + + + + + + + + + + + + + +Formating with xlsx + + + + + + + + + + + + + + + + + + + + + + + + + +

Formating with xlsx

+

Alexander Walker, Philipp Schauberger

+

2021-12-13

+ + + +
+

Formatting with writeData and writeDataTable

+
## data.frame to write
+df <- data.frame(Date = Sys.Date() - 0:4, Logical = c(TRUE, FALSE, TRUE, TRUE, FALSE),
+    Currency = paste("$", -2:2), Accounting = -2:2, hLink = "https://CRAN.R-project.org/",
+    Percentage = seq(-1, 1, length.out = 5), TinyNumber = runif(5)/1e+09, stringsAsFactors = FALSE)
+
+class(df$Currency) <- "currency"
+class(df$Accounting) <- "accounting"
+class(df$hLink) <- "hyperlink"
+class(df$Percentage) <- "percentage"
+class(df$TinyNumber) <- "scientific"
+
+## Formatting can be applied simply through the write functions global options
+## can be set to further simplify things
+options(openxlsx.borderStyle = "thin")
+options(openxlsx.borderColour = "#4F81BD")
+
+## create a workbook and add a worksheet
+wb <- createWorkbook()
+addWorksheet(wb, "writeData auto-formatting")
+
+writeData(wb, 1, df, startRow = 2, startCol = 2)
+writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding")
+writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows")
+writeData(wb, 1, df, startRow = 23, startCol = 2, borders = "columns")
+writeData(wb, 1, df, startRow = 30, startCol = 2, borders = "all")
+
+## headerStyles
+hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold",
+    border = "Bottom", fontColour = "white")
+
+writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1, borders = "rows",
+    borderStyle = "medium")
+
+## to change the display text for a hyperlink column just write over those
+## cells
+writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14)
+
+
+## writing as an Excel Table
+
+addWorksheet(wb, "writeDataTable")
+writeDataTable(wb, 2, df, startRow = 2, startCol = 2)
+writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9")
+writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2")
+writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21")
+
+openXL(wb)  ## opens a temp version
+
+
+

Use of pre-defined table styles

+

The ‘tableStyle’ argument in writeDataTable can be any of the predefined tableStyles in Excel.

+

+
+
+

Date Formatting

+
# data.frame of dates
+dates <- data.frame(d1 = Sys.Date() - 0:4)
+for (i in 1:3) dates <- cbind(dates, dates)
+names(dates) <- paste0("d", 1:8)
+
+## Date Formatting
+wb <- createWorkbook()
+addWorksheet(wb, "Date Formatting", gridLines = FALSE)
+writeData(wb, 1, dates)  ## write without styling
+
+## openxlsx converts columns of class 'Date' to Excel dates with the format
+## given by
+getOption("openxlsx.dateFormat", "mm/dd/yyyy")
+
+## this can be set via (for example)
+options(openxlsx.dateFormat = "yyyy/mm/dd")
+## custom date formats can be made up of any combination of: d, dd, ddd, dddd,
+## m, mm, mmm, mmmm, mmmmm, yy, yyyy
+
+## numFmt == 'DATE' will use the date format specified by the above
+addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE)
+
+## some custom date format examples
+sty <- createStyle(numFmt = "yyyy/mm/dd")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "yyyy/mmm/dd")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "yy / mmmm / dd")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "ddddd")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "yyyy-mmm-dd")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "mm/ dd yyyy")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "mm/dd/yy")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE)
+
+setColWidths(wb, 1, cols = 1:10, widths = 23)
+
+## The default date format used in writeData and writeDataTable can be set
+## with:
+options(openxlsx.dateFormat = "dd/mm/yyyy")
+writeData(wb, "Date Formatting", dates, startRow = 8, borders = "rows")
+options(openxlsx.dateFormat = "yyyy-mm-dd")
+writeData(wb, "Date Formatting", dates, startRow = 15)
+
+saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE)
+
+
+

DateTime Formatting

+

The conversion from POSIX to Excel datetimes is dependent on the timezone you are in. If POSIX values are being written incorrectly, try setting the timezone with (for example)

+
Sys.setenv(TZ = "Australia/Sydney")
+
+dateTimes <- data.frame(d1 = Sys.time() - 0:4 * 10000)
+for (i in 1:2) dateTimes <- cbind(dateTimes, dateTimes)
+names(dateTimes) <- paste0("d", 1:4)
+
+## POSIX Formatting
+wb <- createWorkbook()
+addWorksheet(wb, "DateTime Formatting", gridLines = FALSE)
+writeData(wb, 1, dateTimes)  ## write without styling
+
+## openxlsx converts columns of class 'POSIxt' to Excel datetimes with the
+## format given by
+getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss")
+
+## this can be set via (for example)
+options(openxlsx.datetimeFormat = "yyyy-mm-dd hh:mm:ss")
+## custom datetime formats can be made up of any combination of: d, dd, ddd,
+## dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM
+
+## numFmt == 'LONGDATE' will use the date format specified by the above
+long_date_style <- createStyle(numFmt = "LONGDATE")
+addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE)
+
+## some custom date format examples
+sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "hh:mm:ss AM/PM")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE)
+
+sty <- createStyle(numFmt = "hh:mm:ss")
+addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE)
+
+setColWidths(wb, 1, cols = 1:4, widths = 30)
+
+## The default date format used in writeData and writeDataTable can be set
+## with:
+options(openxlsx.datetimeFormat = "yyyy/mm/dd hh:mm:ss")
+writeData(wb, "DateTime Formatting", dateTimes, startRow = 8, borders = "rows")
+
+options(openxlsx.datetimeFormat = "hh:mm:ss AM/PM")
+writeDataTable(wb, "DateTime Formatting", dateTimes, startRow = 15)
+
+saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE)
+openXL("DateTime Formatting.xlsx")
+
+
+

Conditional Formatting

+
wb <- createWorkbook()
+addWorksheet(wb, "cellIs")
+addWorksheet(wb, "Moving Row")
+addWorksheet(wb, "Moving Col")
+addWorksheet(wb, "Dependent on 1")
+addWorksheet(wb, "Duplicates")
+addWorksheet(wb, "containsText")
+addWorksheet(wb, "colourScale", zoom = 30)
+addWorksheet(wb, "databar")
+
+negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
+posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE")
+
+## rule applies to all each cell in range
+writeData(wb, "cellIs", -5:5)
+writeData(wb, "cellIs", LETTERS[1:11], startCol = 2)
+conditionalFormatting(wb, "cellIs", cols = 1, rows = 1:11, rule = "!=0", style = negStyle)
+conditionalFormatting(wb, "cellIs", cols = 1, rows = 1:11, rule = "==0", style = posStyle)
+
+## highlight row dependent on first cell in row
+writeData(wb, "Moving Row", -5:5)
+writeData(wb, "Moving Row", LETTERS[1:11], startCol = 2)
+conditionalFormatting(wb, "Moving Row", cols = 1:2, rows = 1:11, rule = "$A1<0",
+    style = negStyle)
+conditionalFormatting(wb, "Moving Row", cols = 1:2, rows = 1:11, rule = "$A1>0",
+    style = posStyle)
+
+## highlight column dependent on first cell in column
+writeData(wb, "Moving Col", -5:5)
+writeData(wb, "Moving Col", LETTERS[1:11], startCol = 2)
+conditionalFormatting(wb, "Moving Col", cols = 1:2, rows = 1:11, rule = "A$1<0",
+    style = negStyle)
+conditionalFormatting(wb, "Moving Col", cols = 1:2, rows = 1:11, rule = "A$1>0",
+    style = posStyle)
+
+## highlight entire range cols X rows dependent only on cell A1
+writeData(wb, "Dependent on 1", -5:5)
+writeData(wb, "Dependent on 1", LETTERS[1:11], startCol = 2)
+conditionalFormatting(wb, "Dependent on 1", cols = 1:2, rows = 1:11, rule = "$A$1<0",
+    style = negStyle)
+conditionalFormatting(wb, "Dependent on 1", cols = 1:2, rows = 1:11, rule = "$A$1>0",
+    style = posStyle)
+
+## highlight duplicates using default style
+writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE))
+conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates")
+
+## cells containing text
+fn <- function(x) paste(sample(LETTERS, 10), collapse = "-")
+writeData(wb, "containsText", sapply(1:10, fn))
+conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains",
+    rule = "A")
+
+## colourscale colours cells based on cell value
+df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4)
+writeData(wb, "colourScale", df, colNames = FALSE)  ## write data.frame
+
+## rule is a vector or colours of length 2 or 3 (any hex colour or any of
+## colours()) If rule is NULL, min and max of cells is used. Rule must be the
+## same length as style or NULL.
+conditionalFormatting(wb, "colourScale", cols = 1:ncol(df), rows = 1:nrow(df), style = c("black",
+    "white"), rule = c(0, 255), type = "colourScale")
+
+setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07)
+setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5)
+
+## Databars
+writeData(wb, "databar", -5:5)
+conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar")  ## Default colours
+
+saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE)
+
+openXL(wb)
+
+
+

Numeric Formatting

+

numeric columns styling can be set using the numFmt parameter in createStyle or a default can be set with, for example, options(“openxlsx.numFmt” = “#,#0.00”)

+
options(openxlsx.numFmt = NULL)
+wb <- createWorkbook()
+addWorksheet(wb, "Sheet 1")
+df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5))  ## data.frame to write
+df[, 6:7] <- df[, 6:7] * 1e+06
+
+## Set column 1 class to 'comma' to get comma separated thousands
+class(df$X1) <- "comma"
+
+writeData(wb, 1, df)
+s <- createStyle(numFmt = "0.0")
+addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE)
+
+s <- createStyle(numFmt = "0.00")
+addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE)
+
+s <- createStyle(numFmt = "0.000")
+addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE)
+
+s <- createStyle(numFmt = "#,##0")
+addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE)
+
+s <- createStyle(numFmt = "#,##0.00")
+addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE)
+
+s <- createStyle(numFmt = "$ #,##0.00")
+addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE)
+
+## set a default number format for numeric columns of data.frames
+options(openxlsx.numFmt = "$* #,#0.00")
+writeData(wb, 1, x = data.frame(`Using Default Options` = rep(2345.1235, 5)), startCol = 9)
+
+setColWidths(wb, 1, cols = 1:10, widths = 15)
+
+## Using default numFmt to round to 2 dp (Any numeric column will be affected)
+addWorksheet(wb, "Sheet 2")
+df <- iris
+df[, 1:4] <- df[1:4] + runif(1)
+writeDataTable(wb, sheet = 2, x = df)
+writeData(wb, sheet = 2, x = df, startCol = 7)
+writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows")
+
+## To stop auto-formatting numerics set
+options(openxlsx.numFmt = NULL)
+addWorksheet(wb, "Sheet 3")
+writeDataTable(wb, sheet = 3, x = df)
+
+openXL(wb)
+
+ + + + + + + + + + + diff -Nru r-cran-openxlsx-4.2.4/inst/doc/Formatting.R r-cran-openxlsx-4.2.5/inst/doc/Formatting.R --- r-cran-openxlsx-4.2.4/inst/doc/Formatting.R 2021-06-15 11:54:52.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/doc/Formatting.R 2021-12-13 22:06:53.000000000 +0000 @@ -1,278 +1,278 @@ -## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- -# -# ## data.frame to write -# df <- data.frame("Date" = Sys.Date()-0:4, -# "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), -# "Currency" = paste("$",-2:2), -# "Accounting" = -2:2, -# "hLink" = "https://CRAN.R-project.org/", -# "Percentage" = seq(-1, 1, length.out=5), -# "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE) -# -# class(df$Currency) <- "currency" -# class(df$Accounting) <- "accounting" -# class(df$hLink) <- "hyperlink" -# class(df$Percentage) <- "percentage" -# class(df$TinyNumber) <- "scientific" -# -# ## Formatting can be applied simply through the write functions -# ## global options can be set to further simplify things -# options("openxlsx.borderStyle" = "thin") -# options("openxlsx.borderColour" = "#4F81BD") -# -# ## create a workbook and add a worksheet -# wb <- createWorkbook() -# addWorksheet(wb, "writeData auto-formatting") -# -# writeData(wb, 1, df, startRow = 2, startCol = 2) -# writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding") -# writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows") -# writeData(wb, 1, df, startRow = 23, startCol = 2, borders ="columns") -# writeData(wb, 1, df, startRow = 30, startCol = 2, borders ="all") -# -# ## headerStyles -# hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold", -# border = "Bottom", fontColour = "white") -# -# writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1, -# borders = "rows", borderStyle = "medium") -# -# ## to change the display text for a hyperlink column just write over those cells -# writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14) -# -# -# ## writing as an Excel Table -# -# addWorksheet(wb, "writeDataTable") -# writeDataTable(wb, 2, df, startRow = 2, startCol = 2) -# writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9") -# writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2") -# writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21") -# -# openXL(wb) ## opens a temp version - -## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- -# -# # data.frame of dates -# dates <- data.frame("d1" = Sys.Date() - 0:4) -# for(i in 1:3) dates <- cbind(dates, dates) -# names(dates) <- paste0("d", 1:8) -# -# ## Date Formatting -# wb <- createWorkbook() -# addWorksheet(wb, "Date Formatting", gridLines = FALSE) -# writeData(wb, 1, dates) ## write without styling -# -# ## openxlsx converts columns of class "Date" to Excel dates with the format given by -# getOption("openxlsx.dateFormat", "mm/dd/yyyy") -# -# ## this can be set via (for example) -# options("openxlsx.dateFormat" = "yyyy/mm/dd") -# ## custom date formats can be made up of any combination of: -# ## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy -# -# ## numFmt == "DATE" will use the date format specified by the above -# addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) -# -# ## some custom date format examples -# sty <- createStyle(numFmt = "yyyy/mm/dd") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "yyyy/mmm/dd") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "yy / mmmm / dd") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "ddddd") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "yyyy-mmm-dd") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "mm/ dd yyyy") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "mm/dd/yy") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) -# -# setColWidths(wb, 1, cols = 1:10, widths = 23) -# -# ## The default date format used in writeData and writeDataTable can be set with: -# options("openxlsx.dateFormat" = "dd/mm/yyyy") -# writeData(wb, "Date Formatting", dates, startRow = 8, borders = "rows") -# options("openxlsx.dateFormat" = "yyyy-mm-dd") -# writeData(wb, "Date Formatting", dates, startRow = 15) -# -# saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE) -# - -## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- -# -# Sys.setenv(TZ = "Australia/Sydney") -# -# dateTimes <- data.frame("d1" = Sys.time() - 0:4*10000) -# for(i in 1:2) dateTimes <- cbind(dateTimes, dateTimes) -# names(dateTimes) <- paste0("d", 1:4) -# -# ## POSIX Formatting -# wb <- createWorkbook() -# addWorksheet(wb, "DateTime Formatting", gridLines = FALSE) -# writeData(wb, 1, dateTimes) ## write without styling -# -# ## openxlsx converts columns of class "POSIxt" to Excel datetimes with the format given by -# getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss") -# -# ## this can be set via (for example) -# options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -# ## custom datetime formats can be made up of any combination of: -# ## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM -# -# ## numFmt == "LONGDATE" will use the date format specified by the above -# long_date_style <- createStyle(numFmt = "LONGDATE") -# addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE) -# -# ## some custom date format examples -# sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "hh:mm:ss AM/PM") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) -# -# sty <- createStyle(numFmt = "hh:mm:ss") -# addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) -# -# setColWidths(wb, 1, cols = 1:4, widths = 30) -# -# ## The default date format used in writeData and writeDataTable can be set with: -# options("openxlsx.datetimeFormat" = "yyyy/mm/dd hh:mm:ss") -# writeData(wb, "DateTime Formatting", dateTimes, startRow = 8, borders = "rows") -# -# options("openxlsx.datetimeFormat" = "hh:mm:ss AM/PM") -# writeDataTable(wb, "DateTime Formatting", dateTimes, startRow = 15) -# -# saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE) -# openXL("DateTime Formatting.xlsx") -# - -## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- -# -# wb <- createWorkbook() -# addWorksheet(wb, "cellIs") -# addWorksheet(wb, "Moving Row") -# addWorksheet(wb, "Moving Col") -# addWorksheet(wb, "Dependent on 1") -# addWorksheet(wb, "Duplicates") -# addWorksheet(wb, "containsText") -# addWorksheet(wb, "colourScale", zoom = 30) -# addWorksheet(wb, "databar") -# -# negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -# posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") -# -# ## rule applies to all each cell in range -# writeData(wb, "cellIs", -5:5) -# writeData(wb, "cellIs", LETTERS[1:11], startCol=2) -# conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="!=0", style = negStyle) -# conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="==0", style = posStyle) -# -# ## highlight row dependent on first cell in row -# writeData(wb, "Moving Row", -5:5) -# writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) -# conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1<0", style = negStyle) -# conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1>0", style = posStyle) -# -# ## highlight column dependent on first cell in column -# writeData(wb, "Moving Col", -5:5) -# writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) -# conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1<0", style = negStyle) -# conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1>0", style = posStyle) -# -# ## highlight entire range cols X rows dependent only on cell A1 -# writeData(wb, "Dependent on 1", -5:5) -# writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) -# conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1<0", style = negStyle) -# conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1>0", style = posStyle) -# -# ## highlight duplicates using default style -# writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) -# conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") -# -# ## cells containing text -# fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -# writeData(wb, "containsText", sapply(1:10, fn)) -# conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") -# -# ## colourscale colours cells based on cell value -# df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4) -# writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame -# -# ## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) -# ## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. -# conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), -# style = c("black", "white"), -# rule = c(0, 255), -# type = "colourScale") -# -# setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) -# setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) -# -# ## Databars -# writeData(wb, "databar", -5:5) -# conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours -# -# saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) -# -# openXL(wb) -# - -## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- -# -# options("openxlsx.numFmt" = NULL) -# wb <- createWorkbook() -# addWorksheet(wb, "Sheet 1") -# df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5)) ## data.frame to write -# df[ ,6:7] <- df[ ,6:7]*1E6 -# -# ## Set column 1 class to "comma" to get comma separated thousands -# class(df$X1) <- "comma" -# -# writeData(wb, 1, df) -# s <- createStyle(numFmt = "0.0") -# addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE) -# -# s <- createStyle(numFmt = "0.00") -# addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE) -# -# s <- createStyle(numFmt = "0.000") -# addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE) -# -# s <- createStyle(numFmt = "#,##0") -# addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE) -# -# s <- createStyle(numFmt = "#,##0.00") -# addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE) -# -# s <- createStyle(numFmt = "$ #,##0.00") -# addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE) -# -# ## set a default number format for numeric columns of data.frames -# options("openxlsx.numFmt" = "$* #,#0.00") -# writeData(wb, 1, x = data.frame("Using Default Options" = rep(2345.1235, 5)), startCol = 9) -# -# setColWidths(wb, 1, cols = 1:10, widths = 15) -# -# ## Using default numFmt to round to 2 dp (Any numeric column will be affected) -# addWorksheet(wb, "Sheet 2") -# df <- iris; df[, 1:4] <- df[1:4] + runif(1) -# writeDataTable(wb, sheet = 2, x = df) -# writeData(wb, sheet = 2, x = df, startCol = 7) -# writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows") -# -# ## To stop auto-formatting numerics set -# options("openxlsx.numFmt" = NULL) -# addWorksheet(wb, "Sheet 3") -# writeDataTable(wb, sheet = 3, x = df) -# -# openXL(wb) - +## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- +# +# ## data.frame to write +# df <- data.frame("Date" = Sys.Date()-0:4, +# "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), +# "Currency" = paste("$",-2:2), +# "Accounting" = -2:2, +# "hLink" = "https://CRAN.R-project.org/", +# "Percentage" = seq(-1, 1, length.out=5), +# "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE) +# +# class(df$Currency) <- "currency" +# class(df$Accounting) <- "accounting" +# class(df$hLink) <- "hyperlink" +# class(df$Percentage) <- "percentage" +# class(df$TinyNumber) <- "scientific" +# +# ## Formatting can be applied simply through the write functions +# ## global options can be set to further simplify things +# options("openxlsx.borderStyle" = "thin") +# options("openxlsx.borderColour" = "#4F81BD") +# +# ## create a workbook and add a worksheet +# wb <- createWorkbook() +# addWorksheet(wb, "writeData auto-formatting") +# +# writeData(wb, 1, df, startRow = 2, startCol = 2) +# writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding") +# writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows") +# writeData(wb, 1, df, startRow = 23, startCol = 2, borders ="columns") +# writeData(wb, 1, df, startRow = 30, startCol = 2, borders ="all") +# +# ## headerStyles +# hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold", +# border = "Bottom", fontColour = "white") +# +# writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1, +# borders = "rows", borderStyle = "medium") +# +# ## to change the display text for a hyperlink column just write over those cells +# writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14) +# +# +# ## writing as an Excel Table +# +# addWorksheet(wb, "writeDataTable") +# writeDataTable(wb, 2, df, startRow = 2, startCol = 2) +# writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9") +# writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2") +# writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21") +# +# openXL(wb) ## opens a temp version + +## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- +# +# # data.frame of dates +# dates <- data.frame("d1" = Sys.Date() - 0:4) +# for(i in 1:3) dates <- cbind(dates, dates) +# names(dates) <- paste0("d", 1:8) +# +# ## Date Formatting +# wb <- createWorkbook() +# addWorksheet(wb, "Date Formatting", gridLines = FALSE) +# writeData(wb, 1, dates) ## write without styling +# +# ## openxlsx converts columns of class "Date" to Excel dates with the format given by +# getOption("openxlsx.dateFormat", "mm/dd/yyyy") +# +# ## this can be set via (for example) +# options("openxlsx.dateFormat" = "yyyy/mm/dd") +# ## custom date formats can be made up of any combination of: +# ## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy +# +# ## numFmt == "DATE" will use the date format specified by the above +# addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) +# +# ## some custom date format examples +# sty <- createStyle(numFmt = "yyyy/mm/dd") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "yyyy/mmm/dd") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "yy / mmmm / dd") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "ddddd") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "yyyy-mmm-dd") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "mm/ dd yyyy") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "mm/dd/yy") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) +# +# setColWidths(wb, 1, cols = 1:10, widths = 23) +# +# ## The default date format used in writeData and writeDataTable can be set with: +# options("openxlsx.dateFormat" = "dd/mm/yyyy") +# writeData(wb, "Date Formatting", dates, startRow = 8, borders = "rows") +# options("openxlsx.dateFormat" = "yyyy-mm-dd") +# writeData(wb, "Date Formatting", dates, startRow = 15) +# +# saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE) +# + +## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- +# +# Sys.setenv(TZ = "Australia/Sydney") +# +# dateTimes <- data.frame("d1" = Sys.time() - 0:4*10000) +# for(i in 1:2) dateTimes <- cbind(dateTimes, dateTimes) +# names(dateTimes) <- paste0("d", 1:4) +# +# ## POSIX Formatting +# wb <- createWorkbook() +# addWorksheet(wb, "DateTime Formatting", gridLines = FALSE) +# writeData(wb, 1, dateTimes) ## write without styling +# +# ## openxlsx converts columns of class "POSIxt" to Excel datetimes with the format given by +# getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss") +# +# ## this can be set via (for example) +# options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +# ## custom datetime formats can be made up of any combination of: +# ## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM +# +# ## numFmt == "LONGDATE" will use the date format specified by the above +# long_date_style <- createStyle(numFmt = "LONGDATE") +# addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE) +# +# ## some custom date format examples +# sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "hh:mm:ss AM/PM") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) +# +# sty <- createStyle(numFmt = "hh:mm:ss") +# addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) +# +# setColWidths(wb, 1, cols = 1:4, widths = 30) +# +# ## The default date format used in writeData and writeDataTable can be set with: +# options("openxlsx.datetimeFormat" = "yyyy/mm/dd hh:mm:ss") +# writeData(wb, "DateTime Formatting", dateTimes, startRow = 8, borders = "rows") +# +# options("openxlsx.datetimeFormat" = "hh:mm:ss AM/PM") +# writeDataTable(wb, "DateTime Formatting", dateTimes, startRow = 15) +# +# saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE) +# openXL("DateTime Formatting.xlsx") +# + +## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- +# +# wb <- createWorkbook() +# addWorksheet(wb, "cellIs") +# addWorksheet(wb, "Moving Row") +# addWorksheet(wb, "Moving Col") +# addWorksheet(wb, "Dependent on 1") +# addWorksheet(wb, "Duplicates") +# addWorksheet(wb, "containsText") +# addWorksheet(wb, "colourScale", zoom = 30) +# addWorksheet(wb, "databar") +# +# negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +# posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") +# +# ## rule applies to all each cell in range +# writeData(wb, "cellIs", -5:5) +# writeData(wb, "cellIs", LETTERS[1:11], startCol=2) +# conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="!=0", style = negStyle) +# conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="==0", style = posStyle) +# +# ## highlight row dependent on first cell in row +# writeData(wb, "Moving Row", -5:5) +# writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) +# conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1<0", style = negStyle) +# conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1>0", style = posStyle) +# +# ## highlight column dependent on first cell in column +# writeData(wb, "Moving Col", -5:5) +# writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) +# conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1<0", style = negStyle) +# conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1>0", style = posStyle) +# +# ## highlight entire range cols X rows dependent only on cell A1 +# writeData(wb, "Dependent on 1", -5:5) +# writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) +# conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1<0", style = negStyle) +# conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1>0", style = posStyle) +# +# ## highlight duplicates using default style +# writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) +# conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") +# +# ## cells containing text +# fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +# writeData(wb, "containsText", sapply(1:10, fn)) +# conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") +# +# ## colourscale colours cells based on cell value +# df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4) +# writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame +# +# ## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) +# ## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. +# conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), +# style = c("black", "white"), +# rule = c(0, 255), +# type = "colourScale") +# +# setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) +# setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) +# +# ## Databars +# writeData(wb, "databar", -5:5) +# conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours +# +# saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) +# +# openXL(wb) +# + +## ----include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE---------------------- +# +# options("openxlsx.numFmt" = NULL) +# wb <- createWorkbook() +# addWorksheet(wb, "Sheet 1") +# df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5)) ## data.frame to write +# df[ ,6:7] <- df[ ,6:7]*1E6 +# +# ## Set column 1 class to "comma" to get comma separated thousands +# class(df$X1) <- "comma" +# +# writeData(wb, 1, df) +# s <- createStyle(numFmt = "0.0") +# addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE) +# +# s <- createStyle(numFmt = "0.00") +# addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE) +# +# s <- createStyle(numFmt = "0.000") +# addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE) +# +# s <- createStyle(numFmt = "#,##0") +# addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE) +# +# s <- createStyle(numFmt = "#,##0.00") +# addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE) +# +# s <- createStyle(numFmt = "$ #,##0.00") +# addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE) +# +# ## set a default number format for numeric columns of data.frames +# options("openxlsx.numFmt" = "$* #,#0.00") +# writeData(wb, 1, x = data.frame("Using Default Options" = rep(2345.1235, 5)), startCol = 9) +# +# setColWidths(wb, 1, cols = 1:10, widths = 15) +# +# ## Using default numFmt to round to 2 dp (Any numeric column will be affected) +# addWorksheet(wb, "Sheet 2") +# df <- iris; df[, 1:4] <- df[1:4] + runif(1) +# writeDataTable(wb, sheet = 2, x = df) +# writeData(wb, sheet = 2, x = df, startCol = 7) +# writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows") +# +# ## To stop auto-formatting numerics set +# options("openxlsx.numFmt" = NULL) +# addWorksheet(wb, "Sheet 3") +# writeDataTable(wb, sheet = 3, x = df) +# +# openXL(wb) + diff -Nru r-cran-openxlsx-4.2.4/inst/doc/Formatting.Rmd r-cran-openxlsx-4.2.5/inst/doc/Formatting.Rmd --- r-cran-openxlsx-4.2.4/inst/doc/Formatting.Rmd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/doc/Formatting.Rmd 2021-12-13 08:14:44.000000000 +0000 @@ -1,326 +1,326 @@ ---- -title: "Formating with xlsx" -author: "Alexander Walker, Philipp Schauberger" -date: "`r Sys.Date()`" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{Formating with xlsx} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - - -## Formatting with writeData and writeDataTable - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -## data.frame to write -df <- data.frame("Date" = Sys.Date()-0:4, - "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), - "Currency" = paste("$",-2:2), - "Accounting" = -2:2, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(-1, 1, length.out=5), - "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE) - -class(df$Currency) <- "currency" -class(df$Accounting) <- "accounting" -class(df$hLink) <- "hyperlink" -class(df$Percentage) <- "percentage" -class(df$TinyNumber) <- "scientific" - -## Formatting can be applied simply through the write functions -## global options can be set to further simplify things -options("openxlsx.borderStyle" = "thin") -options("openxlsx.borderColour" = "#4F81BD") - -## create a workbook and add a worksheet -wb <- createWorkbook() -addWorksheet(wb, "writeData auto-formatting") - -writeData(wb, 1, df, startRow = 2, startCol = 2) -writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding") -writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows") -writeData(wb, 1, df, startRow = 23, startCol = 2, borders ="columns") -writeData(wb, 1, df, startRow = 30, startCol = 2, borders ="all") - -## headerStyles -hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold", - border = "Bottom", fontColour = "white") - -writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1, - borders = "rows", borderStyle = "medium") - -## to change the display text for a hyperlink column just write over those cells -writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14) - - -## writing as an Excel Table - -addWorksheet(wb, "writeDataTable") -writeDataTable(wb, 2, df, startRow = 2, startCol = 2) -writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9") -writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2") -writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21") - -openXL(wb) ## opens a temp version -``` - - -## Use of pre-defined table styles - -The 'tableStyle' argument in writeDataTable can be any of the predefined tableStyles in Excel. - -![](tableStyles.PNG) - -## Date Formatting - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -# data.frame of dates -dates <- data.frame("d1" = Sys.Date() - 0:4) -for(i in 1:3) dates <- cbind(dates, dates) -names(dates) <- paste0("d", 1:8) - -## Date Formatting -wb <- createWorkbook() -addWorksheet(wb, "Date Formatting", gridLines = FALSE) -writeData(wb, 1, dates) ## write without styling - -## openxlsx converts columns of class "Date" to Excel dates with the format given by -getOption("openxlsx.dateFormat", "mm/dd/yyyy") - -## this can be set via (for example) -options("openxlsx.dateFormat" = "yyyy/mm/dd") -## custom date formats can be made up of any combination of: -## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy - -## numFmt == "DATE" will use the date format specified by the above -addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) - -## some custom date format examples -sty <- createStyle(numFmt = "yyyy/mm/dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) - -sty <- createStyle(numFmt = "yyyy/mmm/dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) - -sty <- createStyle(numFmt = "yy / mmmm / dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) - -sty <- createStyle(numFmt = "ddddd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) - -sty <- createStyle(numFmt = "yyyy-mmm-dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) - -sty <- createStyle(numFmt = "mm/ dd yyyy") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) - -sty <- createStyle(numFmt = "mm/dd/yy") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) - -setColWidths(wb, 1, cols = 1:10, widths = 23) - -## The default date format used in writeData and writeDataTable can be set with: -options("openxlsx.dateFormat" = "dd/mm/yyyy") -writeData(wb, "Date Formatting", dates, startRow = 8, borders = "rows") -options("openxlsx.dateFormat" = "yyyy-mm-dd") -writeData(wb, "Date Formatting", dates, startRow = 15) - -saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE) - -``` - -## DateTime Formatting - -The conversion from POSIX to Excel datetimes is dependent on the timezone you are in. -If POSIX values are being written incorrectly, try setting the timezone with (for example) - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -Sys.setenv(TZ = "Australia/Sydney") - -dateTimes <- data.frame("d1" = Sys.time() - 0:4*10000) -for(i in 1:2) dateTimes <- cbind(dateTimes, dateTimes) -names(dateTimes) <- paste0("d", 1:4) - -## POSIX Formatting -wb <- createWorkbook() -addWorksheet(wb, "DateTime Formatting", gridLines = FALSE) -writeData(wb, 1, dateTimes) ## write without styling - -## openxlsx converts columns of class "POSIxt" to Excel datetimes with the format given by -getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss") - -## this can be set via (for example) -options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -## custom datetime formats can be made up of any combination of: -## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM - -## numFmt == "LONGDATE" will use the date format specified by the above -long_date_style <- createStyle(numFmt = "LONGDATE") -addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE) - -## some custom date format examples -sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) - -sty <- createStyle(numFmt = "hh:mm:ss AM/PM") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) - -sty <- createStyle(numFmt = "hh:mm:ss") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) - -setColWidths(wb, 1, cols = 1:4, widths = 30) - -## The default date format used in writeData and writeDataTable can be set with: -options("openxlsx.datetimeFormat" = "yyyy/mm/dd hh:mm:ss") -writeData(wb, "DateTime Formatting", dateTimes, startRow = 8, borders = "rows") - -options("openxlsx.datetimeFormat" = "hh:mm:ss AM/PM") -writeDataTable(wb, "DateTime Formatting", dateTimes, startRow = 15) - -saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE) -openXL("DateTime Formatting.xlsx") - -``` - -## Conditional Formatting - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -wb <- createWorkbook() -addWorksheet(wb, "cellIs") -addWorksheet(wb, "Moving Row") -addWorksheet(wb, "Moving Col") -addWorksheet(wb, "Dependent on 1") -addWorksheet(wb, "Duplicates") -addWorksheet(wb, "containsText") -addWorksheet(wb, "colourScale", zoom = 30) -addWorksheet(wb, "databar") - -negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") - -## rule applies to all each cell in range -writeData(wb, "cellIs", -5:5) -writeData(wb, "cellIs", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="!=0", style = negStyle) -conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="==0", style = posStyle) - -## highlight row dependent on first cell in row -writeData(wb, "Moving Row", -5:5) -writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1<0", style = negStyle) -conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1>0", style = posStyle) - -## highlight column dependent on first cell in column -writeData(wb, "Moving Col", -5:5) -writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1<0", style = negStyle) -conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1>0", style = posStyle) - -## highlight entire range cols X rows dependent only on cell A1 -writeData(wb, "Dependent on 1", -5:5) -writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1<0", style = negStyle) -conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1>0", style = posStyle) - -## highlight duplicates using default style -writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) -conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") - -## cells containing text -fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -writeData(wb, "containsText", sapply(1:10, fn)) -conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") - -## colourscale colours cells based on cell value -df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4) -writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame - -## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) -## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. -conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), - style = c("black", "white"), - rule = c(0, 255), - type = "colourScale") - -setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) -setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) - -## Databars -writeData(wb, "databar", -5:5) -conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours - -saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) - -openXL(wb) - -``` - - - -## Numeric Formatting - - -numeric columns styling can be set using the numFmt parameter in createStyle or a default can be -set with, for example, options("openxlsx.numFmt" = "#,#0.00") - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -options("openxlsx.numFmt" = NULL) -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5)) ## data.frame to write -df[ ,6:7] <- df[ ,6:7]*1E6 - -## Set column 1 class to "comma" to get comma separated thousands -class(df$X1) <- "comma" - -writeData(wb, 1, df) -s <- createStyle(numFmt = "0.0") -addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE) - -s <- createStyle(numFmt = "0.00") -addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE) - -s <- createStyle(numFmt = "0.000") -addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE) - -s <- createStyle(numFmt = "#,##0") -addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE) - -s <- createStyle(numFmt = "#,##0.00") -addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE) - -s <- createStyle(numFmt = "$ #,##0.00") -addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE) - -## set a default number format for numeric columns of data.frames -options("openxlsx.numFmt" = "$* #,#0.00") -writeData(wb, 1, x = data.frame("Using Default Options" = rep(2345.1235, 5)), startCol = 9) - -setColWidths(wb, 1, cols = 1:10, widths = 15) - -## Using default numFmt to round to 2 dp (Any numeric column will be affected) -addWorksheet(wb, "Sheet 2") -df <- iris; df[, 1:4] <- df[1:4] + runif(1) -writeDataTable(wb, sheet = 2, x = df) -writeData(wb, sheet = 2, x = df, startCol = 7) -writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows") - -## To stop auto-formatting numerics set -options("openxlsx.numFmt" = NULL) -addWorksheet(wb, "Sheet 3") -writeDataTable(wb, sheet = 3, x = df) - -openXL(wb) -``` - - +--- +title: "Formating with xlsx" +author: "Alexander Walker, Philipp Schauberger" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Formating with xlsx} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + +## Formatting with writeData and writeDataTable + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +## data.frame to write +df <- data.frame("Date" = Sys.Date()-0:4, + "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), + "Currency" = paste("$",-2:2), + "Accounting" = -2:2, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(-1, 1, length.out=5), + "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE) + +class(df$Currency) <- "currency" +class(df$Accounting) <- "accounting" +class(df$hLink) <- "hyperlink" +class(df$Percentage) <- "percentage" +class(df$TinyNumber) <- "scientific" + +## Formatting can be applied simply through the write functions +## global options can be set to further simplify things +options("openxlsx.borderStyle" = "thin") +options("openxlsx.borderColour" = "#4F81BD") + +## create a workbook and add a worksheet +wb <- createWorkbook() +addWorksheet(wb, "writeData auto-formatting") + +writeData(wb, 1, df, startRow = 2, startCol = 2) +writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding") +writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows") +writeData(wb, 1, df, startRow = 23, startCol = 2, borders ="columns") +writeData(wb, 1, df, startRow = 30, startCol = 2, borders ="all") + +## headerStyles +hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold", + border = "Bottom", fontColour = "white") + +writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1, + borders = "rows", borderStyle = "medium") + +## to change the display text for a hyperlink column just write over those cells +writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14) + + +## writing as an Excel Table + +addWorksheet(wb, "writeDataTable") +writeDataTable(wb, 2, df, startRow = 2, startCol = 2) +writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9") +writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2") +writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21") + +openXL(wb) ## opens a temp version +``` + + +## Use of pre-defined table styles + +The 'tableStyle' argument in writeDataTable can be any of the predefined tableStyles in Excel. + +![](tableStyles.PNG) + +## Date Formatting + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +# data.frame of dates +dates <- data.frame("d1" = Sys.Date() - 0:4) +for(i in 1:3) dates <- cbind(dates, dates) +names(dates) <- paste0("d", 1:8) + +## Date Formatting +wb <- createWorkbook() +addWorksheet(wb, "Date Formatting", gridLines = FALSE) +writeData(wb, 1, dates) ## write without styling + +## openxlsx converts columns of class "Date" to Excel dates with the format given by +getOption("openxlsx.dateFormat", "mm/dd/yyyy") + +## this can be set via (for example) +options("openxlsx.dateFormat" = "yyyy/mm/dd") +## custom date formats can be made up of any combination of: +## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy + +## numFmt == "DATE" will use the date format specified by the above +addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) + +## some custom date format examples +sty <- createStyle(numFmt = "yyyy/mm/dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) + +sty <- createStyle(numFmt = "yyyy/mmm/dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) + +sty <- createStyle(numFmt = "yy / mmmm / dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) + +sty <- createStyle(numFmt = "ddddd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) + +sty <- createStyle(numFmt = "yyyy-mmm-dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) + +sty <- createStyle(numFmt = "mm/ dd yyyy") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) + +sty <- createStyle(numFmt = "mm/dd/yy") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) + +setColWidths(wb, 1, cols = 1:10, widths = 23) + +## The default date format used in writeData and writeDataTable can be set with: +options("openxlsx.dateFormat" = "dd/mm/yyyy") +writeData(wb, "Date Formatting", dates, startRow = 8, borders = "rows") +options("openxlsx.dateFormat" = "yyyy-mm-dd") +writeData(wb, "Date Formatting", dates, startRow = 15) + +saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE) + +``` + +## DateTime Formatting + +The conversion from POSIX to Excel datetimes is dependent on the timezone you are in. +If POSIX values are being written incorrectly, try setting the timezone with (for example) + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +Sys.setenv(TZ = "Australia/Sydney") + +dateTimes <- data.frame("d1" = Sys.time() - 0:4*10000) +for(i in 1:2) dateTimes <- cbind(dateTimes, dateTimes) +names(dateTimes) <- paste0("d", 1:4) + +## POSIX Formatting +wb <- createWorkbook() +addWorksheet(wb, "DateTime Formatting", gridLines = FALSE) +writeData(wb, 1, dateTimes) ## write without styling + +## openxlsx converts columns of class "POSIxt" to Excel datetimes with the format given by +getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss") + +## this can be set via (for example) +options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +## custom datetime formats can be made up of any combination of: +## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM + +## numFmt == "LONGDATE" will use the date format specified by the above +long_date_style <- createStyle(numFmt = "LONGDATE") +addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE) + +## some custom date format examples +sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) + +sty <- createStyle(numFmt = "hh:mm:ss AM/PM") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) + +sty <- createStyle(numFmt = "hh:mm:ss") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) + +setColWidths(wb, 1, cols = 1:4, widths = 30) + +## The default date format used in writeData and writeDataTable can be set with: +options("openxlsx.datetimeFormat" = "yyyy/mm/dd hh:mm:ss") +writeData(wb, "DateTime Formatting", dateTimes, startRow = 8, borders = "rows") + +options("openxlsx.datetimeFormat" = "hh:mm:ss AM/PM") +writeDataTable(wb, "DateTime Formatting", dateTimes, startRow = 15) + +saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE) +openXL("DateTime Formatting.xlsx") + +``` + +## Conditional Formatting + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +wb <- createWorkbook() +addWorksheet(wb, "cellIs") +addWorksheet(wb, "Moving Row") +addWorksheet(wb, "Moving Col") +addWorksheet(wb, "Dependent on 1") +addWorksheet(wb, "Duplicates") +addWorksheet(wb, "containsText") +addWorksheet(wb, "colourScale", zoom = 30) +addWorksheet(wb, "databar") + +negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") + +## rule applies to all each cell in range +writeData(wb, "cellIs", -5:5) +writeData(wb, "cellIs", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="!=0", style = negStyle) +conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="==0", style = posStyle) + +## highlight row dependent on first cell in row +writeData(wb, "Moving Row", -5:5) +writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1<0", style = negStyle) +conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1>0", style = posStyle) + +## highlight column dependent on first cell in column +writeData(wb, "Moving Col", -5:5) +writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1<0", style = negStyle) +conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1>0", style = posStyle) + +## highlight entire range cols X rows dependent only on cell A1 +writeData(wb, "Dependent on 1", -5:5) +writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1<0", style = negStyle) +conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1>0", style = posStyle) + +## highlight duplicates using default style +writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) +conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") + +## cells containing text +fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +writeData(wb, "containsText", sapply(1:10, fn)) +conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") + +## colourscale colours cells based on cell value +df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4) +writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame + +## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) +## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. +conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), + style = c("black", "white"), + rule = c(0, 255), + type = "colourScale") + +setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) +setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) + +## Databars +writeData(wb, "databar", -5:5) +conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours + +saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) + +openXL(wb) + +``` + + + +## Numeric Formatting + + +numeric columns styling can be set using the numFmt parameter in createStyle or a default can be +set with, for example, options("openxlsx.numFmt" = "#,#0.00") + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +options("openxlsx.numFmt" = NULL) +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5)) ## data.frame to write +df[ ,6:7] <- df[ ,6:7]*1E6 + +## Set column 1 class to "comma" to get comma separated thousands +class(df$X1) <- "comma" + +writeData(wb, 1, df) +s <- createStyle(numFmt = "0.0") +addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE) + +s <- createStyle(numFmt = "0.00") +addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE) + +s <- createStyle(numFmt = "0.000") +addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE) + +s <- createStyle(numFmt = "#,##0") +addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE) + +s <- createStyle(numFmt = "#,##0.00") +addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE) + +s <- createStyle(numFmt = "$ #,##0.00") +addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE) + +## set a default number format for numeric columns of data.frames +options("openxlsx.numFmt" = "$* #,#0.00") +writeData(wb, 1, x = data.frame("Using Default Options" = rep(2345.1235, 5)), startCol = 9) + +setColWidths(wb, 1, cols = 1:10, widths = 15) + +## Using default numFmt to round to 2 dp (Any numeric column will be affected) +addWorksheet(wb, "Sheet 2") +df <- iris; df[, 1:4] <- df[1:4] + runif(1) +writeDataTable(wb, sheet = 2, x = df) +writeData(wb, sheet = 2, x = df, startCol = 7) +writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows") + +## To stop auto-formatting numerics set +options("openxlsx.numFmt" = NULL) +addWorksheet(wb, "Sheet 3") +writeDataTable(wb, sheet = 3, x = df) + +openXL(wb) +``` + + diff -Nru r-cran-openxlsx-4.2.4/inst/doc/Introduction.html r-cran-openxlsx-4.2.5/inst/doc/Introduction.html --- r-cran-openxlsx-4.2.4/inst/doc/Introduction.html 2021-06-15 11:54:53.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/doc/Introduction.html 2021-12-13 22:06:55.000000000 +0000 @@ -1,614 +1,605 @@ - - - - - - - - - - - - - - - - -Introduction - - - - - - - - - - - - - - - - - - - - - - - - - -

Introduction

-

Alexander Walker, Philipp Schauberger

-

2021-06-15

- - - -
-

Basic Examples

-
-

write.xlsx

-

The simplest way to write to a workbook is write.xlsx(). By default, write.xlsx calls writeData. If asTable is TRUE write.xlsx will write x as an Excel table.

-
## write to working directory
-library(openxlsx)
-write.xlsx(iris, file = "writeXLSX1.xlsx")
-write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE)
-
-
-

write list of data.frames to xlsx-file

-
## write a list of data.frames to individual worksheets using list names as worksheet names
-l <- list("IRIS" = iris, "MTCARS" = mtcars)
-write.xlsx(l, file = "writeXLSX2.xlsx")
-write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE)
-
-
-

write.xlsx also accepts styling parameters

-
-

The simplest way is to set default options and set column class

-
options("openxlsx.borderColour" = "#4F80BD")
-options("openxlsx.borderStyle" = "thin")
-options("openxlsx.dateFormat" = "mm/dd/yyyy")
-options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss")
-options("openxlsx.numFmt" = NULL) ## For default style rounding of numeric columns
-
-df <- data.frame("Date" = Sys.Date()-0:19, "LogicalT" = TRUE,
-                 "Time" = Sys.time()-0:19*60*60,
-                 "Cash" = paste("$",1:20), "Cash2" = 31:50,
-                 "hLink" = "https://CRAN.R-project.org/",
-                 "Percentage" = seq(0, 1, length.out=20),
-                 "TinyNumbers" = runif(20) / 1E9,  stringsAsFactors = FALSE)
-
-class(df$Cash) <- "currency"
-class(df$Cash2) <- "accounting"
-class(df$hLink) <- "hyperlink"
-class(df$Percentage) <- "percentage"
-class(df$TinyNumbers) <- "scientific"
-
-write.xlsx(df, "writeXLSX3.xlsx")
-write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE)
-
-
-
-
-

Workbook styles

-
-

define a style for column headers

-
hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD",
-                  halign = "center", valign = "center", textDecoration = "Bold",
-                  border = "TopBottomLeftRight", textRotation = 45)
-
-write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs)
-write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs)
-
-write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE,
-headerStyle = createStyle(textRotation = 45))
-
-
-

When writing a list, the stylings will apply to all list elements

-
l <- list("IRIS" = iris, "colClasses" = df)
-write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs)
-write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2")
-
-openXL("writeXLSX6.xlsx")
-openXL("writeXLSXTable5.xlsx")
-
-
-

write.xlsx returns the workbook object for further editing

-
wb <- write.xlsx(iris, "writeXLSX6.xlsx")
-setColWidths(wb, sheet = 1, cols = 1:5, widths = 20)
-saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE)
-
-
-
-

Workbook creation walk-through

-
-

create workbook and set default border Colour and style

-
require(ggplot2)
-wb <- createWorkbook()
-options("openxlsx.borderColour" = "#4F80BD")
-options("openxlsx.borderStyle" = "thin")
-modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow")
-
-
-

Add Sheets

-
addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE)
-addWorksheet(wb, sheetName = "Iris", gridLines = FALSE)
-
-
-

write data to sheet 1

-
freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE) ## freeze first row and column
-writeDataTable(wb, sheet = 1, x = mtcars,
-colNames = TRUE, rowNames = TRUE,
-tableStyle = "TableStyleLight9")
-
-setColWidths(wb, sheet = 1, cols = "A", widths = 18)
-
-
-

write data to sheet 2

-

iris data.frame is added as excel table on sheet 2.

-
writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2)
-
-qplot(data=iris, x = Sepal.Length, y= Sepal.Width, colour = Species)
-insertPlot(wb, 2, xy=c("B", 16)) ## insert plot at cell B16
-
-means <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = mean)
-vars <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = var)
-
-
-

add write group means

-
headSty <- createStyle(fgFill="#DCE6F1", halign="center", border = "TopBottomLeftRight")
-writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2)
-writeData(wb, 2, x = means, startCol = "B", startRow=3, borders="rows", headerStyle = headSty)
-
-
-

add write group variances

-
writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9)
-writeData(wb, 2, x= vars, startCol = "B", startRow=10, borders="columns",
-headerStyle = headSty)
-
-setColWidths(wb, 2, cols=2:6, widths = 12) ## width is recycled for each col
-setColWidths(wb, 2, cols=11:15, widths = 15)
-
-
-

add style mean & variance table headers

-
s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic"))
-addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2))
-
-
-

save workbook

-
saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory
-
-
- -
-

Further Examples

-
-

Stock Price

-
require(ggplot2)
-
-wb <- createWorkbook()
-
-## read historical prices from yahoo finance
-ticker <- "CBA.AX"
-csv.url <- paste("http://ichart.finance.yahoo.com/table.csv?s=",
-ticker, "&a=01&b=9&c=2009&d=01&e=9&f=2014&g=d&ignore=.csv")
-prices <- read.csv(url(csv.url), as.is = TRUE)
-prices$Date <- as.Date(prices$Date)
-close <- prices$Close
-prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close)-1)]))
-
-## Create plot of price series and add to worksheet
-ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) +
-geom_line(colour="royalblue2") +
-labs(x = "Date", y = "Price", title = ticker) +
-geom_area(fill = "royalblue1",alpha = 0.3) +
-coord_cartesian(ylim=c(min(prices$Close)-1.5, max(prices$Close)+1.5)) 
-
-## Add worksheet and write plot to sheet
-addWorksheet(wb, sheetName = "CBA")
-insertPlot(wb, sheet = 1, xy = c("J", 3))
-
-## Histogram of log returns
-ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth=0.0025) +
-labs(title = "Histogram of log returns")
-
-## currency 
-class(prices$Close) <- "currency" ## styles as currency in workbook
-
-## write historical data and  histogram of returns
-writeDataTable(wb, sheet = "CBA", x = prices)
-insertPlot(wb, sheet = 1, startRow=25, startCol = "J")
-
-## Add conditional formatting to show where logReturn > 0.01 using default style
-conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices)+1),
-rule = "$H2 > 0.01")
-
-## style log return col as a percentage  
-logRetStyle <- createStyle(numFmt = "percentage")
-
-addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), 
-cols = "H", gridExpand = TRUE)
-
-setColWidths(wb, sheet=1, cols = c("A", "F", "G", "H"), widths = 15)
-
-## save workbook to working directory
-saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE)
-openXL("stockPrice.xlsx")
-
-
-

Image Compression using PCA

-
require(openxlsx)
-require(jpeg)
-require(ggplot2)
-
-plotFn <- function(x, ...){
-  colvec <- grey(x)
-  colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2])
-  image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]),
-    col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1,
-    bty ="n", frame.plot=F, ann=FALSE)
-}
-
-## Create workbook and add a worksheet, hide gridlines
-wb <- createWorkbook("Einstein")
-addWorksheet(wb, "Original Image", gridLines = FALSE)
-
-A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg"))
-height <- nrow(A); width <- ncol(A)
-
-## write "Original Image" to cell B2
-writeData(wb, 1, "Original Image", xy = c(2,2))
-
-## write Object size to cell B3
-writeData(wb, 1, sprintf("Image object size: %s bytes",
-                         format(object.size(A+0)[[1]], big.mark=',')), 
-          xy = c(2,3))  ## equivalent to startCol = 2, startRow = 3
-
-## Plot image
-par(mar=rep(0, 4), xpd = NA); plotFn(A)
-
-## insert plot currently showing in plot window
-insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2)       
-
-## SVD of covariance matrix
-rMeans <- rowMeans(A)
-rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans))
-A <- A - rowMeans
-E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A
-pve <- data.frame("Eigenvalues" = E$d, 
-                  "PVE" = E$d/sum(E$d),
-                  "Cumulative PVE" = cumsum(E$d/sum(E$d)))
-
-## write eigenvalues to worksheet
-addWorksheet(wb, "Principal Component Analysis")
-hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD",
-                  halign = "CENTER", textDecoration = "Bold",
-                  border = "TopBottomLeftRight", borderColour = "#4F81BD")
-
-writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2)
-mergeCells(wb, sheet=2, cols=1:4, rows=2)
-
-setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15))
-writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs)
-
-## Plots
-pve <- cbind(pve, "Ind" = 1:nrow(pve))
-ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) +
-  geom_bar(stat="identity", position = "dodge") +
-  xlab("Principal Component Index") + ylab("Proportion of Variance Explained") +
-  geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue")
-
-## Write plot to worksheet 2
-insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) 
-
-## Plot of cumulative explained variance
-ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) +
-  geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") +
-  ylab("Cumulative Proportion of Variance Explained")
-insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) 
-
-
-## Reconstruct image using increasing number of PCs
-nPCs <- c(5, 7, 12, 20, 50, 200)
-startRow <- rep(c(2, 24), each = 3)
-startCol <- rep(c("B", "H", "N"), 2)
-
-## create a worksheet to save reconstructed images to
-addWorksheet(wb, "Reconstructed Images", zoom = 90)
-
-for(i in 1:length(nPCs)){
-  
-  V <- E$v[, 1:nPCs[i]]
-  imgHat <- t(V) %*% A  ## project img data on to PCs
-  imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans)
-  
-  imgHat <- V %*% imgHat + rowMeans  ## reconstruct from PCs and add back row means
-  imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale
-  plotFn(imgHat/255)
-  
-  ## write strings to worksheet 3
-  writeData(wb, "Reconstructed Images", 
-            sprintf("Number of principal components used:  %s", 
-                    nPCs[[i]]), startCol[i], startRow[i])
-  
-  writeData(wb, "Reconstructed Images", 
-            sprintf("Sum of component object sizes: %s bytes",
-                    format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1)
-  
-  ## write reconstruced image
-  insertPlot(wb, "Reconstructed Images", width, height, units="px",
-             xy = c(startCol[i], startRow[i]+3))
-  
-}
-
-# hide grid lines
-showGridLines(wb, sheet = 3, showGridLines = FALSE)
-
-## Make text above images BOLD
-boldStyle <- createStyle(textDecoration="BOLD")
-
-## only want to apply style to specified cells (not all combinations of rows & cols)
-addStyle(wb, "Reconstructed Images", style=boldStyle, 
-         rows = c(startRow, startRow+1), cols = rep(startCol, 2), 
-         gridExpand = FALSE)  
-
-## save workbook to working directory
-saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) 
-
-
-
-
-## remove example files for cran test
-if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) {
-file_list<-list.files(pattern="\\.xlsx",recursive = T)
-file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)]
-
-if(length(file_list)>0){
-rm(file_list)
-}
-
-
- - - - - - - - - - - + + + + + + + + + + + + + + + + +Introduction + + + + + + + + + + + + + + + + + + + + + + + + + +

Introduction

+

Alexander Walker, Philipp Schauberger

+

2021-12-13

+ + + +
+

Basic Examples

+
+

write.xlsx

+

The simplest way to write to a workbook is write.xlsx(). By default, write.xlsx calls writeData. If asTable is TRUE write.xlsx will write x as an Excel table.

+
## write to working directory
+library(openxlsx)
+write.xlsx(iris, file = "writeXLSX1.xlsx")
+write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE)
+
+
+

write list of data.frames to xlsx-file

+
## write a list of data.frames to individual worksheets using list names as
+## worksheet names
+l <- list(IRIS = iris, MTCARS = mtcars)
+write.xlsx(l, file = "writeXLSX2.xlsx")
+write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE)
+
+
+

write.xlsx also accepts styling parameters

+
+

The simplest way is to set default options and set column class

+
options(openxlsx.borderColour = "#4F80BD")
+options(openxlsx.borderStyle = "thin")
+options(openxlsx.dateFormat = "mm/dd/yyyy")
+options(openxlsx.datetimeFormat = "yyyy-mm-dd hh:mm:ss")
+options(openxlsx.numFmt = NULL)  ## For default style rounding of numeric columns
+
+df <- data.frame(Date = Sys.Date() - 0:19, LogicalT = TRUE, Time = Sys.time() - 0:19 *
+    60 * 60, Cash = paste("$", 1:20), Cash2 = 31:50, hLink = "https://CRAN.R-project.org/",
+    Percentage = seq(0, 1, length.out = 20), TinyNumbers = runif(20)/1e+09, stringsAsFactors = FALSE)
+
+class(df$Cash) <- "currency"
+class(df$Cash2) <- "accounting"
+class(df$hLink) <- "hyperlink"
+class(df$Percentage) <- "percentage"
+class(df$TinyNumbers) <- "scientific"
+
+write.xlsx(df, "writeXLSX3.xlsx")
+write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE)
+
+
+
+
+

Workbook styles

+
+

define a style for column headers

+
hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", halign = "center",
+    valign = "center", textDecoration = "Bold", border = "TopBottomLeftRight", textRotation = 45)
+
+write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs)
+write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs)
+
+write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, headerStyle = createStyle(textRotation = 45))
+
+
+

When writing a list, the stylings will apply to all list elements

+
l <- list(IRIS = iris, colClasses = df)
+write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs)
+write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2")
+
+openXL("writeXLSX6.xlsx")
+openXL("writeXLSXTable5.xlsx")
+
+
+

write.xlsx returns the workbook object for further editing

+
wb <- write.xlsx(iris, "writeXLSX6.xlsx")
+setColWidths(wb, sheet = 1, cols = 1:5, widths = 20)
+saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE)
+
+
+
+

Workbook creation walk-through

+
+

create workbook and set default border Colour and style

+
require(ggplot2)
+wb <- createWorkbook()
+options(openxlsx.borderColour = "#4F80BD")
+options(openxlsx.borderStyle = "thin")
+modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow")
+
+
+

Add Sheets

+
addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE)
+addWorksheet(wb, sheetName = "Iris", gridLines = FALSE)
+
+
+

write data to sheet 1

+
freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE)  ## freeze first row and column
+writeDataTable(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = TRUE, tableStyle = "TableStyleLight9")
+
+setColWidths(wb, sheet = 1, cols = "A", widths = 18)
+
+
+

write data to sheet 2

+

iris data.frame is added as excel table on sheet 2.

+
writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2)
+
+qplot(data = iris, x = Sepal.Length, y = Sepal.Width, colour = Species)
+insertPlot(wb, 2, xy = c("B", 16))  ## insert plot at cell B16
+
+means <- aggregate(x = iris[, -5], by = list(iris$Species), FUN = mean)
+vars <- aggregate(x = iris[, -5], by = list(iris$Species), FUN = var)
+
+
+

add write group means

+
headSty <- createStyle(fgFill = "#DCE6F1", halign = "center", border = "TopBottomLeftRight")
+writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2)
+writeData(wb, 2, x = means, startCol = "B", startRow = 3, borders = "rows", headerStyle = headSty)
+
+
+

add write group variances

+
writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9)
+writeData(wb, 2, x = vars, startCol = "B", startRow = 10, borders = "columns", headerStyle = headSty)
+
+setColWidths(wb, 2, cols = 2:6, widths = 12)  ## width is recycled for each col
+setColWidths(wb, 2, cols = 11:15, widths = 15)
+
+
+

add style mean & variance table headers

+
s1 <- createStyle(fontSize = 14, textDecoration = c("bold", "italic"))
+addStyle(wb, 2, style = s1, rows = c(2, 9), cols = c(2, 2))
+
+
+

save workbook

+
saveWorkbook(wb, "basics.xlsx", overwrite = TRUE)  ## save to working directory
+
+
+ +
+

Further Examples

+
+

Stock Price

+
require(ggplot2)
+
+wb <- createWorkbook()
+
+## read historical prices from yahoo finance
+ticker <- "CBA.AX"
+csv.url <- paste0("https://query1.finance.yahoo.com/v7/finance/download/", ticker,
+    "?period1=1597597610&period2=1629133610&interval=1d&events=history&includeAdjustedClose=true")
+prices <- read.csv(url(csv.url), as.is = TRUE)
+prices$Date <- as.Date(prices$Date)
+close <- prices$Close
+prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close) - 1)]))
+
+## Create plot of price series and add to worksheet
+ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + geom_line(colour = "royalblue2") +
+    labs(x = "Date", y = "Price", title = ticker) + geom_area(fill = "royalblue1",
+    alpha = 0.3) + coord_cartesian(ylim = c(min(prices$Close) - 1.5, max(prices$Close) +
+    1.5))
+
+## Add worksheet and write plot to sheet
+addWorksheet(wb, sheetName = "CBA")
+insertPlot(wb, sheet = 1, xy = c("J", 3))
+
+## Histogram of log returns
+ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth = 0.0025) + labs(title = "Histogram of log returns")
+
+## currency
+class(prices$Close) <- "currency"  ## styles as currency in workbook
+
+## write historical data and histogram of returns
+writeDataTable(wb, sheet = "CBA", x = prices)
+insertPlot(wb, sheet = 1, startRow = 25, startCol = "J")
+
+## Add conditional formatting to show where logReturn > 0.01 using default
+## style
+conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices) +
+    1), rule = "$H2 > 0.01")
+
+## style log return col as a percentage
+logRetStyle <- createStyle(numFmt = "percentage")
+
+addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), cols = "H", gridExpand = TRUE)
+
+setColWidths(wb, sheet = 1, cols = c("A", "F", "G", "H"), widths = 15)
+
+## save workbook to working directory
+saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE)
+openXL("stockPrice.xlsx")
+
+
+

Image Compression using PCA

+
require(openxlsx)
+require(jpeg)
+require(ggplot2)
+
+plotFn <- function(x, ...){
+  colvec <- grey(x)
+  colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2])
+  image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]),
+    col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1,
+    bty ="n", frame.plot=F, ann=FALSE)
+}
+
+## Create workbook and add a worksheet, hide gridlines
+wb <- createWorkbook("Einstein")
+addWorksheet(wb, "Original Image", gridLines = FALSE)
+
+A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg"))
+height <- nrow(A); width <- ncol(A)
+
+## write "Original Image" to cell B2
+writeData(wb, 1, "Original Image", xy = c(2,2))
+
+## write Object size to cell B3
+writeData(wb, 1, sprintf("Image object size: %s bytes",
+                         format(object.size(A+0)[[1]], big.mark=',')), 
+          xy = c(2,3))  ## equivalent to startCol = 2, startRow = 3
+
+## Plot image
+par(mar=rep(0, 4), xpd = NA); plotFn(A)
+
+## insert plot currently showing in plot window
+insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2)       
+
+## SVD of covariance matrix
+rMeans <- rowMeans(A)
+rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans))
+A <- A - rowMeans
+E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A
+pve <- data.frame("Eigenvalues" = E$d, 
+                  "PVE" = E$d/sum(E$d),
+                  "Cumulative PVE" = cumsum(E$d/sum(E$d)))
+
+## write eigenvalues to worksheet
+addWorksheet(wb, "Principal Component Analysis")
+hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD",
+                  halign = "CENTER", textDecoration = "Bold",
+                  border = "TopBottomLeftRight", borderColour = "#4F81BD")
+
+writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2)
+mergeCells(wb, sheet=2, cols=1:4, rows=2)
+
+setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15))
+writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs)
+
+## Plots
+pve <- cbind(pve, "Ind" = 1:nrow(pve))
+ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) +
+  geom_bar(stat="identity", position = "dodge") +
+  xlab("Principal Component Index") + ylab("Proportion of Variance Explained") +
+  geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue")
+
+## Write plot to worksheet 2
+insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) 
+
+## Plot of cumulative explained variance
+ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) +
+  geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") +
+  ylab("Cumulative Proportion of Variance Explained")
+insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) 
+
+
+## Reconstruct image using increasing number of PCs
+nPCs <- c(5, 7, 12, 20, 50, 200)
+startRow <- rep(c(2, 24), each = 3)
+startCol <- rep(c("B", "H", "N"), 2)
+
+## create a worksheet to save reconstructed images to
+addWorksheet(wb, "Reconstructed Images", zoom = 90)
+
+for(i in 1:length(nPCs)){
+  
+  V <- E$v[, 1:nPCs[i]]
+  imgHat <- t(V) %*% A  ## project img data on to PCs
+  imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans)
+  
+  imgHat <- V %*% imgHat + rowMeans  ## reconstruct from PCs and add back row means
+  imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale
+  plotFn(imgHat/255)
+  
+  ## write strings to worksheet 3
+  writeData(wb, "Reconstructed Images", 
+            sprintf("Number of principal components used:  %s", 
+                    nPCs[[i]]), startCol[i], startRow[i])
+  
+  writeData(wb, "Reconstructed Images", 
+            sprintf("Sum of component object sizes: %s bytes",
+                    format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1)
+  
+  ## write reconstruced image
+  insertPlot(wb, "Reconstructed Images", width, height, units="px",
+             xy = c(startCol[i], startRow[i]+3))
+  
+}
+
+# hide grid lines
+showGridLines(wb, sheet = 3, showGridLines = FALSE)
+
+## Make text above images BOLD
+boldStyle <- createStyle(textDecoration="BOLD")
+
+## only want to apply style to specified cells (not all combinations of rows & cols)
+addStyle(wb, "Reconstructed Images", style=boldStyle, 
+         rows = c(startRow, startRow+1), cols = rep(startCol, 2), 
+         gridExpand = FALSE)  
+
+## save workbook to working directory
+saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) 
+
+
+
+
+## remove example files for cran test
+if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) {
+file_list<-list.files(pattern="\\.xlsx",recursive = T)
+file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)]
+
+if(length(file_list)>0){
+rm(file_list)
+}
+
+
+ + + + + + + + + + + diff -Nru r-cran-openxlsx-4.2.4/inst/doc/Introduction.R r-cran-openxlsx-4.2.5/inst/doc/Introduction.R --- r-cran-openxlsx-4.2.4/inst/doc/Introduction.R 2021-06-15 11:54:53.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/doc/Introduction.R 2021-12-13 22:06:54.000000000 +0000 @@ -1,421 +1,421 @@ -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# ## write to working directory -# library(openxlsx) -# write.xlsx(iris, file = "writeXLSX1.xlsx") -# write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# ## write a list of data.frames to individual worksheets using list names as worksheet names -# l <- list("IRIS" = iris, "MTCARS" = mtcars) -# write.xlsx(l, file = "writeXLSX2.xlsx") -# write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# options("openxlsx.borderColour" = "#4F80BD") -# options("openxlsx.borderStyle" = "thin") -# options("openxlsx.dateFormat" = "mm/dd/yyyy") -# options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -# options("openxlsx.numFmt" = NULL) ## For default style rounding of numeric columns -# -# df <- data.frame("Date" = Sys.Date()-0:19, "LogicalT" = TRUE, -# "Time" = Sys.time()-0:19*60*60, -# "Cash" = paste("$",1:20), "Cash2" = 31:50, -# "hLink" = "https://CRAN.R-project.org/", -# "Percentage" = seq(0, 1, length.out=20), -# "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE) -# -# class(df$Cash) <- "currency" -# class(df$Cash2) <- "accounting" -# class(df$hLink) <- "hyperlink" -# class(df$Percentage) <- "percentage" -# class(df$TinyNumbers) <- "scientific" -# -# write.xlsx(df, "writeXLSX3.xlsx") -# write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE) -# -# - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", -# halign = "center", valign = "center", textDecoration = "Bold", -# border = "TopBottomLeftRight", textRotation = 45) -# -# write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs) -# write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs) -# -# write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, -# headerStyle = createStyle(textRotation = 45)) -# -# - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# l <- list("IRIS" = iris, "colClasses" = df) -# write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs) -# write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2") -# -# openXL("writeXLSX6.xlsx") -# openXL("writeXLSXTable5.xlsx") - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# wb <- write.xlsx(iris, "writeXLSX6.xlsx") -# setColWidths(wb, sheet = 1, cols = 1:5, widths = 20) -# saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# require(ggplot2) -# wb <- createWorkbook() -# options("openxlsx.borderColour" = "#4F80BD") -# options("openxlsx.borderStyle" = "thin") -# modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow") - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE) -# addWorksheet(wb, sheetName = "Iris", gridLines = FALSE) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE) ## freeze first row and column -# writeDataTable(wb, sheet = 1, x = mtcars, -# colNames = TRUE, rowNames = TRUE, -# tableStyle = "TableStyleLight9") -# -# setColWidths(wb, sheet = 1, cols = "A", widths = 18) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2) -# -# qplot(data=iris, x = Sepal.Length, y= Sepal.Width, colour = Species) -# insertPlot(wb, 2, xy=c("B", 16)) ## insert plot at cell B16 -# -# means <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = mean) -# vars <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = var) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# headSty <- createStyle(fgFill="#DCE6F1", halign="center", border = "TopBottomLeftRight") -# writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2) -# writeData(wb, 2, x = means, startCol = "B", startRow=3, borders="rows", headerStyle = headSty) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9) -# writeData(wb, 2, x= vars, startCol = "B", startRow=10, borders="columns", -# headerStyle = headSty) -# -# setColWidths(wb, 2, cols=2:6, widths = 12) ## width is recycled for each col -# setColWidths(wb, 2, cols=11:15, widths = 15) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic")) -# addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2)) - -## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- -# saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory - -## ----eval=FALSE, include=TRUE------------------------------------------------- -# ## inspired by xtable gallery -# #https://CRAN.R-project.org/package=xtable/vignettes/xtableGallery.pdf -# -# ## Create a new workbook -# wb <- createWorkbook() -# data(tli, package = "xtable") -# -# ## data.frame -# test.n <- "data.frame" -# my.df <- tli[1:10, ] -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = my.df, borders = "n") -# -# ## matrix -# test.n <- "matrix" -# design.matrix <- model.matrix(~ sex * grade, data = my.df) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = design.matrix) -# -# ## aov -# test.n <- "aov" -# fm1 <- aov(tlimth ~ sex + ethnicty + grade + disadvg, data = tli) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = fm1) -# -# ## lm -# test.n <- "lm" -# fm2 <- lm(tlimth ~ sex*ethnicty, data = tli) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = fm2) -# -# ## anova 1 -# test.n <- "anova" -# my.anova <- anova(fm2) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = my.anova) -# -# ## anova 2 -# test.n <- "anova2" -# fm2b <- lm(tlimth ~ ethnicty, data = tli) -# my.anova2 <- anova(fm2b, fm2) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = my.anova2) -# -# ## glm -# test.n <- "glm" -# fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial()) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = fm3) -# -# ## prcomp -# test.n <- "prcomp" -# pr1 <- prcomp(USArrests) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = pr1) -# -# ## summary.prcomp -# test.n <- "summary.prcomp" -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = summary(pr1)) -# -# ## simple table -# test.n <- "table" -# data(airquality) -# airquality$OzoneG80 <- factor(airquality$Ozone > 80, -# levels = c(FALSE, TRUE), -# labels = c("Oz <= 80", "Oz > 80")) -# airquality$Month <- factor(airquality$Month, -# levels = 5:9, -# labels = month.abb[5:9]) -# my.table <- with(airquality, table(OzoneG80,Month) ) -# addWorksheet(wb = wb, sheetName = test.n) -# writeData(wb = wb, sheet = test.n, x = my.table) -# -# ## survdiff 1 -# library(survival) -# test.n <- "survdiff1" -# addWorksheet(wb = wb, sheetName = test.n) -# x <- survdiff(Surv(futime, fustat) ~ rx, data = ovarian) -# writeData(wb = wb, sheet = test.n, x = x) -# -# ## survdiff 2 -# test.n <- "survdiff2" -# addWorksheet(wb = wb, sheetName = test.n) -# expect <- survexp(futime ~ ratetable(age=(accept.dt - birth.dt), -# sex=1,year=accept.dt,race="white"), jasa, cohort=FALSE, -# ratetable=survexp.usr) -# x <- survdiff(Surv(jasa$futime, jasa$fustat) ~ offset(expect)) -# writeData(wb = wb, sheet = test.n, x = x) -# -# ## coxph 1 -# test.n <- "coxph1" -# addWorksheet(wb = wb, sheetName = test.n) -# bladder$rx <- factor(bladder$rx, labels = c("Pla","Thi")) -# x <- coxph(Surv(stop,event) ~ rx, data = bladder) -# writeData(wb = wb, sheet = test.n, x = x) -# -# ## coxph 2 -# test.n <- "coxph2" -# addWorksheet(wb = wb, sheetName = test.n) -# x <- coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder) -# writeData(wb = wb, sheet = test.n, x = x) -# -# ## cox.zph -# test.n <- "cox.zph" -# addWorksheet(wb = wb, sheetName = test.n) -# x <- cox.zph(coxph(Surv(futime, fustat) ~ age + ecog.ps, data=ovarian)) -# writeData(wb = wb, sheet = test.n, x = x) -# -# ## summary.coxph 1 -# test.n <- "summary.coxph1" -# addWorksheet(wb = wb, sheetName = test.n) -# x <- summary(coxph(Surv(stop,event) ~ rx, data = bladder)) -# writeData(wb = wb, sheet = test.n, x = x) -# -# ## summary.coxph 2 -# test.n <- "summary.coxph2" -# addWorksheet(wb = wb, sheetName = test.n) -# x <- summary(coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder)) -# writeData(wb = wb, sheet = test.n, x = x) -# -# ## view without saving -# openXL(wb) -# - -## ----eval=FALSE, include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------- -# require(ggplot2) -# -# wb <- createWorkbook() -# -# ## read historical prices from yahoo finance -# ticker <- "CBA.AX" -# csv.url <- paste("http://ichart.finance.yahoo.com/table.csv?s=", -# ticker, "&a=01&b=9&c=2009&d=01&e=9&f=2014&g=d&ignore=.csv") -# prices <- read.csv(url(csv.url), as.is = TRUE) -# prices$Date <- as.Date(prices$Date) -# close <- prices$Close -# prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close)-1)])) -# -# ## Create plot of price series and add to worksheet -# ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + -# geom_line(colour="royalblue2") + -# labs(x = "Date", y = "Price", title = ticker) + -# geom_area(fill = "royalblue1",alpha = 0.3) + -# coord_cartesian(ylim=c(min(prices$Close)-1.5, max(prices$Close)+1.5)) -# -# ## Add worksheet and write plot to sheet -# addWorksheet(wb, sheetName = "CBA") -# insertPlot(wb, sheet = 1, xy = c("J", 3)) -# -# ## Histogram of log returns -# ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth=0.0025) + -# labs(title = "Histogram of log returns") -# -# ## currency -# class(prices$Close) <- "currency" ## styles as currency in workbook -# -# ## write historical data and histogram of returns -# writeDataTable(wb, sheet = "CBA", x = prices) -# insertPlot(wb, sheet = 1, startRow=25, startCol = "J") -# -# ## Add conditional formatting to show where logReturn > 0.01 using default style -# conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices)+1), -# rule = "$H2 > 0.01") -# -# ## style log return col as a percentage -# logRetStyle <- createStyle(numFmt = "percentage") -# -# addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), -# cols = "H", gridExpand = TRUE) -# -# setColWidths(wb, sheet=1, cols = c("A", "F", "G", "H"), widths = 15) -# -# ## save workbook to working directory -# saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE) -# openXL("stockPrice.xlsx") - -## ----eval=FALSE, include=TRUE------------------------------------------------- -# require(openxlsx) -# require(jpeg) -# require(ggplot2) -# -# plotFn <- function(x, ...){ -# colvec <- grey(x) -# colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2]) -# image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]), -# col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1, -# bty ="n", frame.plot=F, ann=FALSE) -# } -# -# ## Create workbook and add a worksheet, hide gridlines -# wb <- createWorkbook("Einstein") -# addWorksheet(wb, "Original Image", gridLines = FALSE) -# -# A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg")) -# height <- nrow(A); width <- ncol(A) -# -# ## write "Original Image" to cell B2 -# writeData(wb, 1, "Original Image", xy = c(2,2)) -# -# ## write Object size to cell B3 -# writeData(wb, 1, sprintf("Image object size: %s bytes", -# format(object.size(A+0)[[1]], big.mark=',')), -# xy = c(2,3)) ## equivalent to startCol = 2, startRow = 3 -# -# ## Plot image -# par(mar=rep(0, 4), xpd = NA); plotFn(A) -# -# ## insert plot currently showing in plot window -# insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2) -# -# ## SVD of covariance matrix -# rMeans <- rowMeans(A) -# rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans)) -# A <- A - rowMeans -# E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A -# pve <- data.frame("Eigenvalues" = E$d, -# "PVE" = E$d/sum(E$d), -# "Cumulative PVE" = cumsum(E$d/sum(E$d))) -# -# ## write eigenvalues to worksheet -# addWorksheet(wb, "Principal Component Analysis") -# hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", -# halign = "CENTER", textDecoration = "Bold", -# border = "TopBottomLeftRight", borderColour = "#4F81BD") -# -# writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2) -# mergeCells(wb, sheet=2, cols=1:4, rows=2) -# -# setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15)) -# writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs) -# -# ## Plots -# pve <- cbind(pve, "Ind" = 1:nrow(pve)) -# ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) + -# geom_bar(stat="identity", position = "dodge") + -# xlab("Principal Component Index") + ylab("Proportion of Variance Explained") + -# geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue") -# -# ## Write plot to worksheet 2 -# insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) -# -# ## Plot of cumulative explained variance -# ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) + -# geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") + -# ylab("Cumulative Proportion of Variance Explained") -# insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) -# -# -# ## Reconstruct image using increasing number of PCs -# nPCs <- c(5, 7, 12, 20, 50, 200) -# startRow <- rep(c(2, 24), each = 3) -# startCol <- rep(c("B", "H", "N"), 2) -# -# ## create a worksheet to save reconstructed images to -# addWorksheet(wb, "Reconstructed Images", zoom = 90) -# -# for(i in 1:length(nPCs)){ -# -# V <- E$v[, 1:nPCs[i]] -# imgHat <- t(V) %*% A ## project img data on to PCs -# imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans) -# -# imgHat <- V %*% imgHat + rowMeans ## reconstruct from PCs and add back row means -# imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale -# plotFn(imgHat/255) -# -# ## write strings to worksheet 3 -# writeData(wb, "Reconstructed Images", -# sprintf("Number of principal components used: %s", -# nPCs[[i]]), startCol[i], startRow[i]) -# -# writeData(wb, "Reconstructed Images", -# sprintf("Sum of component object sizes: %s bytes", -# format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1) -# -# ## write reconstruced image -# insertPlot(wb, "Reconstructed Images", width, height, units="px", -# xy = c(startCol[i], startRow[i]+3)) -# -# } -# -# # hide grid lines -# showGridLines(wb, sheet = 3, showGridLines = FALSE) -# -# ## Make text above images BOLD -# boldStyle <- createStyle(textDecoration="BOLD") -# -# ## only want to apply style to specified cells (not all combinations of rows & cols) -# addStyle(wb, "Reconstructed Images", style=boldStyle, -# rows = c(startRow, startRow+1), cols = rep(startCol, 2), -# gridExpand = FALSE) -# -# ## save workbook to working directory -# saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) -# -# -# -# -# ## remove example files for cran test -# if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) { -# file_list<-list.files(pattern="\\.xlsx",recursive = T) -# file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)] -# -# if(length(file_list)>0){ -# rm(file_list) -# } -# - +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# ## write to working directory +# library(openxlsx) +# write.xlsx(iris, file = "writeXLSX1.xlsx") +# write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# ## write a list of data.frames to individual worksheets using list names as worksheet names +# l <- list("IRIS" = iris, "MTCARS" = mtcars) +# write.xlsx(l, file = "writeXLSX2.xlsx") +# write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# options("openxlsx.borderColour" = "#4F80BD") +# options("openxlsx.borderStyle" = "thin") +# options("openxlsx.dateFormat" = "mm/dd/yyyy") +# options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +# options("openxlsx.numFmt" = NULL) ## For default style rounding of numeric columns +# +# df <- data.frame("Date" = Sys.Date()-0:19, "LogicalT" = TRUE, +# "Time" = Sys.time()-0:19*60*60, +# "Cash" = paste("$",1:20), "Cash2" = 31:50, +# "hLink" = "https://CRAN.R-project.org/", +# "Percentage" = seq(0, 1, length.out=20), +# "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE) +# +# class(df$Cash) <- "currency" +# class(df$Cash2) <- "accounting" +# class(df$hLink) <- "hyperlink" +# class(df$Percentage) <- "percentage" +# class(df$TinyNumbers) <- "scientific" +# +# write.xlsx(df, "writeXLSX3.xlsx") +# write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE) +# +# + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", +# halign = "center", valign = "center", textDecoration = "Bold", +# border = "TopBottomLeftRight", textRotation = 45) +# +# write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs) +# write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs) +# +# write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, +# headerStyle = createStyle(textRotation = 45)) +# +# + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# l <- list("IRIS" = iris, "colClasses" = df) +# write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs) +# write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2") +# +# openXL("writeXLSX6.xlsx") +# openXL("writeXLSXTable5.xlsx") + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# wb <- write.xlsx(iris, "writeXLSX6.xlsx") +# setColWidths(wb, sheet = 1, cols = 1:5, widths = 20) +# saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# require(ggplot2) +# wb <- createWorkbook() +# options("openxlsx.borderColour" = "#4F80BD") +# options("openxlsx.borderStyle" = "thin") +# modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow") + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE) +# addWorksheet(wb, sheetName = "Iris", gridLines = FALSE) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE) ## freeze first row and column +# writeDataTable(wb, sheet = 1, x = mtcars, +# colNames = TRUE, rowNames = TRUE, +# tableStyle = "TableStyleLight9") +# +# setColWidths(wb, sheet = 1, cols = "A", widths = 18) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2) +# +# qplot(data=iris, x = Sepal.Length, y= Sepal.Width, colour = Species) +# insertPlot(wb, 2, xy=c("B", 16)) ## insert plot at cell B16 +# +# means <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = mean) +# vars <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = var) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# headSty <- createStyle(fgFill="#DCE6F1", halign="center", border = "TopBottomLeftRight") +# writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2) +# writeData(wb, 2, x = means, startCol = "B", startRow=3, borders="rows", headerStyle = headSty) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9) +# writeData(wb, 2, x= vars, startCol = "B", startRow=10, borders="columns", +# headerStyle = headSty) +# +# setColWidths(wb, 2, cols=2:6, widths = 12) ## width is recycled for each col +# setColWidths(wb, 2, cols=11:15, widths = 15) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic")) +# addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2)) + +## ----include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------------------- +# saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory + +## ----eval=FALSE, include=TRUE------------------------------------------------- +# ## inspired by xtable gallery +# #https://CRAN.R-project.org/package=xtable/vignettes/xtableGallery.pdf +# +# ## Create a new workbook +# wb <- createWorkbook() +# data(tli, package = "xtable") +# +# ## data.frame +# test.n <- "data.frame" +# my.df <- tli[1:10, ] +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = my.df, borders = "n") +# +# ## matrix +# test.n <- "matrix" +# design.matrix <- model.matrix(~ sex * grade, data = my.df) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = design.matrix) +# +# ## aov +# test.n <- "aov" +# fm1 <- aov(tlimth ~ sex + ethnicty + grade + disadvg, data = tli) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = fm1) +# +# ## lm +# test.n <- "lm" +# fm2 <- lm(tlimth ~ sex*ethnicty, data = tli) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = fm2) +# +# ## anova 1 +# test.n <- "anova" +# my.anova <- anova(fm2) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = my.anova) +# +# ## anova 2 +# test.n <- "anova2" +# fm2b <- lm(tlimth ~ ethnicty, data = tli) +# my.anova2 <- anova(fm2b, fm2) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = my.anova2) +# +# ## glm +# test.n <- "glm" +# fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial()) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = fm3) +# +# ## prcomp +# test.n <- "prcomp" +# pr1 <- prcomp(USArrests) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = pr1) +# +# ## summary.prcomp +# test.n <- "summary.prcomp" +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = summary(pr1)) +# +# ## simple table +# test.n <- "table" +# data(airquality) +# airquality$OzoneG80 <- factor(airquality$Ozone > 80, +# levels = c(FALSE, TRUE), +# labels = c("Oz <= 80", "Oz > 80")) +# airquality$Month <- factor(airquality$Month, +# levels = 5:9, +# labels = month.abb[5:9]) +# my.table <- with(airquality, table(OzoneG80,Month) ) +# addWorksheet(wb = wb, sheetName = test.n) +# writeData(wb = wb, sheet = test.n, x = my.table) +# +# ## survdiff 1 +# library(survival) +# test.n <- "survdiff1" +# addWorksheet(wb = wb, sheetName = test.n) +# x <- survdiff(Surv(futime, fustat) ~ rx, data = ovarian) +# writeData(wb = wb, sheet = test.n, x = x) +# +# ## survdiff 2 +# test.n <- "survdiff2" +# addWorksheet(wb = wb, sheetName = test.n) +# expect <- survexp(futime ~ ratetable(age=(accept.dt - birth.dt), +# sex=1,year=accept.dt,race="white"), jasa, cohort=FALSE, +# ratetable=survexp.usr) +# x <- survdiff(Surv(jasa$futime, jasa$fustat) ~ offset(expect)) +# writeData(wb = wb, sheet = test.n, x = x) +# +# ## coxph 1 +# test.n <- "coxph1" +# addWorksheet(wb = wb, sheetName = test.n) +# bladder$rx <- factor(bladder$rx, labels = c("Pla","Thi")) +# x <- coxph(Surv(stop,event) ~ rx, data = bladder) +# writeData(wb = wb, sheet = test.n, x = x) +# +# ## coxph 2 +# test.n <- "coxph2" +# addWorksheet(wb = wb, sheetName = test.n) +# x <- coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder) +# writeData(wb = wb, sheet = test.n, x = x) +# +# ## cox.zph +# test.n <- "cox.zph" +# addWorksheet(wb = wb, sheetName = test.n) +# x <- cox.zph(coxph(Surv(futime, fustat) ~ age + ecog.ps, data=ovarian)) +# writeData(wb = wb, sheet = test.n, x = x) +# +# ## summary.coxph 1 +# test.n <- "summary.coxph1" +# addWorksheet(wb = wb, sheetName = test.n) +# x <- summary(coxph(Surv(stop,event) ~ rx, data = bladder)) +# writeData(wb = wb, sheet = test.n, x = x) +# +# ## summary.coxph 2 +# test.n <- "summary.coxph2" +# addWorksheet(wb = wb, sheetName = test.n) +# x <- summary(coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder)) +# writeData(wb = wb, sheet = test.n, x = x) +# +# ## view without saving +# openXL(wb) +# + +## ----eval=FALSE, include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE--------- +# require(ggplot2) +# +# wb <- createWorkbook() +# +# ## read historical prices from yahoo finance +# ticker <- "CBA.AX" +# csv.url <- paste0("https://query1.finance.yahoo.com/v7/finance/download/", +# ticker, "?period1=1597597610&period2=1629133610&interval=1d&events=history&includeAdjustedClose=true") +# prices <- read.csv(url(csv.url), as.is = TRUE) +# prices$Date <- as.Date(prices$Date) +# close <- prices$Close +# prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close)-1)])) +# +# ## Create plot of price series and add to worksheet +# ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + +# geom_line(colour="royalblue2") + +# labs(x = "Date", y = "Price", title = ticker) + +# geom_area(fill = "royalblue1",alpha = 0.3) + +# coord_cartesian(ylim=c(min(prices$Close)-1.5, max(prices$Close)+1.5)) +# +# ## Add worksheet and write plot to sheet +# addWorksheet(wb, sheetName = "CBA") +# insertPlot(wb, sheet = 1, xy = c("J", 3)) +# +# ## Histogram of log returns +# ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth=0.0025) + +# labs(title = "Histogram of log returns") +# +# ## currency +# class(prices$Close) <- "currency" ## styles as currency in workbook +# +# ## write historical data and histogram of returns +# writeDataTable(wb, sheet = "CBA", x = prices) +# insertPlot(wb, sheet = 1, startRow=25, startCol = "J") +# +# ## Add conditional formatting to show where logReturn > 0.01 using default style +# conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices)+1), +# rule = "$H2 > 0.01") +# +# ## style log return col as a percentage +# logRetStyle <- createStyle(numFmt = "percentage") +# +# addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), +# cols = "H", gridExpand = TRUE) +# +# setColWidths(wb, sheet=1, cols = c("A", "F", "G", "H"), widths = 15) +# +# ## save workbook to working directory +# saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE) +# openXL("stockPrice.xlsx") + +## ----eval=FALSE, include=TRUE------------------------------------------------- +# require(openxlsx) +# require(jpeg) +# require(ggplot2) +# +# plotFn <- function(x, ...){ +# colvec <- grey(x) +# colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2]) +# image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]), +# col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1, +# bty ="n", frame.plot=F, ann=FALSE) +# } +# +# ## Create workbook and add a worksheet, hide gridlines +# wb <- createWorkbook("Einstein") +# addWorksheet(wb, "Original Image", gridLines = FALSE) +# +# A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg")) +# height <- nrow(A); width <- ncol(A) +# +# ## write "Original Image" to cell B2 +# writeData(wb, 1, "Original Image", xy = c(2,2)) +# +# ## write Object size to cell B3 +# writeData(wb, 1, sprintf("Image object size: %s bytes", +# format(object.size(A+0)[[1]], big.mark=',')), +# xy = c(2,3)) ## equivalent to startCol = 2, startRow = 3 +# +# ## Plot image +# par(mar=rep(0, 4), xpd = NA); plotFn(A) +# +# ## insert plot currently showing in plot window +# insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2) +# +# ## SVD of covariance matrix +# rMeans <- rowMeans(A) +# rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans)) +# A <- A - rowMeans +# E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A +# pve <- data.frame("Eigenvalues" = E$d, +# "PVE" = E$d/sum(E$d), +# "Cumulative PVE" = cumsum(E$d/sum(E$d))) +# +# ## write eigenvalues to worksheet +# addWorksheet(wb, "Principal Component Analysis") +# hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", +# halign = "CENTER", textDecoration = "Bold", +# border = "TopBottomLeftRight", borderColour = "#4F81BD") +# +# writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2) +# mergeCells(wb, sheet=2, cols=1:4, rows=2) +# +# setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15)) +# writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs) +# +# ## Plots +# pve <- cbind(pve, "Ind" = 1:nrow(pve)) +# ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) + +# geom_bar(stat="identity", position = "dodge") + +# xlab("Principal Component Index") + ylab("Proportion of Variance Explained") + +# geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue") +# +# ## Write plot to worksheet 2 +# insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) +# +# ## Plot of cumulative explained variance +# ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) + +# geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") + +# ylab("Cumulative Proportion of Variance Explained") +# insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) +# +# +# ## Reconstruct image using increasing number of PCs +# nPCs <- c(5, 7, 12, 20, 50, 200) +# startRow <- rep(c(2, 24), each = 3) +# startCol <- rep(c("B", "H", "N"), 2) +# +# ## create a worksheet to save reconstructed images to +# addWorksheet(wb, "Reconstructed Images", zoom = 90) +# +# for(i in 1:length(nPCs)){ +# +# V <- E$v[, 1:nPCs[i]] +# imgHat <- t(V) %*% A ## project img data on to PCs +# imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans) +# +# imgHat <- V %*% imgHat + rowMeans ## reconstruct from PCs and add back row means +# imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale +# plotFn(imgHat/255) +# +# ## write strings to worksheet 3 +# writeData(wb, "Reconstructed Images", +# sprintf("Number of principal components used: %s", +# nPCs[[i]]), startCol[i], startRow[i]) +# +# writeData(wb, "Reconstructed Images", +# sprintf("Sum of component object sizes: %s bytes", +# format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1) +# +# ## write reconstruced image +# insertPlot(wb, "Reconstructed Images", width, height, units="px", +# xy = c(startCol[i], startRow[i]+3)) +# +# } +# +# # hide grid lines +# showGridLines(wb, sheet = 3, showGridLines = FALSE) +# +# ## Make text above images BOLD +# boldStyle <- createStyle(textDecoration="BOLD") +# +# ## only want to apply style to specified cells (not all combinations of rows & cols) +# addStyle(wb, "Reconstructed Images", style=boldStyle, +# rows = c(startRow, startRow+1), cols = rep(startCol, 2), +# gridExpand = FALSE) +# +# ## save workbook to working directory +# saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) +# +# +# +# +# ## remove example files for cran test +# if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) { +# file_list<-list.files(pattern="\\.xlsx",recursive = T) +# file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)] +# +# if(length(file_list)>0){ +# rm(file_list) +# } +# + diff -Nru r-cran-openxlsx-4.2.4/inst/doc/Introduction.Rmd r-cran-openxlsx-4.2.5/inst/doc/Introduction.Rmd --- r-cran-openxlsx-4.2.4/inst/doc/Introduction.Rmd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/doc/Introduction.Rmd 2021-12-13 08:14:44.000000000 +0000 @@ -1,510 +1,510 @@ ---- -title: "Introduction" -author: "Alexander Walker, Philipp Schauberger" -date: "`r Sys.Date()`" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{Introduction} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -## Basic Examples - - -### write.xlsx - -The simplest way to write to a workbook is write.xlsx(). -By default, write.xlsx calls writeData. If asTable is TRUE write.xlsx will write x as -an Excel table. - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -## write to working directory -library(openxlsx) -write.xlsx(iris, file = "writeXLSX1.xlsx") -write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE) -``` - -### write list of data.frames to xlsx-file - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -## write a list of data.frames to individual worksheets using list names as worksheet names -l <- list("IRIS" = iris, "MTCARS" = mtcars) -write.xlsx(l, file = "writeXLSX2.xlsx") -write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE) -``` - - -### write.xlsx also accepts styling parameters - - -#### The simplest way is to set default options and set column class - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -options("openxlsx.borderColour" = "#4F80BD") -options("openxlsx.borderStyle" = "thin") -options("openxlsx.dateFormat" = "mm/dd/yyyy") -options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -options("openxlsx.numFmt" = NULL) ## For default style rounding of numeric columns - -df <- data.frame("Date" = Sys.Date()-0:19, "LogicalT" = TRUE, - "Time" = Sys.time()-0:19*60*60, - "Cash" = paste("$",1:20), "Cash2" = 31:50, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(0, 1, length.out=20), - "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE) - -class(df$Cash) <- "currency" -class(df$Cash2) <- "accounting" -class(df$hLink) <- "hyperlink" -class(df$Percentage) <- "percentage" -class(df$TinyNumbers) <- "scientific" - -write.xlsx(df, "writeXLSX3.xlsx") -write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE) - - -``` - - -## Workbook styles - -### define a style for column headers -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", - halign = "center", valign = "center", textDecoration = "Bold", - border = "TopBottomLeftRight", textRotation = 45) - -write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs) -write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs) - -write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, -headerStyle = createStyle(textRotation = 45)) - - -``` - -### When writing a list, the stylings will apply to all list elements -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -l <- list("IRIS" = iris, "colClasses" = df) -write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs) -write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2") - -openXL("writeXLSX6.xlsx") -openXL("writeXLSXTable5.xlsx") -``` - - -### write.xlsx returns the workbook object for further editing -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -wb <- write.xlsx(iris, "writeXLSX6.xlsx") -setColWidths(wb, sheet = 1, cols = 1:5, widths = 20) -saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE) -``` - - - -## Workbook creation walk-through - -### create workbook and set default border Colour and style - - - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -require(ggplot2) -wb <- createWorkbook() -options("openxlsx.borderColour" = "#4F80BD") -options("openxlsx.borderStyle" = "thin") -modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow") -``` - - -### Add Sheets - - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE) -addWorksheet(wb, sheetName = "Iris", gridLines = FALSE) -``` - - -### write data to sheet 1 - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE) ## freeze first row and column -writeDataTable(wb, sheet = 1, x = mtcars, -colNames = TRUE, rowNames = TRUE, -tableStyle = "TableStyleLight9") - -setColWidths(wb, sheet = 1, cols = "A", widths = 18) -``` - - -### write data to sheet 2 - -iris data.frame is added as excel table on sheet 2. - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2) - -qplot(data=iris, x = Sepal.Length, y= Sepal.Width, colour = Species) -insertPlot(wb, 2, xy=c("B", 16)) ## insert plot at cell B16 - -means <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = mean) -vars <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = var) -``` - - -### add write group means -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -headSty <- createStyle(fgFill="#DCE6F1", halign="center", border = "TopBottomLeftRight") -writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2) -writeData(wb, 2, x = means, startCol = "B", startRow=3, borders="rows", headerStyle = headSty) -``` -### add write group variances -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9) -writeData(wb, 2, x= vars, startCol = "B", startRow=10, borders="columns", -headerStyle = headSty) - -setColWidths(wb, 2, cols=2:6, widths = 12) ## width is recycled for each col -setColWidths(wb, 2, cols=11:15, widths = 15) -``` - - -### add style mean & variance table headers -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic")) -addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2)) -``` - - -### save workbook -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory -``` - - -## Gallery - -```{r eval=FALSE, include=TRUE} -## inspired by xtable gallery -#https://CRAN.R-project.org/package=xtable/vignettes/xtableGallery.pdf - -## Create a new workbook -wb <- createWorkbook() -data(tli, package = "xtable") - -## data.frame -test.n <- "data.frame" -my.df <- tli[1:10, ] -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.df, borders = "n") - -## matrix -test.n <- "matrix" -design.matrix <- model.matrix(~ sex * grade, data = my.df) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = design.matrix) - -## aov -test.n <- "aov" -fm1 <- aov(tlimth ~ sex + ethnicty + grade + disadvg, data = tli) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = fm1) - -## lm -test.n <- "lm" -fm2 <- lm(tlimth ~ sex*ethnicty, data = tli) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = fm2) - -## anova 1 -test.n <- "anova" -my.anova <- anova(fm2) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.anova) - -## anova 2 -test.n <- "anova2" -fm2b <- lm(tlimth ~ ethnicty, data = tli) -my.anova2 <- anova(fm2b, fm2) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.anova2) - -## glm -test.n <- "glm" -fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial()) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = fm3) - -## prcomp -test.n <- "prcomp" -pr1 <- prcomp(USArrests) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = pr1) - -## summary.prcomp -test.n <- "summary.prcomp" -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = summary(pr1)) - -## simple table -test.n <- "table" -data(airquality) -airquality$OzoneG80 <- factor(airquality$Ozone > 80, -levels = c(FALSE, TRUE), -labels = c("Oz <= 80", "Oz > 80")) -airquality$Month <- factor(airquality$Month, -levels = 5:9, -labels = month.abb[5:9]) -my.table <- with(airquality, table(OzoneG80,Month) ) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.table) - -## survdiff 1 -library(survival) -test.n <- "survdiff1" -addWorksheet(wb = wb, sheetName = test.n) -x <- survdiff(Surv(futime, fustat) ~ rx, data = ovarian) -writeData(wb = wb, sheet = test.n, x = x) - -## survdiff 2 -test.n <- "survdiff2" -addWorksheet(wb = wb, sheetName = test.n) -expect <- survexp(futime ~ ratetable(age=(accept.dt - birth.dt), - sex=1,year=accept.dt,race="white"), jasa, cohort=FALSE, - ratetable=survexp.usr) -x <- survdiff(Surv(jasa$futime, jasa$fustat) ~ offset(expect)) -writeData(wb = wb, sheet = test.n, x = x) - -## coxph 1 -test.n <- "coxph1" -addWorksheet(wb = wb, sheetName = test.n) -bladder$rx <- factor(bladder$rx, labels = c("Pla","Thi")) -x <- coxph(Surv(stop,event) ~ rx, data = bladder) -writeData(wb = wb, sheet = test.n, x = x) - -## coxph 2 -test.n <- "coxph2" -addWorksheet(wb = wb, sheetName = test.n) -x <- coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder) -writeData(wb = wb, sheet = test.n, x = x) - -## cox.zph -test.n <- "cox.zph" -addWorksheet(wb = wb, sheetName = test.n) -x <- cox.zph(coxph(Surv(futime, fustat) ~ age + ecog.ps, data=ovarian)) -writeData(wb = wb, sheet = test.n, x = x) - -## summary.coxph 1 -test.n <- "summary.coxph1" -addWorksheet(wb = wb, sheetName = test.n) -x <- summary(coxph(Surv(stop,event) ~ rx, data = bladder)) -writeData(wb = wb, sheet = test.n, x = x) - -## summary.coxph 2 -test.n <- "summary.coxph2" -addWorksheet(wb = wb, sheetName = test.n) -x <- summary(coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder)) -writeData(wb = wb, sheet = test.n, x = x) - -## view without saving -openXL(wb) - -``` - -## Further Examples - -### Stock Price - -```{r eval=FALSE, include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -require(ggplot2) - -wb <- createWorkbook() - -## read historical prices from yahoo finance -ticker <- "CBA.AX" -csv.url <- paste("http://ichart.finance.yahoo.com/table.csv?s=", -ticker, "&a=01&b=9&c=2009&d=01&e=9&f=2014&g=d&ignore=.csv") -prices <- read.csv(url(csv.url), as.is = TRUE) -prices$Date <- as.Date(prices$Date) -close <- prices$Close -prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close)-1)])) - -## Create plot of price series and add to worksheet -ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + -geom_line(colour="royalblue2") + -labs(x = "Date", y = "Price", title = ticker) + -geom_area(fill = "royalblue1",alpha = 0.3) + -coord_cartesian(ylim=c(min(prices$Close)-1.5, max(prices$Close)+1.5)) - -## Add worksheet and write plot to sheet -addWorksheet(wb, sheetName = "CBA") -insertPlot(wb, sheet = 1, xy = c("J", 3)) - -## Histogram of log returns -ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth=0.0025) + -labs(title = "Histogram of log returns") - -## currency -class(prices$Close) <- "currency" ## styles as currency in workbook - -## write historical data and histogram of returns -writeDataTable(wb, sheet = "CBA", x = prices) -insertPlot(wb, sheet = 1, startRow=25, startCol = "J") - -## Add conditional formatting to show where logReturn > 0.01 using default style -conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices)+1), -rule = "$H2 > 0.01") - -## style log return col as a percentage -logRetStyle <- createStyle(numFmt = "percentage") - -addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), -cols = "H", gridExpand = TRUE) - -setColWidths(wb, sheet=1, cols = c("A", "F", "G", "H"), widths = 15) - -## save workbook to working directory -saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE) -openXL("stockPrice.xlsx") -``` - - -### Image Compression using PCA - - -```{r eval=FALSE, include=TRUE} -require(openxlsx) -require(jpeg) -require(ggplot2) - -plotFn <- function(x, ...){ - colvec <- grey(x) - colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2]) - image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]), - col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1, - bty ="n", frame.plot=F, ann=FALSE) -} - -## Create workbook and add a worksheet, hide gridlines -wb <- createWorkbook("Einstein") -addWorksheet(wb, "Original Image", gridLines = FALSE) - -A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg")) -height <- nrow(A); width <- ncol(A) - -## write "Original Image" to cell B2 -writeData(wb, 1, "Original Image", xy = c(2,2)) - -## write Object size to cell B3 -writeData(wb, 1, sprintf("Image object size: %s bytes", - format(object.size(A+0)[[1]], big.mark=',')), - xy = c(2,3)) ## equivalent to startCol = 2, startRow = 3 - -## Plot image -par(mar=rep(0, 4), xpd = NA); plotFn(A) - -## insert plot currently showing in plot window -insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2) - -## SVD of covariance matrix -rMeans <- rowMeans(A) -rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans)) -A <- A - rowMeans -E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A -pve <- data.frame("Eigenvalues" = E$d, - "PVE" = E$d/sum(E$d), - "Cumulative PVE" = cumsum(E$d/sum(E$d))) - -## write eigenvalues to worksheet -addWorksheet(wb, "Principal Component Analysis") -hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", - halign = "CENTER", textDecoration = "Bold", - border = "TopBottomLeftRight", borderColour = "#4F81BD") - -writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2) -mergeCells(wb, sheet=2, cols=1:4, rows=2) - -setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15)) -writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs) - -## Plots -pve <- cbind(pve, "Ind" = 1:nrow(pve)) -ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) + - geom_bar(stat="identity", position = "dodge") + - xlab("Principal Component Index") + ylab("Proportion of Variance Explained") + - geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue") - -## Write plot to worksheet 2 -insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) - -## Plot of cumulative explained variance -ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) + - geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") + - ylab("Cumulative Proportion of Variance Explained") -insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) - - -## Reconstruct image using increasing number of PCs -nPCs <- c(5, 7, 12, 20, 50, 200) -startRow <- rep(c(2, 24), each = 3) -startCol <- rep(c("B", "H", "N"), 2) - -## create a worksheet to save reconstructed images to -addWorksheet(wb, "Reconstructed Images", zoom = 90) - -for(i in 1:length(nPCs)){ - - V <- E$v[, 1:nPCs[i]] - imgHat <- t(V) %*% A ## project img data on to PCs - imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans) - - imgHat <- V %*% imgHat + rowMeans ## reconstruct from PCs and add back row means - imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale - plotFn(imgHat/255) - - ## write strings to worksheet 3 - writeData(wb, "Reconstructed Images", - sprintf("Number of principal components used: %s", - nPCs[[i]]), startCol[i], startRow[i]) - - writeData(wb, "Reconstructed Images", - sprintf("Sum of component object sizes: %s bytes", - format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1) - - ## write reconstruced image - insertPlot(wb, "Reconstructed Images", width, height, units="px", - xy = c(startCol[i], startRow[i]+3)) - -} - -# hide grid lines -showGridLines(wb, sheet = 3, showGridLines = FALSE) - -## Make text above images BOLD -boldStyle <- createStyle(textDecoration="BOLD") - -## only want to apply style to specified cells (not all combinations of rows & cols) -addStyle(wb, "Reconstructed Images", style=boldStyle, - rows = c(startRow, startRow+1), cols = rep(startCol, 2), - gridExpand = FALSE) - -## save workbook to working directory -saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) - - - - -## remove example files for cran test -if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) { -file_list<-list.files(pattern="\\.xlsx",recursive = T) -file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)] - -if(length(file_list)>0){ -rm(file_list) -} - -``` - +--- +title: "Introduction" +author: "Alexander Walker, Philipp Schauberger" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Introduction} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +## Basic Examples + + +### write.xlsx + +The simplest way to write to a workbook is write.xlsx(). +By default, write.xlsx calls writeData. If asTable is TRUE write.xlsx will write x as +an Excel table. + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +## write to working directory +library(openxlsx) +write.xlsx(iris, file = "writeXLSX1.xlsx") +write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE) +``` + +### write list of data.frames to xlsx-file + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +## write a list of data.frames to individual worksheets using list names as worksheet names +l <- list("IRIS" = iris, "MTCARS" = mtcars) +write.xlsx(l, file = "writeXLSX2.xlsx") +write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE) +``` + + +### write.xlsx also accepts styling parameters + + +#### The simplest way is to set default options and set column class + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +options("openxlsx.borderColour" = "#4F80BD") +options("openxlsx.borderStyle" = "thin") +options("openxlsx.dateFormat" = "mm/dd/yyyy") +options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +options("openxlsx.numFmt" = NULL) ## For default style rounding of numeric columns + +df <- data.frame("Date" = Sys.Date()-0:19, "LogicalT" = TRUE, + "Time" = Sys.time()-0:19*60*60, + "Cash" = paste("$",1:20), "Cash2" = 31:50, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(0, 1, length.out=20), + "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE) + +class(df$Cash) <- "currency" +class(df$Cash2) <- "accounting" +class(df$hLink) <- "hyperlink" +class(df$Percentage) <- "percentage" +class(df$TinyNumbers) <- "scientific" + +write.xlsx(df, "writeXLSX3.xlsx") +write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE) + + +``` + + +## Workbook styles + +### define a style for column headers +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", + halign = "center", valign = "center", textDecoration = "Bold", + border = "TopBottomLeftRight", textRotation = 45) + +write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs) +write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs) + +write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, +headerStyle = createStyle(textRotation = 45)) + + +``` + +### When writing a list, the stylings will apply to all list elements +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +l <- list("IRIS" = iris, "colClasses" = df) +write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs) +write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2") + +openXL("writeXLSX6.xlsx") +openXL("writeXLSXTable5.xlsx") +``` + + +### write.xlsx returns the workbook object for further editing +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +wb <- write.xlsx(iris, "writeXLSX6.xlsx") +setColWidths(wb, sheet = 1, cols = 1:5, widths = 20) +saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE) +``` + + + +## Workbook creation walk-through + +### create workbook and set default border Colour and style + + + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +require(ggplot2) +wb <- createWorkbook() +options("openxlsx.borderColour" = "#4F80BD") +options("openxlsx.borderStyle" = "thin") +modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow") +``` + + +### Add Sheets + + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE) +addWorksheet(wb, sheetName = "Iris", gridLines = FALSE) +``` + + +### write data to sheet 1 + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE) ## freeze first row and column +writeDataTable(wb, sheet = 1, x = mtcars, +colNames = TRUE, rowNames = TRUE, +tableStyle = "TableStyleLight9") + +setColWidths(wb, sheet = 1, cols = "A", widths = 18) +``` + + +### write data to sheet 2 + +iris data.frame is added as excel table on sheet 2. + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2) + +qplot(data=iris, x = Sepal.Length, y= Sepal.Width, colour = Species) +insertPlot(wb, 2, xy=c("B", 16)) ## insert plot at cell B16 + +means <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = mean) +vars <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = var) +``` + + +### add write group means +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +headSty <- createStyle(fgFill="#DCE6F1", halign="center", border = "TopBottomLeftRight") +writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2) +writeData(wb, 2, x = means, startCol = "B", startRow=3, borders="rows", headerStyle = headSty) +``` +### add write group variances +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9) +writeData(wb, 2, x= vars, startCol = "B", startRow=10, borders="columns", +headerStyle = headSty) + +setColWidths(wb, 2, cols=2:6, widths = 12) ## width is recycled for each col +setColWidths(wb, 2, cols=11:15, widths = 15) +``` + + +### add style mean & variance table headers +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic")) +addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2)) +``` + + +### save workbook +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory +``` + + +## Gallery + +```{r eval=FALSE, include=TRUE} +## inspired by xtable gallery +#https://CRAN.R-project.org/package=xtable/vignettes/xtableGallery.pdf + +## Create a new workbook +wb <- createWorkbook() +data(tli, package = "xtable") + +## data.frame +test.n <- "data.frame" +my.df <- tli[1:10, ] +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.df, borders = "n") + +## matrix +test.n <- "matrix" +design.matrix <- model.matrix(~ sex * grade, data = my.df) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = design.matrix) + +## aov +test.n <- "aov" +fm1 <- aov(tlimth ~ sex + ethnicty + grade + disadvg, data = tli) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = fm1) + +## lm +test.n <- "lm" +fm2 <- lm(tlimth ~ sex*ethnicty, data = tli) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = fm2) + +## anova 1 +test.n <- "anova" +my.anova <- anova(fm2) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.anova) + +## anova 2 +test.n <- "anova2" +fm2b <- lm(tlimth ~ ethnicty, data = tli) +my.anova2 <- anova(fm2b, fm2) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.anova2) + +## glm +test.n <- "glm" +fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial()) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = fm3) + +## prcomp +test.n <- "prcomp" +pr1 <- prcomp(USArrests) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = pr1) + +## summary.prcomp +test.n <- "summary.prcomp" +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = summary(pr1)) + +## simple table +test.n <- "table" +data(airquality) +airquality$OzoneG80 <- factor(airquality$Ozone > 80, +levels = c(FALSE, TRUE), +labels = c("Oz <= 80", "Oz > 80")) +airquality$Month <- factor(airquality$Month, +levels = 5:9, +labels = month.abb[5:9]) +my.table <- with(airquality, table(OzoneG80,Month) ) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.table) + +## survdiff 1 +library(survival) +test.n <- "survdiff1" +addWorksheet(wb = wb, sheetName = test.n) +x <- survdiff(Surv(futime, fustat) ~ rx, data = ovarian) +writeData(wb = wb, sheet = test.n, x = x) + +## survdiff 2 +test.n <- "survdiff2" +addWorksheet(wb = wb, sheetName = test.n) +expect <- survexp(futime ~ ratetable(age=(accept.dt - birth.dt), + sex=1,year=accept.dt,race="white"), jasa, cohort=FALSE, + ratetable=survexp.usr) +x <- survdiff(Surv(jasa$futime, jasa$fustat) ~ offset(expect)) +writeData(wb = wb, sheet = test.n, x = x) + +## coxph 1 +test.n <- "coxph1" +addWorksheet(wb = wb, sheetName = test.n) +bladder$rx <- factor(bladder$rx, labels = c("Pla","Thi")) +x <- coxph(Surv(stop,event) ~ rx, data = bladder) +writeData(wb = wb, sheet = test.n, x = x) + +## coxph 2 +test.n <- "coxph2" +addWorksheet(wb = wb, sheetName = test.n) +x <- coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder) +writeData(wb = wb, sheet = test.n, x = x) + +## cox.zph +test.n <- "cox.zph" +addWorksheet(wb = wb, sheetName = test.n) +x <- cox.zph(coxph(Surv(futime, fustat) ~ age + ecog.ps, data=ovarian)) +writeData(wb = wb, sheet = test.n, x = x) + +## summary.coxph 1 +test.n <- "summary.coxph1" +addWorksheet(wb = wb, sheetName = test.n) +x <- summary(coxph(Surv(stop,event) ~ rx, data = bladder)) +writeData(wb = wb, sheet = test.n, x = x) + +## summary.coxph 2 +test.n <- "summary.coxph2" +addWorksheet(wb = wb, sheetName = test.n) +x <- summary(coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder)) +writeData(wb = wb, sheet = test.n, x = x) + +## view without saving +openXL(wb) + +``` + +## Further Examples + +### Stock Price + +```{r eval=FALSE, include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +require(ggplot2) + +wb <- createWorkbook() + +## read historical prices from yahoo finance +ticker <- "CBA.AX" +csv.url <- paste0("https://query1.finance.yahoo.com/v7/finance/download/", +ticker, "?period1=1597597610&period2=1629133610&interval=1d&events=history&includeAdjustedClose=true") +prices <- read.csv(url(csv.url), as.is = TRUE) +prices$Date <- as.Date(prices$Date) +close <- prices$Close +prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close)-1)])) + +## Create plot of price series and add to worksheet +ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + +geom_line(colour="royalblue2") + +labs(x = "Date", y = "Price", title = ticker) + +geom_area(fill = "royalblue1",alpha = 0.3) + +coord_cartesian(ylim=c(min(prices$Close)-1.5, max(prices$Close)+1.5)) + +## Add worksheet and write plot to sheet +addWorksheet(wb, sheetName = "CBA") +insertPlot(wb, sheet = 1, xy = c("J", 3)) + +## Histogram of log returns +ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth=0.0025) + +labs(title = "Histogram of log returns") + +## currency +class(prices$Close) <- "currency" ## styles as currency in workbook + +## write historical data and histogram of returns +writeDataTable(wb, sheet = "CBA", x = prices) +insertPlot(wb, sheet = 1, startRow=25, startCol = "J") + +## Add conditional formatting to show where logReturn > 0.01 using default style +conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices)+1), +rule = "$H2 > 0.01") + +## style log return col as a percentage +logRetStyle <- createStyle(numFmt = "percentage") + +addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), +cols = "H", gridExpand = TRUE) + +setColWidths(wb, sheet=1, cols = c("A", "F", "G", "H"), widths = 15) + +## save workbook to working directory +saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE) +openXL("stockPrice.xlsx") +``` + + +### Image Compression using PCA + + +```{r eval=FALSE, include=TRUE} +require(openxlsx) +require(jpeg) +require(ggplot2) + +plotFn <- function(x, ...){ + colvec <- grey(x) + colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2]) + image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]), + col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1, + bty ="n", frame.plot=F, ann=FALSE) +} + +## Create workbook and add a worksheet, hide gridlines +wb <- createWorkbook("Einstein") +addWorksheet(wb, "Original Image", gridLines = FALSE) + +A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg")) +height <- nrow(A); width <- ncol(A) + +## write "Original Image" to cell B2 +writeData(wb, 1, "Original Image", xy = c(2,2)) + +## write Object size to cell B3 +writeData(wb, 1, sprintf("Image object size: %s bytes", + format(object.size(A+0)[[1]], big.mark=',')), + xy = c(2,3)) ## equivalent to startCol = 2, startRow = 3 + +## Plot image +par(mar=rep(0, 4), xpd = NA); plotFn(A) + +## insert plot currently showing in plot window +insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2) + +## SVD of covariance matrix +rMeans <- rowMeans(A) +rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans)) +A <- A - rowMeans +E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A +pve <- data.frame("Eigenvalues" = E$d, + "PVE" = E$d/sum(E$d), + "Cumulative PVE" = cumsum(E$d/sum(E$d))) + +## write eigenvalues to worksheet +addWorksheet(wb, "Principal Component Analysis") +hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", + halign = "CENTER", textDecoration = "Bold", + border = "TopBottomLeftRight", borderColour = "#4F81BD") + +writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2) +mergeCells(wb, sheet=2, cols=1:4, rows=2) + +setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15)) +writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs) + +## Plots +pve <- cbind(pve, "Ind" = 1:nrow(pve)) +ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) + + geom_bar(stat="identity", position = "dodge") + + xlab("Principal Component Index") + ylab("Proportion of Variance Explained") + + geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue") + +## Write plot to worksheet 2 +insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) + +## Plot of cumulative explained variance +ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) + + geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") + + ylab("Cumulative Proportion of Variance Explained") +insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) + + +## Reconstruct image using increasing number of PCs +nPCs <- c(5, 7, 12, 20, 50, 200) +startRow <- rep(c(2, 24), each = 3) +startCol <- rep(c("B", "H", "N"), 2) + +## create a worksheet to save reconstructed images to +addWorksheet(wb, "Reconstructed Images", zoom = 90) + +for(i in 1:length(nPCs)){ + + V <- E$v[, 1:nPCs[i]] + imgHat <- t(V) %*% A ## project img data on to PCs + imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans) + + imgHat <- V %*% imgHat + rowMeans ## reconstruct from PCs and add back row means + imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale + plotFn(imgHat/255) + + ## write strings to worksheet 3 + writeData(wb, "Reconstructed Images", + sprintf("Number of principal components used: %s", + nPCs[[i]]), startCol[i], startRow[i]) + + writeData(wb, "Reconstructed Images", + sprintf("Sum of component object sizes: %s bytes", + format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1) + + ## write reconstruced image + insertPlot(wb, "Reconstructed Images", width, height, units="px", + xy = c(startCol[i], startRow[i]+3)) + +} + +# hide grid lines +showGridLines(wb, sheet = 3, showGridLines = FALSE) + +## Make text above images BOLD +boldStyle <- createStyle(textDecoration="BOLD") + +## only want to apply style to specified cells (not all combinations of rows & cols) +addStyle(wb, "Reconstructed Images", style=boldStyle, + rows = c(startRow, startRow+1), cols = rep(startCol, 2), + gridExpand = FALSE) + +## save workbook to working directory +saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) + + + + +## remove example files for cran test +if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) { +file_list<-list.files(pattern="\\.xlsx",recursive = T) +file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)] + +if(length(file_list)>0){ +rm(file_list) +} + +``` + diff -Nru r-cran-openxlsx-4.2.4/inst/extdata/build_font_size_lookup.R r-cran-openxlsx-4.2.5/inst/extdata/build_font_size_lookup.R --- r-cran-openxlsx-4.2.4/inst/extdata/build_font_size_lookup.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/extdata/build_font_size_lookup.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,64 +1,64 @@ -# nolint start - -options("scipen" = 10000) - -## loop through all fonts -fontDir <- "C:\\Users\\Alex\\Desktop\\font_workbooks" -files <- list.files(fontDir, patter = "\\.xlsx$", full.names = TRUE) -files <- files[!grepl("-bold.xlsx", files)] - -files2 <- list.files(fontDir, patter = "\\.xlsx$", full.names = FALSE) -files2 <- files2[!grepl("-bold.xlsx", files2)] - -font <- tolower(gsub(" ", ".", gsub("\\.xlsx", "", files2))) - - -strs <- "openxlsxFontSizeLookupTable <- \ndata.frame(" -allWidths <- rep(8.43, 29) -names(allWidths) <- 1:29 -for(i in seq_along(files)){ - - f <- font[[i]] - widths <- round(as.numeric(read.xlsx(files[[i]])[2,]), 6) - strs <- c(strs, sprintf('"%s"= c(%s),\n', f, paste(widths, collapse = ", "))) - -} - -strs[length(strs)] <- gsub(",\n", ")", strs[length(strs)]) - - -## bold ones - -## loop through all fonts -fontDir <- "C:\\Users\\Alex\\Desktop\\font_workbooks" -files <- list.files(fontDir, patter = "\\.xlsx$", full.names = TRUE) -files <- files[grepl("-bold.xlsx", files)] - -files2 <- list.files(fontDir, patter = "\\.xlsx$", full.names = FALSE) -files2 <- files2[grepl("-bold.xlsx", files2)] - -font <- tolower(gsub(" ", ".", gsub("\\-bold.xlsx", "", files2))) - - -strsBold <- "openxlsxFontSizeLookupTableBold <- \ndata.frame(" -allWidths <- rep(8.43, 29) -names(allWidths) <- 1:29 -for(i in seq_along(files)){ - - f <- font[[i]] - widths <- round(as.numeric(read.xlsx(files[[i]])[2,]), 6) - strsBold <- c(strsBold, sprintf('"%s"= c(%s),\n', f, paste(widths, collapse = ", "))) - -} - -strsBold[length(strsBold)] <- gsub(",\n", ")", strsBold[length(strsBold)]) - - -allStrs <- c(strs, "\n\n\n", strsBold) -cat(allStrs) - - - - - -# nolint end +# nolint start + +options("scipen" = 10000) + +## loop through all fonts +fontDir <- "C:\\Users\\Alex\\Desktop\\font_workbooks" +files <- list.files(fontDir, patter = "\\.xlsx$", full.names = TRUE) +files <- files[!grepl("-bold.xlsx", files)] + +files2 <- list.files(fontDir, patter = "\\.xlsx$", full.names = FALSE) +files2 <- files2[!grepl("-bold.xlsx", files2)] + +font <- tolower(gsub(" ", ".", gsub("\\.xlsx", "", files2))) + + +strs <- "openxlsxFontSizeLookupTable <- \ndata.frame(" +allWidths <- rep(8.43, 29) +names(allWidths) <- 1:29 +for(i in seq_along(files)){ + + f <- font[[i]] + widths <- round(as.numeric(read.xlsx(files[[i]])[2,]), 6) + strs <- c(strs, sprintf('"%s"= c(%s),\n', f, paste(widths, collapse = ", "))) + +} + +strs[length(strs)] <- gsub(",\n", ")", strs[length(strs)]) + + +## bold ones + +## loop through all fonts +fontDir <- "C:\\Users\\Alex\\Desktop\\font_workbooks" +files <- list.files(fontDir, patter = "\\.xlsx$", full.names = TRUE) +files <- files[grepl("-bold.xlsx", files)] + +files2 <- list.files(fontDir, patter = "\\.xlsx$", full.names = FALSE) +files2 <- files2[grepl("-bold.xlsx", files2)] + +font <- tolower(gsub(" ", ".", gsub("\\-bold.xlsx", "", files2))) + + +strsBold <- "openxlsxFontSizeLookupTableBold <- \ndata.frame(" +allWidths <- rep(8.43, 29) +names(allWidths) <- 1:29 +for(i in seq_along(files)){ + + f <- font[[i]] + widths <- round(as.numeric(read.xlsx(files[[i]])[2,]), 6) + strsBold <- c(strsBold, sprintf('"%s"= c(%s),\n', f, paste(widths, collapse = ", "))) + +} + +strsBold[length(strsBold)] <- gsub(",\n", ")", strsBold[length(strsBold)]) + + +allStrs <- c(strs, "\n\n\n", strsBold) +cat(allStrs) + + + + + +# nolint end Binary files /tmp/tmpl8lzxd88/cZki4U6tAm/r-cran-openxlsx-4.2.4/inst/extdata/ColorTabs3.xlsx and /tmp/tmpl8lzxd88/_fcQBeVuZy/r-cran-openxlsx-4.2.5/inst/extdata/ColorTabs3.xlsx differ diff -Nru r-cran-openxlsx-4.2.4/inst/extdata/conditional_formatting_testing.R r-cran-openxlsx-4.2.5/inst/extdata/conditional_formatting_testing.R --- r-cran-openxlsx-4.2.4/inst/extdata/conditional_formatting_testing.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/extdata/conditional_formatting_testing.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,80 +1,80 @@ -# nolint start - - -wb <- createWorkbook() -addWorksheet(wb, "cellIs") -addWorksheet(wb, "Moving Row") -addWorksheet(wb, "Moving Col") -addWorksheet(wb, "Dependent on 1") -addWorksheet(wb, "Duplicates") -addWorksheet(wb, "containsText") -addWorksheet(wb, "colourScale", zoom = 30) -addWorksheet(wb, "databar") - -negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") - -## rule applies to all each cell in range -writeData(wb, "cellIs", -5:5) -writeData(wb, "cellIs", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "cellIs", cols=1, rows=2:12, rule="!=0", style = negStyle) -conditionalFormatting(wb, "cellIs", cols=1, rows=2:12, rule="==0", style = posStyle) - -## highlight row dependent on first cell in row -writeData(wb, "Moving Row", -5:5) -writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Moving Row", cols=1:2, rows=2:12, rule="$A1<0", style = negStyle) -conditionalFormatting(wb, "Moving Row", cols=1:2, rows=2:12, rule="$A1>0", style = posStyle) - -## highlight column dependent on first cell in column -writeData(wb, "Moving Col", -5:5) -writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Moving Col", cols=1:2, rows=2:12, rule="A$1<0", style = negStyle) -conditionalFormatting(wb, "Moving Col", cols=1:2, rows=2:12, rule="A$1>0", style = posStyle) - -## highlight entire range cols X rows dependent only on cell A1 -writeData(wb, "Dependent on 1", -5:5) -writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=2:12, rule="$A$1<0", style = negStyle) -conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=2:12, rule="$A$1>0", style = posStyle) - -## highlight duplicates using default style -writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) -conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") - -## cells containing text -fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -writeData(wb, "containsText", sapply(1:10, fn)) -conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") - -## colourscale colours cells based on cell value -df <- read.xlsx(system.file("extdata","readTest.xlsx", package = "openxlsx"), sheet = 4) -writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame - -## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) -conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), - style = c("black", "red", "white"), - rule = c(0, 100, 255), #If rule is NULL, min and max are used. Rule must be the same length as style or NULL. - type = "colourScale") - -setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) -setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) - -## Databars -writeData(wb, "databar", -5:5) -conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours - -fl <- tempfile(fileext = ".xlsx") -saveWorkbook(wb, file = fl, overwrite = TRUE) - -openXL(wb) - - - - -wb <- loadWorkbook(fl) -conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates", style = createStyle(textDecoration = 'BOLD')) -openXL(wb) - - -# nolint end +# nolint start + + +wb <- createWorkbook() +addWorksheet(wb, "cellIs") +addWorksheet(wb, "Moving Row") +addWorksheet(wb, "Moving Col") +addWorksheet(wb, "Dependent on 1") +addWorksheet(wb, "Duplicates") +addWorksheet(wb, "containsText") +addWorksheet(wb, "colourScale", zoom = 30) +addWorksheet(wb, "databar") + +negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") + +## rule applies to all each cell in range +writeData(wb, "cellIs", -5:5) +writeData(wb, "cellIs", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "cellIs", cols=1, rows=2:12, rule="!=0", style = negStyle) +conditionalFormatting(wb, "cellIs", cols=1, rows=2:12, rule="==0", style = posStyle) + +## highlight row dependent on first cell in row +writeData(wb, "Moving Row", -5:5) +writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Moving Row", cols=1:2, rows=2:12, rule="$A1<0", style = negStyle) +conditionalFormatting(wb, "Moving Row", cols=1:2, rows=2:12, rule="$A1>0", style = posStyle) + +## highlight column dependent on first cell in column +writeData(wb, "Moving Col", -5:5) +writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Moving Col", cols=1:2, rows=2:12, rule="A$1<0", style = negStyle) +conditionalFormatting(wb, "Moving Col", cols=1:2, rows=2:12, rule="A$1>0", style = posStyle) + +## highlight entire range cols X rows dependent only on cell A1 +writeData(wb, "Dependent on 1", -5:5) +writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=2:12, rule="$A$1<0", style = negStyle) +conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=2:12, rule="$A$1>0", style = posStyle) + +## highlight duplicates using default style +writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) +conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") + +## cells containing text +fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +writeData(wb, "containsText", sapply(1:10, fn)) +conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") + +## colourscale colours cells based on cell value +df <- read.xlsx(system.file("extdata","readTest.xlsx", package = "openxlsx"), sheet = 4) +writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame + +## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) +conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), + style = c("black", "red", "white"), + rule = c(0, 100, 255), #If rule is NULL, min and max are used. Rule must be the same length as style or NULL. + type = "colourScale") + +setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) +setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) + +## Databars +writeData(wb, "databar", -5:5) +conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours + +fl <- tempfile(fileext = ".xlsx") +saveWorkbook(wb, file = fl, overwrite = TRUE) + +openXL(wb) + + + + +wb <- loadWorkbook(fl) +conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates", style = createStyle(textDecoration = 'BOLD')) +openXL(wb) + + +# nolint end Binary files /tmp/tmpl8lzxd88/cZki4U6tAm/r-cran-openxlsx-4.2.4/inst/extdata/inlineStr.xlsx and /tmp/tmpl8lzxd88/_fcQBeVuZy/r-cran-openxlsx-4.2.5/inst/extdata/inlineStr.xlsx differ diff -Nru r-cran-openxlsx-4.2.4/inst/extdata/load_xlsx_testing.R r-cran-openxlsx-4.2.5/inst/extdata/load_xlsx_testing.R --- r-cran-openxlsx-4.2.4/inst/extdata/load_xlsx_testing.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/extdata/load_xlsx_testing.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,175 +1,175 @@ -# nolint start -require('openxlsx') - -unzip_xlsx <- function(fl){ - - wd <- getwd() - d <- file.path(tempdir(), paste(sample(LETTERS, 10), collapse = "")) - unlink(d, recursive = TRUE, force = TRUE) - dir.create(d) - - new_fl <- file.path(d, basename(fl)) - file.copy(from = fl, to = new_fl) - - setwd(d) - unzip(zipfile = new_fl, junkpaths = FALSE) - cmd <- paste("start", d) - shell(cmd) - - unlink(new_fl) - - setwd(wd) - - return(d) - -} - - -zip_xlsx <- function(d){ - - wd <- getwd() - setwd(d) - - zipfile = "a.xlsx" - files <- list.files() - flags = "-r1" - extras = "" - zip = Sys.getenv("R_ZIPCMD", "zip") - args <- c(flags, shQuote(path.expand(zipfile)), shQuote(files), extras) - res <- invisible(suppressWarnings(system2(zip, args, stdout = NULL))) - setwd(wd) - - -} - -## Get loading files -# devtools::install_github("awalker89/openxlsx_testing_files", force = TRUE) - -## To install from CRAN -# detach("package:openxlsx", unload=TRUE) -# install.packages("openxlsx") - - -test_file_dir <- system.file(package = "openxlsx.testing.files") - -################################################################################################################ -## All Features -wb <- loadWorkbook(file.path(test_file_dir, "All_Features.xlsx")) -openXL(wb) - - -################################################################################################################ -## Budget Template -wb <- loadWorkbook(file.path(test_file_dir, "Budget.xlsx")) -openXL(wb) -openXL(file.path(test_file_dir, "Budget.xlsx")) - - - - -################################################################################################################ -## Chart Sheet -wb <- loadWorkbook(file.path(test_file_dir, "Chart_Sheet_Test.xlsx")) -openXL(wb) - - - -################################################################################################################ -## Chineses Characters -wb <- loadWorkbook(file.path(test_file_dir, "Chinese_Characters.xlsx")) -openXL(wb) - - -################################################################################################################ -## Excel Diet Template -wb <- loadWorkbook(file.path(test_file_dir, "Diet.xlsx")) -openXL(wb) -openXL(file.path(test_file_dir, "Diet.xlsx")) - -################################################################################################################ -## Empty Workbook -wb <- loadWorkbook(file.path(test_file_dir, "empty.xlsx")) -openXL(wb) - - -################################################################################################################ -## Encoding Test -wb <- loadWorkbook(file.path(test_file_dir, "Encoding_Test.xlsx")) -openXL(wb) -openXL(file.path(test_file_dir, "Encoding_Test.xlsx")) - -################################################################################################################ -## Libre Office Test File -wb <- loadWorkbook(file.path(test_file_dir, "libre_test.xlsx")) -openXL(wb) - -wb <- loadWorkbook(file.path(test_file_dir, "libre_test2.xlsx")) -openXL(wb) - - -################################################################################################################ -## Load Example Workbook -wb <- loadWorkbook(system.file("loadExample.xlsx", package = "openxlsx")) -openXL(wb) -openXL(system.file("loadExample.xlsx", package = "openxlsx")) - -################################################################################################################ -## Loading Pivot Tables -wb <- loadWorkbook(file.path(test_file_dir, "pivotTest.xlsx")) -openXL(wb) - -wb <- loadWorkbook(file.path(test_file_dir, "pivotTest2.xlsx")) -openXL(wb) - -wb <- loadWorkbook(file.path(test_file_dir, "pivotTest3.xlsx")) -openXL(wb) - - -################################################################################################################ -## Excel Template (Sales call log and organizer1.xlsx) -wb <- loadWorkbook(file.path(test_file_dir, "Sales call log and organizer1.xlsx")) -openXL(wb) - - -################################################################################################################ -## Whitespace - maintain whitespace -wb <- loadWorkbook(file.path(test_file_dir, "Whitespace_Test.xlsx")) -openXL(wb) - - -################################################################################################################ -## Weight Tracket Excel Template -wb <- loadWorkbook(file.path(test_file_dir, "WeightTrackerTemplate.xlsx")) -openXL(wb) - -################################################################################################################ -## Schedule Excel Template -wb <- loadWorkbook(file = file.path(test_file_dir, "Schedule Template.xlsx")) -openXL(wb) - - -################################################################################################################ -## package Example File -wb <- loadWorkbook(file = system.file("loadExample.xlsx", package = "openxlsx")) -openXL(wb) - - - - -## write jsuts a date -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -writeData(wb, 1, as.Date('2014-01-01')) -openXL(wb) - -wb <- loadWorkbook(file.path(test_file_dir, "pivotTest.xlsx")) -writeData(wb, 1, iris[,1:3]*100, colNames = FALSE, startRow = 2) -openXL(wb) - -openXL(file.path(test_file_dir, "pivotTest.xlsx")) - - - - - -# nolint end +# nolint start +require('openxlsx') + +unzip_xlsx <- function(fl){ + + wd <- getwd() + d <- file.path(tempdir(), paste(sample(LETTERS, 10), collapse = "")) + unlink(d, recursive = TRUE, force = TRUE) + dir.create(d) + + new_fl <- file.path(d, basename(fl)) + file.copy(from = fl, to = new_fl) + + setwd(d) + unzip(zipfile = new_fl, junkpaths = FALSE) + cmd <- paste("start", d) + shell(cmd) + + unlink(new_fl) + + setwd(wd) + + return(d) + +} + + +zip_xlsx <- function(d){ + + wd <- getwd() + setwd(d) + + zipfile = "a.xlsx" + files <- list.files() + flags = "-r1" + extras = "" + zip = Sys.getenv("R_ZIPCMD", "zip") + args <- c(flags, shQuote(path.expand(zipfile)), shQuote(files), extras) + res <- invisible(suppressWarnings(system2(zip, args, stdout = NULL))) + setwd(wd) + + +} + +## Get loading files +# devtools::install_github("awalker89/openxlsx_testing_files", force = TRUE) + +## To install from CRAN +# detach("package:openxlsx", unload=TRUE) +# install.packages("openxlsx") + + +test_file_dir <- system.file(package = "openxlsx.testing.files") + +################################################################################################################ +## All Features +wb <- loadWorkbook(file.path(test_file_dir, "All_Features.xlsx")) +openXL(wb) + + +################################################################################################################ +## Budget Template +wb <- loadWorkbook(file.path(test_file_dir, "Budget.xlsx")) +openXL(wb) +openXL(file.path(test_file_dir, "Budget.xlsx")) + + + + +################################################################################################################ +## Chart Sheet +wb <- loadWorkbook(file.path(test_file_dir, "Chart_Sheet_Test.xlsx")) +openXL(wb) + + + +################################################################################################################ +## Chineses Characters +wb <- loadWorkbook(file.path(test_file_dir, "Chinese_Characters.xlsx")) +openXL(wb) + + +################################################################################################################ +## Excel Diet Template +wb <- loadWorkbook(file.path(test_file_dir, "Diet.xlsx")) +openXL(wb) +openXL(file.path(test_file_dir, "Diet.xlsx")) + +################################################################################################################ +## Empty Workbook +wb <- loadWorkbook(file.path(test_file_dir, "empty.xlsx")) +openXL(wb) + + +################################################################################################################ +## Encoding Test +wb <- loadWorkbook(file.path(test_file_dir, "Encoding_Test.xlsx")) +openXL(wb) +openXL(file.path(test_file_dir, "Encoding_Test.xlsx")) + +################################################################################################################ +## Libre Office Test File +wb <- loadWorkbook(file.path(test_file_dir, "libre_test.xlsx")) +openXL(wb) + +wb <- loadWorkbook(file.path(test_file_dir, "libre_test2.xlsx")) +openXL(wb) + + +################################################################################################################ +## Load Example Workbook +wb <- loadWorkbook(system.file("loadExample.xlsx", package = "openxlsx")) +openXL(wb) +openXL(system.file("loadExample.xlsx", package = "openxlsx")) + +################################################################################################################ +## Loading Pivot Tables +wb <- loadWorkbook(file.path(test_file_dir, "pivotTest.xlsx")) +openXL(wb) + +wb <- loadWorkbook(file.path(test_file_dir, "pivotTest2.xlsx")) +openXL(wb) + +wb <- loadWorkbook(file.path(test_file_dir, "pivotTest3.xlsx")) +openXL(wb) + + +################################################################################################################ +## Excel Template (Sales call log and organizer1.xlsx) +wb <- loadWorkbook(file.path(test_file_dir, "Sales call log and organizer1.xlsx")) +openXL(wb) + + +################################################################################################################ +## Whitespace - maintain whitespace +wb <- loadWorkbook(file.path(test_file_dir, "Whitespace_Test.xlsx")) +openXL(wb) + + +################################################################################################################ +## Weight Tracket Excel Template +wb <- loadWorkbook(file.path(test_file_dir, "WeightTrackerTemplate.xlsx")) +openXL(wb) + +################################################################################################################ +## Schedule Excel Template +wb <- loadWorkbook(file = file.path(test_file_dir, "Schedule Template.xlsx")) +openXL(wb) + + +################################################################################################################ +## package Example File +wb <- loadWorkbook(file = system.file("loadExample.xlsx", package = "openxlsx")) +openXL(wb) + + + + +## write jsuts a date +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +writeData(wb, 1, as.Date('2014-01-01')) +openXL(wb) + +wb <- loadWorkbook(file.path(test_file_dir, "pivotTest.xlsx")) +writeData(wb, 1, iris[,1:3]*100, colNames = FALSE, startRow = 2) +openXL(wb) + +openXL(file.path(test_file_dir, "pivotTest.xlsx")) + + + + + +# nolint end diff -Nru r-cran-openxlsx-4.2.4/inst/extdata/stack_style_testing.R r-cran-openxlsx-4.2.5/inst/extdata/stack_style_testing.R --- r-cran-openxlsx-4.2.4/inst/extdata/stack_style_testing.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/extdata/stack_style_testing.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,126 +1,126 @@ -# nolint start - - -require('openxlsx') - - -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -writeData(wb, 1, head(iris)) - -## What we expect -# yellow fill and bold test rows 1:2 cols 1:5 -addStyle(wb, sheet = 1, style = createStyle(fgFill = "yellow", textDecoration = "bold"), rows = 1:2, cols = 1:5, gridExpand = TRUE, stack = TRUE) - -# yellow fill and bold test rows 1:2 cols 1:5 -# red fill for row 1 and italic -addStyle(wb, sheet = 1, style = createStyle(fgFill = "red", textDecoration = "italic"), rows = 1, cols = 1:5, gridExpand = TRUE, stack = TRUE) - -# ## add a bluw line at row 5 -addStyle(wb, sheet = 1, style = createStyle(fgFill = "blue"), rows = 5, cols = 1:5, gridExpand = TRUE, stack = TRUE) ## non-intersecting - -# ## Now borders and underlined around rows 1:3 for columns 1 and 5 -addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright", textDecoration = "underline"), rows = 2:3, cols = c(1, 5), gridExpand = TRUE, stack = TRUE) -# -# ## Now blue border only on top for rows 1:3, column 1 -addStyle(wb, sheet = 1, style = createStyle(border = "top", borderColour = "blue"), rows = 1:3, cols = 1, gridExpand = TRUE, stack = TRUE) - -# -# ## no stack! Wipe all formatting and put all black borders rows 1:4, col 3 -# addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright"), rows = 1:4, cols = c(3,3,3,3), stack = FALSE) -# -# ## cell 3,3 red bottom border -# addStyle(wb, sheet = 1, style = createStyle(border = "bottom", borderColour = "red"), rows = 2:10, cols = 3, gridExpand = TRUE, stack = TRUE) - - -openXL(wb) - -wb$addStyle - - - - - - - -## Now not stacking -addWorksheet(wb, "Sheet 2") -writeData(wb, 2, matrix("abc", nrow = 4, ncol = 5)) -addStyle(wb, 2, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) -addStyle(wb, 2, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) - -## STACk == TRUE -addWorksheet(wb, "Sheet 3") -writeData(wb, 3, matrix("abc", nrow = 4, ncol = 5)) -addStyle(wb, 3, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) -addStyle(wb, 3, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) - - - -openXL(wb) - - - - - - - - - - - - - - - - - -## TEST NUMBER 2 - BUG REPORT #203 - -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -writeData(wb, 1, head(iris)) - - - -## Make a red block -addStyle(wb, sheet = 1, style = createStyle(fgFill = "red", textDecoration = "italic"), rows = c(2, 3, 4), cols = 2:5, gridExpand = TRUE, stack = TRUE) - -## Draw a yellow L around it -addStyle(wb, sheet = 1, style = createStyle(fgFill = "yellow", textDecoration = "bold"), rows = c(1,2,3,4,5,5,5,5,5), cols = c(1,1,1,1,1,2,3,4,5), gridExpand = FALSE, stack = TRUE) -# addStyle(wb, sheet = 1, style = createStyle(fgFill = "yellow", textDecoration = "bold"), rows = 5, cols = 1:5, gridExpand = TRUE, stack = TRUE) - - -## Now borders and underlined around rows 1:3 for columns 1 and 5 -addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright", textDecoration = "underline"), rows = 1:3, cols = c(1, 5), gridExpand = TRUE, stack = TRUE) - -## Now blue border only on top for rows 1:3, column 1 -addStyle(wb, sheet = 1, style = createStyle(border = "top", borderColour = "blue"), rows = 1:3, cols = 1, gridExpand = TRUE, stack = TRUE) - - -## no stack! Wipe all formatting and put all black borders rows 1:4, col 3 -addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright"), rows = 1:4, cols = c(3,3,3,3)) - -## cell 3,3 red bottom border -addStyle(wb, sheet = 1, style = createStyle(border = "bottom", borderColour = "red"), rows = 2:10, cols = 3, gridExpand = TRUE, stack = TRUE) - - - - -## Now not stacking -addWorksheet(wb, "Sheet 2") -writeData(wb, 2, matrix("abc", nrow = 4, ncol = 5)) -addStyle(wb, 2, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) -addStyle(wb, 2, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) - -## STACk == TRUE -addWorksheet(wb, "Sheet 3") -writeData(wb, 3, matrix("abc", nrow = 4, ncol = 5)) -addStyle(wb, 3, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) -addStyle(wb, 3, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) - - - -openXL(wb) - -# nolint end +# nolint start + + +require('openxlsx') + + +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +writeData(wb, 1, head(iris)) + +## What we expect +# yellow fill and bold test rows 1:2 cols 1:5 +addStyle(wb, sheet = 1, style = createStyle(fgFill = "yellow", textDecoration = "bold"), rows = 1:2, cols = 1:5, gridExpand = TRUE, stack = TRUE) + +# yellow fill and bold test rows 1:2 cols 1:5 +# red fill for row 1 and italic +addStyle(wb, sheet = 1, style = createStyle(fgFill = "red", textDecoration = "italic"), rows = 1, cols = 1:5, gridExpand = TRUE, stack = TRUE) + +# ## add a bluw line at row 5 +addStyle(wb, sheet = 1, style = createStyle(fgFill = "blue"), rows = 5, cols = 1:5, gridExpand = TRUE, stack = TRUE) ## non-intersecting + +# ## Now borders and underlined around rows 1:3 for columns 1 and 5 +addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright", textDecoration = "underline"), rows = 2:3, cols = c(1, 5), gridExpand = TRUE, stack = TRUE) +# +# ## Now blue border only on top for rows 1:3, column 1 +addStyle(wb, sheet = 1, style = createStyle(border = "top", borderColour = "blue"), rows = 1:3, cols = 1, gridExpand = TRUE, stack = TRUE) + +# +# ## no stack! Wipe all formatting and put all black borders rows 1:4, col 3 +# addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright"), rows = 1:4, cols = c(3,3,3,3), stack = FALSE) +# +# ## cell 3,3 red bottom border +# addStyle(wb, sheet = 1, style = createStyle(border = "bottom", borderColour = "red"), rows = 2:10, cols = 3, gridExpand = TRUE, stack = TRUE) + + +openXL(wb) + +wb$addStyle + + + + + + + +## Now not stacking +addWorksheet(wb, "Sheet 2") +writeData(wb, 2, matrix("abc", nrow = 4, ncol = 5)) +addStyle(wb, 2, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) +addStyle(wb, 2, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) + +## STACk == TRUE +addWorksheet(wb, "Sheet 3") +writeData(wb, 3, matrix("abc", nrow = 4, ncol = 5)) +addStyle(wb, 3, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) +addStyle(wb, 3, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) + + + +openXL(wb) + + + + + + + + + + + + + + + + + +## TEST NUMBER 2 - BUG REPORT #203 + +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +writeData(wb, 1, head(iris)) + + + +## Make a red block +addStyle(wb, sheet = 1, style = createStyle(fgFill = "red", textDecoration = "italic"), rows = c(2, 3, 4), cols = 2:5, gridExpand = TRUE, stack = TRUE) + +## Draw a yellow L around it +addStyle(wb, sheet = 1, style = createStyle(fgFill = "yellow", textDecoration = "bold"), rows = c(1,2,3,4,5,5,5,5,5), cols = c(1,1,1,1,1,2,3,4,5), gridExpand = FALSE, stack = TRUE) +# addStyle(wb, sheet = 1, style = createStyle(fgFill = "yellow", textDecoration = "bold"), rows = 5, cols = 1:5, gridExpand = TRUE, stack = TRUE) + + +## Now borders and underlined around rows 1:3 for columns 1 and 5 +addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright", textDecoration = "underline"), rows = 1:3, cols = c(1, 5), gridExpand = TRUE, stack = TRUE) + +## Now blue border only on top for rows 1:3, column 1 +addStyle(wb, sheet = 1, style = createStyle(border = "top", borderColour = "blue"), rows = 1:3, cols = 1, gridExpand = TRUE, stack = TRUE) + + +## no stack! Wipe all formatting and put all black borders rows 1:4, col 3 +addStyle(wb, sheet = 1, style = createStyle(border = "topbottomleftright"), rows = 1:4, cols = c(3,3,3,3)) + +## cell 3,3 red bottom border +addStyle(wb, sheet = 1, style = createStyle(border = "bottom", borderColour = "red"), rows = 2:10, cols = 3, gridExpand = TRUE, stack = TRUE) + + + + +## Now not stacking +addWorksheet(wb, "Sheet 2") +writeData(wb, 2, matrix("abc", nrow = 4, ncol = 5)) +addStyle(wb, 2, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) +addStyle(wb, 2, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) + +## STACk == TRUE +addWorksheet(wb, "Sheet 3") +writeData(wb, 3, matrix("abc", nrow = 4, ncol = 5)) +addStyle(wb, 3, createStyle(halign = "center", border = "TopBottomLeftRight"), 1:5, 1:5, gridExpand = TRUE) +addStyle(wb, 3, createStyle(textDecoration = "bold", fgFill = "salmon"), 2:4, 2:4,gridExpand = F, stack = TRUE) + + + +openXL(wb) + +# nolint end diff -Nru r-cran-openxlsx-4.2.4/inst/WORDLIST r-cran-openxlsx-4.2.5/inst/WORDLIST --- r-cran-openxlsx-4.2.4/inst/WORDLIST 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/inst/WORDLIST 2021-12-13 08:14:43.000000000 +0000 @@ -1,38 +1,129 @@ -args -CMD -config -cran -cron -deps -dev -dir -env -eval -gcc -github -hashFiles -https -LIBS -linux -macOS -os -packagemanager -pandoc -pkgs -rcmdcheck -Rds -RHUB -Rscript -rspm -RSPM -rstudiopm -saveRDS -sessioninfo -sudo -sysreq -sysreqs -testthat -tinytex -ubuntu -xenial -YAML +appreci +args +artMS +aut +Barbone +baseXML +bibliometrix +bochum +borderFunctions +Braglia +BugReports +cbaf +chartsheet +CHRONOS +CMD +CNVPanelizer +CommentClass +config +cran +cre +cron +ctb +ctype +DAPAR +ddPCRclust +de +deps +dev +dir +emdi +env +eval +fedup +fontSizeLookupTables +fs +garbuszus +Garbuszus +gcc +GHshiny +github +gmail +grDevices +hashFiles +helperFunctions +https +hypeR +hypeR’ +HyperlinkClass +io +isoreader +jan +jmbarbone +knitr +LIBS +LinkingTo +linux +loadWorkbook +LTS +Luca +macOS +maEndToEnd +MatrixQCvis +MicroSEC +nanotatoR +onUnload +openXL +openxlsx +openxlsxCoerce +ORCID +os +packagemanager +pandoc +philipp +Philipp +pkgs +PloGO +rbiom +rcmdcheck +Rcpp +RcppExports +Rds +readWorkbook +Revdeps +RHUB +rmarkdown +roxygen +RoxygenNote +Rscript +rspm +RSPM +rstudiopm +ruhr +sangeranalyseR +saveRDS +schauberger +Schauberger +sessioninfo +SEtools +sigFeature +stplanr +stringi +struct +structToolbox +Sturm +StyleClass +sudo +sysreq +sysreqs +TarSeqQC +testthat +tinytex +TPP +tz +ubuntu +ui +uncoverappLib +upstartr +VignetteBuilder +WorkbookClass +writeData +writeDataTable +writexlsx +xenial +XLConnect +xlsx +YAML +ycphs +zzz +Δ diff -Nru r-cran-openxlsx-4.2.4/LICENSE r-cran-openxlsx-4.2.5/LICENSE --- r-cran-openxlsx-4.2.4/LICENSE 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/LICENSE 2021-12-13 08:14:43.000000000 +0000 @@ -1,2 +1,2 @@ -YEAR: 2014-2018 -COPYRIGHT HOLDER: Alexander Walker +YEAR: 2014-2021 +COPYRIGHT HOLDER: openxlsx authors diff -Nru r-cran-openxlsx-4.2.4/man/activeSheet.Rd r-cran-openxlsx-4.2.5/man/activeSheet.Rd --- r-cran-openxlsx-4.2.4/man/activeSheet.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/activeSheet.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,38 +1,38 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{activeSheet} -\alias{activeSheet} -\alias{activeSheet<-} -\title{Get/set active sheet of the workbook} -\usage{ -activeSheet(wb) - -activeSheet(wb) <- value -} -\arguments{ -\item{wb}{A workbook object} - -\item{value}{index of the active sheet or name of the active sheet} -} -\value{ -return the active sheet of the workbook -} -\description{ -Get and set active sheet of the workbook -} -\examples{ - -wb <- createWorkbook() -addWorksheet(wb, sheetName = "S1") -addWorksheet(wb, sheetName = "S2") -addWorksheet(wb, sheetName = "S3") - -activeSheet(wb) # default value is the first sheet active -activeSheet(wb) <- 1 ## active sheet S1 -activeSheet(wb) -activeSheet(wb) <- "S2" ## active sheet S2 -activeSheet(wb) -} -\author{ -Philipp Schauberger -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{activeSheet} +\alias{activeSheet} +\alias{activeSheet<-} +\title{Get/set active sheet of the workbook} +\usage{ +activeSheet(wb) + +activeSheet(wb) <- value +} +\arguments{ +\item{wb}{A workbook object} + +\item{value}{index of the active sheet or name of the active sheet} +} +\value{ +return the active sheet of the workbook +} +\description{ +Get and set active sheet of the workbook +} +\examples{ + +wb <- createWorkbook() +addWorksheet(wb, sheetName = "S1") +addWorksheet(wb, sheetName = "S2") +addWorksheet(wb, sheetName = "S3") + +activeSheet(wb) # default value is the first sheet active +activeSheet(wb) <- 1 ## active sheet S1 +activeSheet(wb) +activeSheet(wb) <- "S2" ## active sheet S2 +activeSheet(wb) +} +\author{ +Philipp Schauberger +} diff -Nru r-cran-openxlsx-4.2.4/man/addCreator.Rd r-cran-openxlsx-4.2.5/man/addCreator.Rd --- r-cran-openxlsx-4.2.4/man/addCreator.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/addCreator.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,24 +1,24 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{addCreator} -\alias{addCreator} -\title{Add another author to the meta data of the file.} -\usage{ -addCreator(wb, Creator) -} -\arguments{ -\item{wb}{A workbook object} - -\item{Creator}{A string object with the name of the creator} -} -\description{ -Just a wrapper of wb$addCreator() -} -\examples{ - -wb <- createWorkbook() -addCreator(wb, "test") -} -\author{ -Philipp Schauberger -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{addCreator} +\alias{addCreator} +\title{Add another author to the meta data of the file.} +\usage{ +addCreator(wb, Creator) +} +\arguments{ +\item{wb}{A workbook object} + +\item{Creator}{A string object with the name of the creator} +} +\description{ +Just a wrapper of wb$addCreator() +} +\examples{ + +wb <- createWorkbook() +addCreator(wb, "test") +} +\author{ +Philipp Schauberger +} diff -Nru r-cran-openxlsx-4.2.4/man/addFilter.Rd r-cran-openxlsx-4.2.5/man/addFilter.Rd --- r-cran-openxlsx-4.2.4/man/addFilter.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/addFilter.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,48 +1,48 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{addFilter} -\alias{addFilter} -\title{Add column filters} -\usage{ -addFilter(wb, sheet, rows, cols) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{rows}{A row number.} - -\item{cols}{columns to add filter to.} -} -\description{ -Add excel column filters to a worksheet -} -\details{ -adds filters to worksheet columns, same as filter parameters in writeData. -writeDataTable automatically adds filters to first row of a table. -NOTE Can only have a single filter per worksheet unless using tables. -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2") -addWorksheet(wb, "Sheet 3") - -writeData(wb, 1, iris) -addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) - -## Equivalently -writeData(wb, 2, x = iris, withFilter = TRUE) - -## Similarly -writeDataTable(wb, 3, iris) -\dontrun{ -saveWorkbook(wb, file = "addFilterExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{writeData}} - -\code{\link{addFilter}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{addFilter} +\alias{addFilter} +\title{Add column filters} +\usage{ +addFilter(wb, sheet, rows, cols) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{rows}{A row number.} + +\item{cols}{columns to add filter to.} +} +\description{ +Add excel column filters to a worksheet +} +\details{ +adds filters to worksheet columns, same as filter parameters in writeData. +writeDataTable automatically adds filters to first row of a table. +NOTE Can only have a single filter per worksheet unless using tables. +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2") +addWorksheet(wb, "Sheet 3") + +writeData(wb, 1, iris) +addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) + +## Equivalently +writeData(wb, 2, x = iris, withFilter = TRUE) + +## Similarly +writeDataTable(wb, 3, iris) +\dontrun{ +saveWorkbook(wb, file = "addFilterExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=writeData]{writeData()}} + +\code{\link[=addFilter]{addFilter()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/addStyle.Rd r-cran-openxlsx-4.2.5/man/addStyle.Rd --- r-cran-openxlsx-4.2.4/man/addStyle.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/addStyle.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,61 +1,61 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{addStyle} -\alias{addStyle} -\title{Add a style to a set of cells} -\usage{ -addStyle(wb, sheet, style, rows, cols, gridExpand = FALSE, stack = FALSE) -} -\arguments{ -\item{wb}{A Workbook object containing a worksheet.} - -\item{sheet}{A worksheet to apply the style to.} - -\item{style}{A style object returned from createStyle()} - -\item{rows}{Rows to apply style to.} - -\item{cols}{columns to apply style to.} - -\item{gridExpand}{If \code{TRUE}, style will be applied to all combinations of rows and cols.} - -\item{stack}{If \code{TRUE} the new style is merged with any existing cell styles. If FALSE, any -existing style is replaced by the new style.} -} -\description{ -Function adds a style to a specified set of cells. -} -\examples{ -## See package vignette for more examples. - -## Create a new workbook -wb <- createWorkbook("My name here") - -## Add a worksheets -addWorksheet(wb, "Expenditure", gridLines = FALSE) - -## write data to worksheet 1 -writeData(wb, sheet = 1, USPersonalExpenditure, rowNames = TRUE) - -## create and add a style to the column headers -headerStyle <- createStyle( - fontSize = 14, fontColour = "#FFFFFF", halign = "center", - fgFill = "#4F81BD", border = "TopBottom", borderColour = "#4F81BD" -) - -## style for body -bodyStyle <- createStyle(border = "TopBottom", borderColour = "#4F81BD") -addStyle(wb, sheet = 1, bodyStyle, rows = 2:6, cols = 1:6, gridExpand = TRUE) -setColWidths(wb, 1, cols = 1, widths = 21) ## set column width for row names column -\dontrun{ -saveWorkbook(wb, "addStyleExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{createStyle}} - -expand.grid -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{addStyle} +\alias{addStyle} +\title{Add a style to a set of cells} +\usage{ +addStyle(wb, sheet, style, rows, cols, gridExpand = FALSE, stack = FALSE) +} +\arguments{ +\item{wb}{A Workbook object containing a worksheet.} + +\item{sheet}{A worksheet to apply the style to.} + +\item{style}{A style object returned from createStyle()} + +\item{rows}{Rows to apply style to.} + +\item{cols}{columns to apply style to.} + +\item{gridExpand}{If \code{TRUE}, style will be applied to all combinations of rows and cols.} + +\item{stack}{If \code{TRUE} the new style is merged with any existing cell styles. If FALSE, any +existing style is replaced by the new style.} +} +\description{ +Function adds a style to a specified set of cells. +} +\examples{ +## See package vignette for more examples. + +## Create a new workbook +wb <- createWorkbook("My name here") + +## Add a worksheets +addWorksheet(wb, "Expenditure", gridLines = FALSE) + +## write data to worksheet 1 +writeData(wb, sheet = 1, USPersonalExpenditure, rowNames = TRUE) + +## create and add a style to the column headers +headerStyle <- createStyle( + fontSize = 14, fontColour = "#FFFFFF", halign = "center", + fgFill = "#4F81BD", border = "TopBottom", borderColour = "#4F81BD" +) + +## style for body +bodyStyle <- createStyle(border = "TopBottom", borderColour = "#4F81BD") +addStyle(wb, sheet = 1, bodyStyle, rows = 2:6, cols = 1:6, gridExpand = TRUE) +setColWidths(wb, 1, cols = 1, widths = 21) ## set column width for row names column +\dontrun{ +saveWorkbook(wb, "addStyleExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=createStyle]{createStyle()}} + +expand.grid +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/addWorksheet.Rd r-cran-openxlsx-4.2.5/man/addWorksheet.Rd --- r-cran-openxlsx-4.2.4/man/addWorksheet.Rd 2021-06-08 13:18:25.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/addWorksheet.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,127 +1,127 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{addWorksheet} -\alias{addWorksheet} -\title{Add a worksheet to a workbook} -\usage{ -addWorksheet( - wb, - sheetName, - gridLines = openxlsx_getOp("gridLines", TRUE), - tabColour = NULL, - zoom = 100, - header = openxlsx_getOp("header"), - footer = openxlsx_getOp("footer"), - evenHeader = openxlsx_getOp("evenHeader"), - evenFooter = openxlsx_getOp("evenFooter"), - firstHeader = openxlsx_getOp("firstHeader"), - firstFooter = openxlsx_getOp("firstFooter"), - visible = TRUE, - paperSize = openxlsx_getOp("paperSize", 9), - orientation = openxlsx_getOp("orientation", "portrait"), - vdpi = openxlsx_getOp("vdpi", 300), - hdpi = openxlsx_getOp("hdpi", 300) -) -} -\arguments{ -\item{wb}{A Workbook object to attach the new worksheet} - -\item{sheetName}{A name for the new worksheet} - -\item{gridLines}{A logical. If \code{FALSE}, the worksheet grid lines will be hidden.} - -\item{tabColour}{Colour of the worksheet tab. A valid colour (belonging to colours()) or a valid hex colour beginning with "#"} - -\item{zoom}{A numeric between 10 and 400. Worksheet zoom level as a percentage.} - -\item{header}{document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} - -\item{footer}{document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} - -\item{evenHeader}{document header for even pages.} - -\item{evenFooter}{document footer for even pages.} - -\item{firstHeader}{document header for first page only.} - -\item{firstFooter}{document footer for first page only.} - -\item{visible}{If FALSE, sheet is hidden else visible.} - -\item{paperSize}{An integer corresponding to a paper size. See ?pageSetup for details.} - -\item{orientation}{One of "portrait" or "landscape"} - -\item{vdpi}{Vertical DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.vdpi" = X)} - -\item{hdpi}{Horizontal DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.hdpi" = X)} -} -\value{ -XML tree -} -\description{ -Add a worksheet to a Workbook object -} -\details{ -Headers and footers can contain special tags -\itemize{ - \item{\bold{&[Page]}}{ Page number} - \item{\bold{&[Pages]}}{ Number of pages} - \item{\bold{&[Date]}}{ Current date} - \item{\bold{&[Time]}}{ Current time} - \item{\bold{&[Path]}}{ File path} - \item{\bold{&[File]}}{ File name} - \item{\bold{&[Tab]}}{ Worksheet name} -} -} -\examples{ -## Create a new workbook -wb <- createWorkbook("Fred") - -## Add 3 worksheets -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2", gridLines = FALSE) -addWorksheet(wb, "Sheet 3", tabColour = "red") -addWorksheet(wb, "Sheet 4", gridLines = FALSE, tabColour = "#4F81BD") - -## Headers and Footers -addWorksheet(wb, "Sheet 5", - header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), - footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), - evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), - evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), - firstHeader = c("TOP", "OF FIRST", "PAGE"), - firstFooter = c("BOTTOM", "OF FIRST", "PAGE") -) - -addWorksheet(wb, "Sheet 6", - header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), - footer = c("&[Path]&[File]", NA, "&[Tab]"), - firstHeader = c(NA, "Center Header of First Page", NA), - firstFooter = c(NA, "Center Footer of First Page", NA) -) - -addWorksheet(wb, "Sheet 7", - header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), - footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") -) - -addWorksheet(wb, "Sheet 8", - firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), - firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") -) - -## Need data on worksheet to see all headers and footers -writeData(wb, sheet = 5, 1:400) -writeData(wb, sheet = 6, 1:400) -writeData(wb, sheet = 7, 1:400) -writeData(wb, sheet = 8, 1:400) - -## Save workbook -\dontrun{ -saveWorkbook(wb, "addWorksheetExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{addWorksheet} +\alias{addWorksheet} +\title{Add a worksheet to a workbook} +\usage{ +addWorksheet( + wb, + sheetName, + gridLines = openxlsx_getOp("gridLines", TRUE), + tabColour = NULL, + zoom = 100, + header = openxlsx_getOp("header"), + footer = openxlsx_getOp("footer"), + evenHeader = openxlsx_getOp("evenHeader"), + evenFooter = openxlsx_getOp("evenFooter"), + firstHeader = openxlsx_getOp("firstHeader"), + firstFooter = openxlsx_getOp("firstFooter"), + visible = TRUE, + paperSize = openxlsx_getOp("paperSize", 9), + orientation = openxlsx_getOp("orientation", "portrait"), + vdpi = openxlsx_getOp("vdpi", 300), + hdpi = openxlsx_getOp("hdpi", 300) +) +} +\arguments{ +\item{wb}{A Workbook object to attach the new worksheet} + +\item{sheetName}{A name for the new worksheet} + +\item{gridLines}{A logical. If \code{FALSE}, the worksheet grid lines will be hidden.} + +\item{tabColour}{Colour of the worksheet tab. A valid colour (belonging to colours()) or a valid hex colour beginning with "#"} + +\item{zoom}{A numeric between 10 and 400. Worksheet zoom level as a percentage.} + +\item{header}{document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} + +\item{footer}{document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} + +\item{evenHeader}{document header for even pages.} + +\item{evenFooter}{document footer for even pages.} + +\item{firstHeader}{document header for first page only.} + +\item{firstFooter}{document footer for first page only.} + +\item{visible}{If FALSE, sheet is hidden else visible.} + +\item{paperSize}{An integer corresponding to a paper size. See ?pageSetup for details.} + +\item{orientation}{One of "portrait" or "landscape"} + +\item{vdpi}{Vertical DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.vdpi" = X)} + +\item{hdpi}{Horizontal DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.hdpi" = X)} +} +\value{ +XML tree +} +\description{ +Add a worksheet to a Workbook object +} +\details{ +Headers and footers can contain special tags +\itemize{ +\item{\strong{&[Page]}}{ Page number} +\item{\strong{&[Pages]}}{ Number of pages} +\item{\strong{&[Date]}}{ Current date} +\item{\strong{&[Time]}}{ Current time} +\item{\strong{&[Path]}}{ File path} +\item{\strong{&[File]}}{ File name} +\item{\strong{&[Tab]}}{ Worksheet name} +} +} +\examples{ +## Create a new workbook +wb <- createWorkbook("Fred") + +## Add 3 worksheets +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2", gridLines = FALSE) +addWorksheet(wb, "Sheet 3", tabColour = "red") +addWorksheet(wb, "Sheet 4", gridLines = FALSE, tabColour = "#4F81BD") + +## Headers and Footers +addWorksheet(wb, "Sheet 5", + header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), + footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), + evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), + evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), + firstHeader = c("TOP", "OF FIRST", "PAGE"), + firstFooter = c("BOTTOM", "OF FIRST", "PAGE") +) + +addWorksheet(wb, "Sheet 6", + header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), + footer = c("&[Path]&[File]", NA, "&[Tab]"), + firstHeader = c(NA, "Center Header of First Page", NA), + firstFooter = c(NA, "Center Footer of First Page", NA) +) + +addWorksheet(wb, "Sheet 7", + header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), + footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") +) + +addWorksheet(wb, "Sheet 8", + firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), + firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") +) + +## Need data on worksheet to see all headers and footers +writeData(wb, sheet = 5, 1:400) +writeData(wb, sheet = 6, 1:400) +writeData(wb, sheet = 7, 1:400) +writeData(wb, sheet = 8, 1:400) + +## Save workbook +\dontrun{ +saveWorkbook(wb, "addWorksheetExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/all.equal.Rd r-cran-openxlsx-4.2.5/man/all.equal.Rd --- r-cran-openxlsx-4.2.4/man/all.equal.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/all.equal.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,19 +1,19 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{all.equal} -\alias{all.equal} -\alias{all.equal.Workbook} -\title{Check equality of workbooks} -\usage{ -\method{all.equal}{Workbook}(target, current, ...) -} -\arguments{ -\item{target}{A \code{Workbook} object} - -\item{current}{A \code{Workbook} object} - -\item{...}{ignored} -} -\description{ -Check equality of workbooks -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{all.equal} +\alias{all.equal} +\alias{all.equal.Workbook} +\title{Check equality of workbooks} +\usage{ +\method{all.equal}{Workbook}(target, current, ...) +} +\arguments{ +\item{target}{A \code{Workbook} object} + +\item{current}{A \code{Workbook} object} + +\item{...}{ignored} +} +\description{ +Check equality of workbooks +} diff -Nru r-cran-openxlsx-4.2.4/man/buildWorkbook.Rd r-cran-openxlsx-4.2.5/man/buildWorkbook.Rd --- r-cran-openxlsx-4.2.4/man/buildWorkbook.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/buildWorkbook.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,48 +1,101 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/build_workbook.R -\name{buildWorkbook} -\alias{buildWorkbook} -\title{Build Workbook} -\usage{ -buildWorkbook(x, asTable = FALSE, ...) -} -\arguments{ -\item{x}{A data.frame or a (named) list of objects that can be handled by -\code{\link{writeData}} or \code{\link{writeDataTable}} to write to file} - -\item{asTable}{If \code{TRUE} will use \code{\link{writeDataTable}} rather -than \code{\link{writeData}} to write \code{x} to the file (default: -\code{FALSE})} - -\item{...}{Additional arguments passed to \code{\link{writeData}}, -\code{\link{writeDataTable}}, \code{\link{setColWidths}}} -} -\value{ -A Workbook object -} -\description{ -Build a workbook from a data.frame or named list -} -\details{ -This function can be used as shortcut to create a workbook object from a - data.frame or named list. If names are available in the list they will be - used as the worksheet names. The parameters in \code{...} are collected - and passed to \code{\link{writeData}} or \code{\link{writeDataTable}} to - initially create the Workbook objects then appropriate parameters are - passed to \code{\link{setColWidths}}. -} -\examples{ -x <- data.frame(a = 1, b = 2) -wb <- buildWorkbook(x) - -y <- list(a = x, b = x, c = x) -buildWorkbook(y, asTable = TRUE) -buildWorkbook(y, asTable = TRUE, tableStyle = "TableStyleLight8") - -} -\seealso{ -\code{\link{write.xlsx}} -} -\author{ -Jordan Mark Barbone -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/build_workbook.R +\name{buildWorkbook} +\alias{buildWorkbook} +\title{Build Workbook} +\usage{ +buildWorkbook(x, asTable = FALSE, ...) +} +\arguments{ +\item{x}{A data.frame or a (named) list of objects that can be handled by +\code{\link[=writeData]{writeData()}} or \code{\link[=writeDataTable]{writeDataTable()}} to write to file} + +\item{asTable}{If \code{TRUE} will use \code{\link[=writeDataTable]{writeDataTable()}} rather +than \code{\link[=writeData]{writeData()}} to write \code{x} to the file (default: +\code{FALSE})} + +\item{...}{Additional arguments passed to \code{\link[=writeData]{writeData()}}, +\code{\link[=writeDataTable]{writeDataTable()}}, \code{\link[=setColWidths]{setColWidths()}} (see Optional +Parameters)} +} +\value{ +A Workbook object +} +\description{ +Build a workbook from a data.frame or named list +} +\details{ +This function can be used as shortcut to create a workbook object from a +data.frame or named list. If names are available in the list they will be +used as the worksheet names. The parameters in \code{...} are collected +and passed to \code{\link[=writeData]{writeData()}} or \code{\link[=writeDataTable]{writeDataTable()}} to +initially create the Workbook objects then appropriate parameters are +passed to \code{\link[=setColWidths]{setColWidths()}}. + +columns of x with class Date or POSIXt are automatically +styled as dates and datetimes respectively. +} +\section{Optional Parameters}{ + + +\strong{createWorkbook Parameters} +\itemize{ +\item{\strong{creator}}{ A string specifying the workbook author} +} + +\strong{addWorksheet Parameters} +\itemize{ +\item{\strong{sheetName}}{ Name of the worksheet} +\item{\strong{gridLines}}{ A logical. If \code{FALSE}, the worksheet grid lines will be hidden.} +\item{\strong{tabColour}}{ Colour of the worksheet tab. A valid colour (belonging to colours()) +or a valid hex colour beginning with "#".} +\item{\strong{zoom}}{ A numeric between 10 and 400. Worksheet zoom level as a percentage.} +} + +\strong{writeData/writeDataTable Parameters} +\itemize{ +\item{\strong{startCol}}{ A vector specifying the starting column(s) to write df} +\item{\strong{startRow}}{ A vector specifying the starting row(s) to write df} +\item{\strong{xy}}{ An alternative to specifying startCol and startRow individually. +A vector of the form c(startCol, startRow)} +\item{\strong{colNames or col.names}}{ If \code{TRUE}, column names of x are written.} +\item{\strong{rowNames or row.names}}{ If \code{TRUE}, row names of x are written.} +\item{\strong{headerStyle}}{ Custom style to apply to column names.} +\item{\strong{borders}}{ Either "surrounding", "columns" or "rows" or NULL. If "surrounding", a border is drawn around the +data. If "rows", a surrounding border is drawn a border around each row. If "columns", a surrounding border is drawn with a border +between each column. If "\code{all}" all cell borders are drawn.} +\item{\strong{borderColour}}{ Colour of cell border} +\item{\strong{borderStyle}}{ Border line style.} +\item{\strong{keepNA}} {If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty. Defaults to FALSE.} +\item{\strong{na.string}} {If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel. Defaults to NULL.} +} + +\strong{freezePane Parameters} +\itemize{ +\item{\strong{firstActiveRow}} {Top row of active region to freeze pane.} +\item{\strong{firstActiveCol}} {Furthest left column of active region to freeze pane.} +\item{\strong{firstRow}} {If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2)} +\item{\strong{firstCol}} {If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2)} +} + +\strong{colWidths Parameters} +\itemize{ +\item{\strong{colWidths}} {May be a single value for all columns (or "auto"), or a list of vectors that will be recycled for each sheet (see examples)} +} +} + +\examples{ +x <- data.frame(a = 1, b = 2) +wb <- buildWorkbook(x) + +y <- list(a = x, b = x, c = x) +buildWorkbook(y, asTable = TRUE) +buildWorkbook(y, asTable = TRUE, tableStyle = "TableStyleLight8") + +} +\seealso{ +\code{\link[=write.xlsx]{write.xlsx()}} +} +\author{ +Jordan Mark Barbone +} diff -Nru r-cran-openxlsx-4.2.4/man/cloneWorksheet.Rd r-cran-openxlsx-4.2.5/man/cloneWorksheet.Rd --- r-cran-openxlsx-4.2.4/man/cloneWorksheet.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/cloneWorksheet.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,37 +1,37 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{cloneWorksheet} -\alias{cloneWorksheet} -\title{Clone a worksheet to a workbook} -\usage{ -cloneWorksheet(wb, sheetName, clonedSheet) -} -\arguments{ -\item{wb}{A Workbook object to attach the new worksheet} - -\item{sheetName}{A name for the new worksheet} - -\item{clonedSheet}{The name of the existing worksheet to be cloned.} -} -\value{ -XML tree -} -\description{ -Clone a worksheet to a Workbook object -} -\examples{ -## Create a new workbook -wb <- createWorkbook("Fred") - -## Add 3 worksheets -addWorksheet(wb, "Sheet 1") -cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") - -## Save workbook -\dontrun{ -saveWorkbook(wb, "cloneWorksheetExample.xlsx", overwrite = TRUE) -} -} -\author{ -Reinhold Kainhofer -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{cloneWorksheet} +\alias{cloneWorksheet} +\title{Clone a worksheet to a workbook} +\usage{ +cloneWorksheet(wb, sheetName, clonedSheet) +} +\arguments{ +\item{wb}{A Workbook object to attach the new worksheet} + +\item{sheetName}{A name for the new worksheet} + +\item{clonedSheet}{The name of the existing worksheet to be cloned.} +} +\value{ +XML tree +} +\description{ +Clone a worksheet to a Workbook object +} +\examples{ +## Create a new workbook +wb <- createWorkbook("Fred") + +## Add 3 worksheets +addWorksheet(wb, "Sheet 1") +cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") + +## Save workbook +\dontrun{ +saveWorkbook(wb, "cloneWorksheetExample.xlsx", overwrite = TRUE) +} +} +\author{ +Reinhold Kainhofer +} diff -Nru r-cran-openxlsx-4.2.4/man/col2int.Rd r-cran-openxlsx-4.2.5/man/col2int.Rd --- r-cran-openxlsx-4.2.4/man/col2int.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/col2int.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{col2int} +\alias{col2int} +\title{Convert Excel column to integer} +\usage{ +col2int(x) +} +\arguments{ +\item{x}{A character vector} +} +\description{ +Converts an Excel column label to an integer. +} +\examples{ +col2int(LETTERS) +} diff -Nru r-cran-openxlsx-4.2.4/man/conditionalFormat.Rd r-cran-openxlsx-4.2.5/man/conditionalFormat.Rd --- r-cran-openxlsx-4.2.4/man/conditionalFormat.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/conditionalFormat.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,47 +1,47 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{conditionalFormat} -\alias{conditionalFormat} -\title{Add conditional formatting to cells} -\usage{ -conditionalFormat( - wb, - sheet, - cols, - rows, - rule = NULL, - style = NULL, - type = "expression" -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Columns to apply conditional formatting to} - -\item{rows}{Rows to apply conditional formatting to} - -\item{rule}{The condition under which to apply the formatting or a vector of colours. See examples.} - -\item{style}{A style to apply to those cells that satisfy the rule. A Style object returned from createStyle()} - -\item{type}{Either 'expression', 'colorscale' or 'databar'. If 'expression' the formatting is determined -by a formula. If colorScale cells are coloured based on cell value. See examples.} -} -\description{ -DEPRECATED! USE \code{\link{conditionalFormatting}} -} -\details{ -DEPRECATED! USE \code{\link{conditionalFormatting}} - -Valid operators are "<", "<=", ">", ">=", "==", "!=". See Examples. -Default style given by: createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -} -\seealso{ -\code{\link{createStyle}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{conditionalFormat} +\alias{conditionalFormat} +\title{Add conditional formatting to cells} +\usage{ +conditionalFormat( + wb, + sheet, + cols, + rows, + rule = NULL, + style = NULL, + type = "expression" +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Columns to apply conditional formatting to} + +\item{rows}{Rows to apply conditional formatting to} + +\item{rule}{The condition under which to apply the formatting or a vector of colours. See examples.} + +\item{style}{A style to apply to those cells that satisfy the rule. A Style object returned from createStyle()} + +\item{type}{Either 'expression', 'colorscale' or 'databar'. If 'expression' the formatting is determined +by a formula. If colorScale cells are coloured based on cell value. See examples.} +} +\description{ +DEPRECATED! USE \code{\link[=conditionalFormatting]{conditionalFormatting()}} +} +\details{ +DEPRECATED! USE \code{\link[=conditionalFormatting]{conditionalFormatting()}} + +Valid operators are "<", "<=", ">", ">=", "==", "!=". See Examples. +Default style given by: createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +} +\seealso{ +\code{\link[=createStyle]{createStyle()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/conditionalFormatting.Rd r-cran-openxlsx-4.2.5/man/conditionalFormatting.Rd --- r-cran-openxlsx-4.2.4/man/conditionalFormatting.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/conditionalFormatting.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,313 +1,313 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/conditional_formatting.R -\name{conditionalFormatting} -\alias{conditionalFormatting} -\alias{databar} -\title{Add conditional formatting to cells} -\usage{ -conditionalFormatting( - wb, - sheet, - cols, - rows, - rule = NULL, - style = NULL, - type = "expression", - ... -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Columns to apply conditional formatting to} - -\item{rows}{Rows to apply conditional formatting to} - -\item{rule}{The condition under which to apply the formatting. See examples.} - -\item{style}{A style to apply to those cells that satisfy the rule. Default is createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")} - -\item{type}{Either 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', -'endsWith', 'topN', 'bottomN', 'contains' or 'notContains' (case insensitive).} - -\item{...}{See below} -} -\description{ -Add conditional formatting to cells -} -\details{ -See Examples. - -If type == "expression" -\itemize{ - \item{style is a Style object. See \code{\link{createStyle}}} - \item{rule is an expression. Valid operators are "<", "<=", ">", ">=", "==", "!=".} -} - -If type == "colourScale" -\itemize{ - \item{style is a vector of colours with length 2 or 3} - \item{rule can be NULL or a vector of colours of equal length to styles} -} - -If type == "databar" -\itemize{ - \item{style is a vector of colours with length 2 or 3} - \item{rule is a numeric vector specifying the range of the databar colours. Must be equal length to style} - \item{... - \itemize{ - \item{\bold{showvalue} If FALSE the cell value is hidden. Default TRUE.} - \item{\bold{gradient} If FALSE colour gradient is removed. Default TRUE.} - \item{\bold{border} If FALSE the border around the database is hidden. Default TRUE.} - } - } -} - -If type == "duplicates" -\itemize{ - \item{style is a Style object. See \code{\link{createStyle}}} - \item{rule is ignored.} -} - -If type == "contains" -\itemize{ - \item{style is a Style object. See \code{\link{createStyle}}} - \item{rule is the text to look for within cells} -} - -If type == "between" -\itemize{ - \item{style is a Style object. See \code{\link{createStyle}}} - \item{rule is a numeric vector of length 2 specifying lower and upper bound (Inclusive)} -} - -If type == "topN" -\itemize{ - \item{style is a Style object. See \code{\link{createStyle}}} - \item{rule is ignored} - \item{... - \itemize{ - \item{\bold{rank} numeric vector of length 1 indicating number of highest values.} - \item{\bold{percent} TRUE if you want top N percentage.} - } - } -} - -If type == "bottomN" -\itemize{ - \item{style is a Style object. See \code{\link{createStyle}}} - \item{rule is ignored} - \item{... - \itemize{ - \item{\bold{rank} numeric vector of length 1 indicating number of lowest values.} - \item{\bold{percent} TRUE if you want bottom N percentage.} - } - } -} -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "cellIs") -addWorksheet(wb, "Moving Row") -addWorksheet(wb, "Moving Col") -addWorksheet(wb, "Dependent on") -addWorksheet(wb, "Duplicates") -addWorksheet(wb, "containsText") -addWorksheet(wb, "notcontainsText") -addWorksheet(wb, "beginsWith") -addWorksheet(wb, "endsWith") -addWorksheet(wb, "colourScale", zoom = 30) -addWorksheet(wb, "databar") -addWorksheet(wb, "between") -addWorksheet(wb, "topN") -addWorksheet(wb, "bottomN") -addWorksheet(wb, "logical operators") - -negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") - -## rule applies to all each cell in range -writeData(wb, "cellIs", -5:5) -writeData(wb, "cellIs", LETTERS[1:11], startCol = 2) -conditionalFormatting(wb, "cellIs", - cols = 1, - rows = 1:11, rule = "!=0", style = negStyle -) -conditionalFormatting(wb, "cellIs", - cols = 1, - rows = 1:11, rule = "==0", style = posStyle -) - -## highlight row dependent on first cell in row -writeData(wb, "Moving Row", -5:5) -writeData(wb, "Moving Row", LETTERS[1:11], startCol = 2) -conditionalFormatting(wb, "Moving Row", - cols = 1:2, - rows = 1:11, rule = "$A1<0", style = negStyle -) -conditionalFormatting(wb, "Moving Row", - cols = 1:2, - rows = 1:11, rule = "$A1>0", style = posStyle -) - -## highlight column dependent on first cell in column -writeData(wb, "Moving Col", -5:5) -writeData(wb, "Moving Col", LETTERS[1:11], startCol = 2) -conditionalFormatting(wb, "Moving Col", - cols = 1:2, - rows = 1:11, rule = "A$1<0", style = negStyle -) -conditionalFormatting(wb, "Moving Col", - cols = 1:2, - rows = 1:11, rule = "A$1>0", style = posStyle -) - -## highlight entire range cols X rows dependent only on cell A1 -writeData(wb, "Dependent on", -5:5) -writeData(wb, "Dependent on", LETTERS[1:11], startCol = 2) -conditionalFormatting(wb, "Dependent on", - cols = 1:2, - rows = 1:11, rule = "$A$1<0", style = negStyle -) -conditionalFormatting(wb, "Dependent on", - cols = 1:2, - rows = 1:11, rule = "$A$1>0", style = posStyle -) - -## highlight cells in column 1 based on value in column 2 -writeData(wb, "Dependent on", data.frame(x = 1:10, y = runif(10)), startRow = 15) -conditionalFormatting(wb, "Dependent on", - cols = 1, - rows = 16:25, rule = "B16<0.5", style = negStyle -) -conditionalFormatting(wb, "Dependent on", - cols = 1, - rows = 16:25, rule = "B16>=0.5", style = posStyle -) - - -## highlight duplicates using default style -writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) -conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") - -## cells containing text -fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -writeData(wb, "containsText", sapply(1:10, fn)) -conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") - -## cells not containing text -fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -writeData(wb, "containsText", sapply(1:10, fn)) -conditionalFormatting(wb, "notcontainsText", cols = 1, - rows = 1:10, type = "notcontains", rule = "A") - - -## cells begins with text -fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -writeData(wb, "beginsWith", sapply(1:100, fn)) -conditionalFormatting(wb, "beginsWith", cols = 1, rows = 1:100, type = "beginsWith", rule = "A") - - -## cells ends with text -fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -writeData(wb, "endsWith", sapply(1:100, fn)) -conditionalFormatting(wb, "endsWith", cols = 1, rows = 1:100, type = "endsWith", rule = "A") - -## colourscale colours cells based on cell value -df <- read.xlsx(system.file("extdata", "readTest.xlsx", package = "openxlsx"), sheet = 4) -writeData(wb, "colourScale", df, colNames = FALSE) ## write data.frame - -## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) -## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. -conditionalFormatting(wb, "colourScale", - cols = 1:ncol(df), rows = 1:nrow(df), - style = c("black", "white"), - rule = c(0, 255), - type = "colourScale" -) - -setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) -setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) - -## Databars -writeData(wb, "databar", -5:5) -conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Default colours - -## Between -# Highlight cells in interval [-2, 2] -writeData(wb, "between", -5:5) -conditionalFormatting(wb, "between", cols = 1, rows = 1:11, type = "between", rule = c(-2, 2)) - -## Top N -writeData(wb, "topN", data.frame(x = 1:10, y = rnorm(10))) -# Highlight top 5 values in column x -conditionalFormatting(wb, "topN", cols = 1, rows = 2:11, - style = posStyle, type = "topN", rank = 5)#' -# Highlight top 20 percentage in column y -conditionalFormatting(wb, "topN", cols = 2, rows = 2:11, - style = posStyle, type = "topN", rank = 20, percent = TRUE) - -## Bottom N -writeData(wb, "bottomN", data.frame(x = 1:10, y = rnorm(10))) -# Highlight bottom 5 values in column x -conditionalFormatting(wb, "bottomN", cols = 1, rows = 2:11, - style = negStyle, type = "topN", rank = 5) -# Highlight bottom 20 percentage in column y -conditionalFormatting(wb, "bottomN", cols = 2, rows = 2:11, - style = negStyle, type = "topN", rank = 20, percent = TRUE) - -## Logical Operators -# You can use Excels logical Operators -writeData(wb, "logical operators", 1:10) -conditionalFormatting(wb, "logical operators", - cols = 1, rows = 1:10, - rule = "OR($A1=1,$A1=3,$A1=5,$A1=7)" -) -\dontrun{ -saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) -} - - -######################################################################### -## Databar Example - -wb <- createWorkbook() -addWorksheet(wb, "databar") - -## Databars -writeData(wb, "databar", -5:5, startCol = 1) -conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Defaults - -writeData(wb, "databar", -5:5, startCol = 3) -conditionalFormatting(wb, "databar", cols = 3, rows = 1:11, type = "databar", border = FALSE) - -writeData(wb, "databar", -5:5, startCol = 5) -conditionalFormatting(wb, "databar", - cols = 5, rows = 1:11, - type = "databar", style = c("#a6a6a6"), showValue = FALSE -) - -writeData(wb, "databar", -5:5, startCol = 7) -conditionalFormatting(wb, "databar", - cols = 7, rows = 1:11, - type = "databar", style = c("#a6a6a6"), showValue = FALSE, gradient = FALSE -) - -writeData(wb, "databar", -5:5, startCol = 9) -conditionalFormatting(wb, "databar", - cols = 9, rows = 1:11, - type = "databar", style = c("#a6a6a6", "#a6a6a6"), showValue = FALSE, gradient = FALSE -) -\dontrun{ -saveWorkbook(wb, file = "databarExample.xlsx", overwrite = TRUE) -} - -} -\seealso{ -\code{\link{createStyle}} -} -\author{ -Alexander Walker, Philipp Schauberger -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conditional_formatting.R +\name{conditionalFormatting} +\alias{conditionalFormatting} +\alias{databar} +\title{Add conditional formatting to cells} +\usage{ +conditionalFormatting( + wb, + sheet, + cols, + rows, + rule = NULL, + style = NULL, + type = "expression", + ... +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Columns to apply conditional formatting to} + +\item{rows}{Rows to apply conditional formatting to} + +\item{rule}{The condition under which to apply the formatting. See examples.} + +\item{style}{A style to apply to those cells that satisfy the rule. Default is createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")} + +\item{type}{Either 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', +'endsWith', 'topN', 'bottomN', 'contains' or 'notContains' (case insensitive).} + +\item{...}{See below} +} +\description{ +Add conditional formatting to cells +} +\details{ +See Examples. + +If type == "expression" +\itemize{ +\item{style is a Style object. See \code{\link[=createStyle]{createStyle()}}} +\item{rule is an expression. Valid operators are "<", "<=", ">", ">=", "==", "!=".} +} + +If type == "colourScale" +\itemize{ +\item{style is a vector of colours with length 2 or 3} +\item{rule can be NULL or a vector of colours of equal length to styles} +} + +If type == "databar" +\itemize{ +\item{style is a vector of colours with length 2 or 3} +\item{rule is a numeric vector specifying the range of the databar colours. Must be equal length to style} +\item{... +\itemize{ +\item{\strong{showvalue} If FALSE the cell value is hidden. Default TRUE.} +\item{\strong{gradient} If FALSE colour gradient is removed. Default TRUE.} +\item{\strong{border} If FALSE the border around the database is hidden. Default TRUE.} +} +} +} + +If type == "duplicates" +\itemize{ +\item{style is a Style object. See \code{\link[=createStyle]{createStyle()}}} +\item{rule is ignored.} +} + +If type == "contains" +\itemize{ +\item{style is a Style object. See \code{\link[=createStyle]{createStyle()}}} +\item{rule is the text to look for within cells} +} + +If type == "between" +\itemize{ +\item{style is a Style object. See \code{\link[=createStyle]{createStyle()}}} +\item{rule is a numeric vector of length 2 specifying lower and upper bound (Inclusive)} +} + +If type == "topN" +\itemize{ +\item{style is a Style object. See \code{\link[=createStyle]{createStyle()}}} +\item{rule is ignored} +\item{... +\itemize{ +\item{\strong{rank} numeric vector of length 1 indicating number of highest values.} +\item{\strong{percent} TRUE if you want top N percentage.} +} +} +} + +If type == "bottomN" +\itemize{ +\item{style is a Style object. See \code{\link[=createStyle]{createStyle()}}} +\item{rule is ignored} +\item{... +\itemize{ +\item{\strong{rank} numeric vector of length 1 indicating number of lowest values.} +\item{\strong{percent} TRUE if you want bottom N percentage.} +} +} +} +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "cellIs") +addWorksheet(wb, "Moving Row") +addWorksheet(wb, "Moving Col") +addWorksheet(wb, "Dependent on") +addWorksheet(wb, "Duplicates") +addWorksheet(wb, "containsText") +addWorksheet(wb, "notcontainsText") +addWorksheet(wb, "beginsWith") +addWorksheet(wb, "endsWith") +addWorksheet(wb, "colourScale", zoom = 30) +addWorksheet(wb, "databar") +addWorksheet(wb, "between") +addWorksheet(wb, "topN") +addWorksheet(wb, "bottomN") +addWorksheet(wb, "logical operators") + +negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") + +## rule applies to all each cell in range +writeData(wb, "cellIs", -5:5) +writeData(wb, "cellIs", LETTERS[1:11], startCol = 2) +conditionalFormatting(wb, "cellIs", + cols = 1, + rows = 1:11, rule = "!=0", style = negStyle +) +conditionalFormatting(wb, "cellIs", + cols = 1, + rows = 1:11, rule = "==0", style = posStyle +) + +## highlight row dependent on first cell in row +writeData(wb, "Moving Row", -5:5) +writeData(wb, "Moving Row", LETTERS[1:11], startCol = 2) +conditionalFormatting(wb, "Moving Row", + cols = 1:2, + rows = 1:11, rule = "$A1<0", style = negStyle +) +conditionalFormatting(wb, "Moving Row", + cols = 1:2, + rows = 1:11, rule = "$A1>0", style = posStyle +) + +## highlight column dependent on first cell in column +writeData(wb, "Moving Col", -5:5) +writeData(wb, "Moving Col", LETTERS[1:11], startCol = 2) +conditionalFormatting(wb, "Moving Col", + cols = 1:2, + rows = 1:11, rule = "A$1<0", style = negStyle +) +conditionalFormatting(wb, "Moving Col", + cols = 1:2, + rows = 1:11, rule = "A$1>0", style = posStyle +) + +## highlight entire range cols X rows dependent only on cell A1 +writeData(wb, "Dependent on", -5:5) +writeData(wb, "Dependent on", LETTERS[1:11], startCol = 2) +conditionalFormatting(wb, "Dependent on", + cols = 1:2, + rows = 1:11, rule = "$A$1<0", style = negStyle +) +conditionalFormatting(wb, "Dependent on", + cols = 1:2, + rows = 1:11, rule = "$A$1>0", style = posStyle +) + +## highlight cells in column 1 based on value in column 2 +writeData(wb, "Dependent on", data.frame(x = 1:10, y = runif(10)), startRow = 15) +conditionalFormatting(wb, "Dependent on", + cols = 1, + rows = 16:25, rule = "B16<0.5", style = negStyle +) +conditionalFormatting(wb, "Dependent on", + cols = 1, + rows = 16:25, rule = "B16>=0.5", style = posStyle +) + + +## highlight duplicates using default style +writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) +conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") + +## cells containing text +fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +writeData(wb, "containsText", sapply(1:10, fn)) +conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") + +## cells not containing text +fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +writeData(wb, "containsText", sapply(1:10, fn)) +conditionalFormatting(wb, "notcontainsText", cols = 1, + rows = 1:10, type = "notcontains", rule = "A") + + +## cells begins with text +fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +writeData(wb, "beginsWith", sapply(1:100, fn)) +conditionalFormatting(wb, "beginsWith", cols = 1, rows = 1:100, type = "beginsWith", rule = "A") + + +## cells ends with text +fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +writeData(wb, "endsWith", sapply(1:100, fn)) +conditionalFormatting(wb, "endsWith", cols = 1, rows = 1:100, type = "endsWith", rule = "A") + +## colourscale colours cells based on cell value +df <- read.xlsx(system.file("extdata", "readTest.xlsx", package = "openxlsx"), sheet = 4) +writeData(wb, "colourScale", df, colNames = FALSE) ## write data.frame + +## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) +## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. +conditionalFormatting(wb, "colourScale", + cols = 1:ncol(df), rows = 1:nrow(df), + style = c("black", "white"), + rule = c(0, 255), + type = "colourScale" +) + +setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) +setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) + +## Databars +writeData(wb, "databar", -5:5) +conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Default colours + +## Between +# Highlight cells in interval [-2, 2] +writeData(wb, "between", -5:5) +conditionalFormatting(wb, "between", cols = 1, rows = 1:11, type = "between", rule = c(-2, 2)) + +## Top N +writeData(wb, "topN", data.frame(x = 1:10, y = rnorm(10))) +# Highlight top 5 values in column x +conditionalFormatting(wb, "topN", cols = 1, rows = 2:11, + style = posStyle, type = "topN", rank = 5)#' +# Highlight top 20 percentage in column y +conditionalFormatting(wb, "topN", cols = 2, rows = 2:11, + style = posStyle, type = "topN", rank = 20, percent = TRUE) + +## Bottom N +writeData(wb, "bottomN", data.frame(x = 1:10, y = rnorm(10))) +# Highlight bottom 5 values in column x +conditionalFormatting(wb, "bottomN", cols = 1, rows = 2:11, + style = negStyle, type = "topN", rank = 5) +# Highlight bottom 20 percentage in column y +conditionalFormatting(wb, "bottomN", cols = 2, rows = 2:11, + style = negStyle, type = "topN", rank = 20, percent = TRUE) + +## Logical Operators +# You can use Excels logical Operators +writeData(wb, "logical operators", 1:10) +conditionalFormatting(wb, "logical operators", + cols = 1, rows = 1:10, + rule = "OR($A1=1,$A1=3,$A1=5,$A1=7)" +) +\dontrun{ +saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) +} + + +######################################################################### +## Databar Example + +wb <- createWorkbook() +addWorksheet(wb, "databar") + +## Databars +writeData(wb, "databar", -5:5, startCol = 1) +conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Defaults + +writeData(wb, "databar", -5:5, startCol = 3) +conditionalFormatting(wb, "databar", cols = 3, rows = 1:11, type = "databar", border = FALSE) + +writeData(wb, "databar", -5:5, startCol = 5) +conditionalFormatting(wb, "databar", + cols = 5, rows = 1:11, + type = "databar", style = c("#a6a6a6"), showValue = FALSE +) + +writeData(wb, "databar", -5:5, startCol = 7) +conditionalFormatting(wb, "databar", + cols = 7, rows = 1:11, + type = "databar", style = c("#a6a6a6"), showValue = FALSE, gradient = FALSE +) + +writeData(wb, "databar", -5:5, startCol = 9) +conditionalFormatting(wb, "databar", + cols = 9, rows = 1:11, + type = "databar", style = c("#a6a6a6", "#a6a6a6"), showValue = FALSE, gradient = FALSE +) +\dontrun{ +saveWorkbook(wb, file = "databarExample.xlsx", overwrite = TRUE) +} + +} +\seealso{ +\code{\link[=createStyle]{createStyle()}} +} +\author{ +Alexander Walker, Philipp Schauberger +} diff -Nru r-cran-openxlsx-4.2.4/man/convertFromExcelRef.Rd r-cran-openxlsx-4.2.5/man/convertFromExcelRef.Rd --- r-cran-openxlsx-4.2.4/man/convertFromExcelRef.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/convertFromExcelRef.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,21 +1,21 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{convertFromExcelRef} -\alias{convertFromExcelRef} -\title{Convert excel column name to integer index} -\usage{ -convertFromExcelRef(col) -} -\arguments{ -\item{col}{An excel column reference} -} -\description{ -Convert excel column name to integer index e.g. "J" to 10 -} -\examples{ -convertFromExcelRef("DOG") -convertFromExcelRef("COW") - -## numbers will be removed -convertFromExcelRef("R22") -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{convertFromExcelRef} +\alias{convertFromExcelRef} +\title{Convert excel column name to integer index} +\usage{ +convertFromExcelRef(col) +} +\arguments{ +\item{col}{An excel column reference} +} +\description{ +Convert excel column name to integer index e.g. "J" to 10 +} +\examples{ +convertFromExcelRef("DOG") +convertFromExcelRef("COW") + +## numbers will be removed +convertFromExcelRef("R22") +} diff -Nru r-cran-openxlsx-4.2.4/man/convertToDate.Rd r-cran-openxlsx-4.2.5/man/convertToDate.Rd --- r-cran-openxlsx-4.2.4/man/convertToDate.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/convertToDate.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,29 +1,29 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{convertToDate} -\alias{convertToDate} -\title{Convert from excel date number to R Date type} -\usage{ -convertToDate(x, origin = "1900-01-01", ...) -} -\arguments{ -\item{x}{A vector of integers} - -\item{origin}{date. Default value is for Windows Excel 2010} - -\item{...}{additional parameters passed to as.Date()} -} -\description{ -Convert from excel date number to R Date type -} -\details{ -Excel stores dates as number of days from some origin day -} -\examples{ -## 2014 April 21st to 25th -convertToDate(c(41750, 41751, 41752, 41753, 41754, NA)) -convertToDate(c(41750.2, 41751.99, NA, 41753)) -} -\seealso{ -\code{\link{writeData}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{convertToDate} +\alias{convertToDate} +\title{Convert from excel date number to R Date type} +\usage{ +convertToDate(x, origin = "1900-01-01", ...) +} +\arguments{ +\item{x}{A vector of integers} + +\item{origin}{date. Default value is for Windows Excel 2010} + +\item{...}{additional parameters passed to as.Date()} +} +\description{ +Convert from excel date number to R Date type +} +\details{ +Excel stores dates as number of days from some origin day +} +\examples{ +## 2014 April 21st to 25th +convertToDate(c(41750, 41751, 41752, 41753, 41754, NA)) +convertToDate(c(41750.2, 41751.99, NA, 41753)) +} +\seealso{ +\code{\link[=writeData]{writeData()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/convertToDateTime.Rd r-cran-openxlsx-4.2.5/man/convertToDateTime.Rd --- r-cran-openxlsx-4.2.4/man/convertToDateTime.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/convertToDateTime.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,28 +1,28 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{convertToDateTime} -\alias{convertToDateTime} -\title{Convert from excel time number to R POSIXct type.} -\usage{ -convertToDateTime(x, origin = "1900-01-01", ...) -} -\arguments{ -\item{x}{A numeric vector} - -\item{origin}{date. Default value is for Windows Excel 2010} - -\item{...}{Additional parameters passed to as.POSIXct} -} -\description{ -Convert from excel time number to R POSIXct type. -} -\details{ -Excel stores dates as number of days from some origin date -} -\examples{ -## 2014-07-01, 2014-06-30, 2014-06-29 -x <- c(41821.8127314815, 41820.8127314815, NA, 41819, NaN) -convertToDateTime(x) -convertToDateTime(x, tz = "Australia/Perth") -convertToDateTime(x, tz = "UTC") -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{convertToDateTime} +\alias{convertToDateTime} +\title{Convert from excel time number to R POSIXct type.} +\usage{ +convertToDateTime(x, origin = "1900-01-01", ...) +} +\arguments{ +\item{x}{A numeric vector} + +\item{origin}{date. Default value is for Windows Excel 2010} + +\item{...}{Additional parameters passed to as.POSIXct} +} +\description{ +Convert from excel time number to R POSIXct type. +} +\details{ +Excel stores dates as number of days from some origin date +} +\examples{ +## 2014-07-01, 2014-06-30, 2014-06-29 +x <- c(41821.8127314815, 41820.8127314815, NA, 41819, NaN) +convertToDateTime(x) +convertToDateTime(x, tz = "Australia/Perth") +convertToDateTime(x, tz = "UTC") +} diff -Nru r-cran-openxlsx-4.2.4/man/copyWorkbook.Rd r-cran-openxlsx-4.2.5/man/copyWorkbook.Rd --- r-cran-openxlsx-4.2.4/man/copyWorkbook.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/copyWorkbook.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,29 +1,29 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{copyWorkbook} -\alias{copyWorkbook} -\title{Copy a Workbook object.} -\usage{ -copyWorkbook(wb) -} -\arguments{ -\item{wb}{A workbook object} -} -\value{ -Workbook -} -\description{ -Just a wrapper of wb$copy() -} -\examples{ - -wb <- createWorkbook() -wb2 <- wb ## does not create a copy -wb3 <- copyWorkbook(wb) ## wrapper for wb$copy() - -addWorksheet(wb, "Sheet1") ## adds worksheet to both wb and wb2 but not wb3 - -names(wb) -names(wb2) -names(wb3) -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{copyWorkbook} +\alias{copyWorkbook} +\title{Copy a Workbook object.} +\usage{ +copyWorkbook(wb) +} +\arguments{ +\item{wb}{A workbook object} +} +\value{ +Workbook +} +\description{ +Just a wrapper of wb$copy() +} +\examples{ + +wb <- createWorkbook() +wb2 <- wb ## does not create a copy +wb3 <- copyWorkbook(wb) ## wrapper for wb$copy() + +addWorksheet(wb, "Sheet1") ## adds worksheet to both wb and wb2 but not wb3 + +names(wb) +names(wb2) +names(wb3) +} diff -Nru r-cran-openxlsx-4.2.4/man/createComment.Rd r-cran-openxlsx-4.2.5/man/createComment.Rd --- r-cran-openxlsx-4.2.4/man/createComment.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/createComment.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,52 +1,51 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CommentClass.R -\name{createComment} -\alias{createComment} -\title{create a Comment object} -\usage{ -createComment( - comment, - author = Sys.getenv("USERNAME"), - style = NULL, - visible = TRUE, - width = 2, - height = 4 -) -} -\arguments{ -\item{comment}{Comment text. Character vector.} - -\item{author}{Author of comment. Character vector of length 1} - -\item{style}{A Style object or list of style objects the same length as comment vector. See \code{\link{createStyle}}.} - -\item{visible}{TRUE or FALSE. Is comment visible.} - -\item{width}{Textbox integer width in number of cells} - -\item{height}{Textbox integer height in number of cells} -} -\description{ -Create a cell Comment object to pass to writeComment() -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") - -c1 <- createComment(comment = "this is comment") -writeComment(wb, 1, col = "B", row = 10, comment = c1) - -s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) -s2 <- createStyle(fontSize = 9, fontColour = "black") - -c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) -c2 - -writeComment(wb, 1, col = 6, row = 3, comment = c2) -\dontrun{ -saveWorkbook(wb, file = "createCommentExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{writeComment}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CommentClass.R +\name{createComment} +\alias{createComment} +\title{create a Comment object} +\usage{ +createComment( + comment, + author = Sys.getenv("USERNAME"), + style = NULL, + visible = TRUE, + width = 2, + height = 4 +) +} +\arguments{ +\item{comment}{Comment text. Character vector.} + +\item{author}{Author of comment. Character vector of length 1} + +\item{style}{A Style object or list of style objects the same length as comment vector. See \code{\link[=createStyle]{createStyle()}}.} + +\item{visible}{TRUE or FALSE. Is comment visible.} + +\item{width, height}{Width and height of textbook (in number of cells); +doubles are rounded with \code{base::round()}} +} +\description{ +Create a cell Comment object to pass to writeComment() +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") + +c1 <- createComment(comment = "this is comment") +writeComment(wb, 1, col = "B", row = 10, comment = c1) + +s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) +s2 <- createStyle(fontSize = 9, fontColour = "black") + +c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) +c2 + +writeComment(wb, 1, col = 6, row = 3, comment = c2) +\dontrun{ +saveWorkbook(wb, file = "createCommentExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=writeComment]{writeComment()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/createNamedRegion.Rd r-cran-openxlsx-4.2.5/man/createNamedRegion.Rd --- r-cran-openxlsx-4.2.4/man/createNamedRegion.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/createNamedRegion.Rd 1970-01-01 00:00:00.000000000 +0000 @@ -1,66 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{createNamedRegion} -\alias{createNamedRegion} -\title{Create a named region.} -\usage{ -createNamedRegion(wb, sheet, cols, rows, name) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Numeric vector specifying columns to include in region} - -\item{rows}{Numeric vector specifying rows to include in region} - -\item{name}{Name for region. A character vector of length 1. Note region names musts be case-insensitive unique.} -} -\description{ -Create a named region -} -\details{ -Region is given by: min(cols):max(cols) X min(rows):max(rows) -} -\examples{ -## create named regions -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") - -## specify region -writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) -createNamedRegion( - wb = wb, - sheet = 1, - name = "iris", - rows = 1:(nrow(iris) + 1), - cols = 1:ncol(iris) -) - - -## using writeData 'name' argument -writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) - -out_file <- tempfile(fileext = ".xlsx") -\dontrun{ -saveWorkbook(wb, out_file, overwrite = TRUE) - -## see named regions -getNamedRegions(wb) ## From Workbook object -getNamedRegions(out_file) ## From xlsx file - -## read named regions -df <- read.xlsx(wb, namedRegion = "iris") -head(df) - -df <- read.xlsx(out_file, namedRegion = "iris2") -head(df) -} -} -\seealso{ -\code{\link{getNamedRegions}} -} -\author{ -Alexander Walker -} diff -Nru r-cran-openxlsx-4.2.4/man/createStyle.Rd r-cran-openxlsx-4.2.5/man/createStyle.Rd --- r-cran-openxlsx-4.2.4/man/createStyle.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/createStyle.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,169 +1,172 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{createStyle} -\alias{createStyle} -\title{Create a cell style} -\usage{ -createStyle( - fontName = NULL, - fontSize = NULL, - fontColour = NULL, - numFmt = openxlsx_getOp("numFmt", "GENERAL"), - border = NULL, - borderColour = openxlsx_getOp("borderColour", "black"), - borderStyle = openxlsx_getOp("borderStyle", "thin"), - bgFill = NULL, - fgFill = NULL, - halign = NULL, - valign = NULL, - textDecoration = NULL, - wrapText = FALSE, - textRotation = NULL, - indent = NULL, - locked = NULL, - hidden = NULL -) -} -\arguments{ -\item{fontName}{A name of a font. Note the font name is not validated. If fontName is NULL, -the workbook base font is used. (Defaults to Calibri)} - -\item{fontSize}{Font size. A numeric greater than 0. -If fontSize is NULL, the workbook base font size is used. (Defaults to 11)} - -\item{fontColour}{Colour of text in cell. A valid hex colour beginning with "#" -or one of colours(). If fontColour is NULL, the workbook base font colours is used. -(Defaults to black)} - -\item{numFmt}{Cell formatting -\itemize{ - \item{\bold{GENERAL}} - \item{\bold{NUMBER}} - \item{\bold{CURRENCY}} - \item{\bold{ACCOUNTING}} - \item{\bold{DATE}} - \item{\bold{LONGDATE}} - \item{\bold{TIME}} - \item{\bold{PERCENTAGE}} - \item{\bold{FRACTION}} - \item{\bold{SCIENTIFIC}} - \item{\bold{TEXT}} - \item{\bold{COMMA}{ for comma separated thousands}} - \item{For date/datetime styling a combination of d, m, y and punctuation marks} - \item{For numeric rounding use "0.00" with the preferred number of decimal places} -}} - -\item{border}{Cell border. A vector of "top", "bottom", "left", "right" or a single string). -\itemize{ - \item{\bold{"top"}}{ Top border} - \item{\bold{bottom}}{ Bottom border} - \item{\bold{left}}{ Left border} - \item{\bold{right}}{ Right border} - \item{\bold{TopBottom} or \bold{c("top", "bottom")}}{ Top and bottom border} - \item{\bold{LeftRight} or \bold{c("left", "right")}}{ Left and right border} - \item{\bold{TopLeftRight} or \bold{c("top", "left", "right")}}{ Top, Left and right border} - \item{\bold{TopBottomLeftRight} or \bold{c("top", "bottom", "left", "right")}}{ All borders} - }} - -\item{borderColour}{Colour of cell border vector the same length as the number of sides specified in "border" -A valid colour (belonging to colours()) or a valid hex colour beginning with "#"} - -\item{borderStyle}{Border line style vector the same length as the number of sides specified in "border" -\itemize{ - \item{\bold{none}}{ No Border} - \item{\bold{thin}}{ thin border} - \item{\bold{medium}}{ medium border} - \item{\bold{dashed}}{ dashed border} - \item{\bold{dotted}}{ dotted border} - \item{\bold{thick}}{ thick border} - \item{\bold{double}}{ double line border} - \item{\bold{hair}}{ Hairline border} - \item{\bold{mediumDashed}}{ medium weight dashed border} - \item{\bold{dashDot}}{ dash-dot border} - \item{\bold{mediumDashDot}}{ medium weight dash-dot border} - \item{\bold{dashDotDot}}{ dash-dot-dot border} - \item{\bold{mediumDashDotDot}}{ medium weight dash-dot-dot border} - \item{\bold{slantDashDot}}{ slanted dash-dot border} - }} - -\item{bgFill}{Cell background fill colour. -A valid colour (belonging to colours()) or a valid hex colour beginning with "#". --- \bold{Use for conditional formatting styles only.}} - -\item{fgFill}{Cell foreground fill colour. -A valid colour (belonging to colours()) or a valid hex colour beginning with "#"} - -\item{halign}{Horizontal alignment of cell contents -\itemize{ - \item{\bold{left}}{ Left horizontal align cell contents} - \item{\bold{right}}{ Right horizontal align cell contents} - \item{\bold{center}}{ Center horizontal align cell contents} - }} - -\item{valign}{A name -Vertical alignment of cell contents -\itemize{ - \item{\bold{top}}{ Top vertical align cell contents} - \item{\bold{center}}{ Center vertical align cell contents} - \item{\bold{bottom}}{ Bottom vertical align cell contents} - }} - -\item{textDecoration}{Text styling. -\itemize{ - \item{\bold{bold}}{ Bold cell contents} - \item{\bold{strikeout}}{ Strikeout cell contents} - \item{\bold{italic}}{ Italicise cell contents} - \item{\bold{underline}}{ Underline cell contents} - \item{\bold{underline2}}{ Double underline cell contents} - }} - -\item{wrapText}{Logical. If \code{TRUE} cell contents will wrap to fit in column.} - -\item{textRotation}{Rotation of text in degrees. 255 for vertical text.} - -\item{indent}{Horizontal indentation of cell contents.} - -\item{locked}{Whether cell contents are locked (if worksheet protection is turned on)} - -\item{hidden}{Whether the formula of the cell contents will be hidden (if worksheet protection is turned on)} -} -\value{ -A style object -} -\description{ -Create a new style to apply to worksheet cells -} -\examples{ -## See package vignettes for further examples - -## Modify default values of border colour and border line style -options("openxlsx.borderColour" = "#4F80BD") -options("openxlsx.borderStyle" = "thin") - -## Size 18 Arial, Bold, left horz. aligned, fill colour #1A33CC, all borders, -style <- createStyle( - fontSize = 18, fontName = "Arial", - textDecoration = "bold", halign = "left", fgFill = "#1A33CC", border = "TopBottomLeftRight" -) - -## Red, size 24, Bold, italic, underline, center aligned Font, bottom border -style <- createStyle( - fontSize = 24, fontColour = rgb(1, 0, 0), - textDecoration = c("bold", "italic", "underline"), - halign = "center", valign = "center", border = "Bottom" -) - -# borderColour is recycled for each border or all colours can be supplied - -# colour is recycled 3 times for "Top", "Bottom" & "Right" sides. -createStyle(border = "TopBottomRight", borderColour = "red") - -# supply all colours -createStyle(border = "TopBottomLeft", borderColour = c("red", "yellow", "green")) -} -\seealso{ -\code{\link{addStyle}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{createStyle} +\alias{createStyle} +\title{Create a cell style} +\usage{ +createStyle( + fontName = NULL, + fontSize = NULL, + fontColour = NULL, + numFmt = openxlsx_getOp("numFmt", "GENERAL"), + border = NULL, + borderColour = openxlsx_getOp("borderColour", "black"), + borderStyle = openxlsx_getOp("borderStyle", "thin"), + bgFill = NULL, + fgFill = NULL, + halign = NULL, + valign = NULL, + textDecoration = NULL, + wrapText = FALSE, + textRotation = NULL, + indent = NULL, + locked = NULL, + hidden = NULL +) +} +\arguments{ +\item{fontName}{A name of a font. Note the font name is not validated. If fontName is NULL, +the workbook base font is used. (Defaults to Calibri)} + +\item{fontSize}{Font size. A numeric greater than 0. +If fontSize is NULL, the workbook base font size is used. (Defaults to 11)} + +\item{fontColour}{Colour of text in cell. A valid hex colour beginning with "#" +or one of colours(). If fontColour is NULL, the workbook base font colours is used. +(Defaults to black)} + +\item{numFmt}{Cell formatting +\itemize{ +\item{\strong{GENERAL}} +\item{\strong{NUMBER}} +\item{\strong{CURRENCY}} +\item{\strong{ACCOUNTING}} +\item{\strong{DATE}} +\item{\strong{LONGDATE}} +\item{\strong{TIME}} +\item{\strong{PERCENTAGE}} +\item{\strong{FRACTION}} +\item{\strong{SCIENTIFIC}} +\item{\strong{TEXT}} +\item{\strong{COMMA}{ for comma separated thousands}} +\item{For date/datetime styling a combination of d, m, y and punctuation marks} +\item{For numeric rounding use "0.00" with the preferred number of decimal places} +}} + +\item{border}{Cell border. A vector of "top", "bottom", "left", "right" or a single string). +\itemize{ +\item{\strong{"top"}}{ Top border} +\item{\strong{bottom}}{ Bottom border} +\item{\strong{left}}{ Left border} +\item{\strong{right}}{ Right border} +\item{\strong{TopBottom} or \strong{c("top", "bottom")}}{ Top and bottom border} +\item{\strong{LeftRight} or \strong{c("left", "right")}}{ Left and right border} +\item{\strong{TopLeftRight} or \strong{c("top", "left", "right")}}{ Top, Left and right border} +\item{\strong{TopBottomLeftRight} or \strong{c("top", "bottom", "left", "right")}}{ All borders} +}} + +\item{borderColour}{Colour of cell border vector the same length as the number of sides specified in "border" +A valid colour (belonging to colours()) or a valid hex colour beginning with "#"} + +\item{borderStyle}{Border line style vector the same length as the number of sides specified in "border" +\itemize{ +\item{\strong{none}}{ No Border} +\item{\strong{thin}}{ thin border} +\item{\strong{medium}}{ medium border} +\item{\strong{dashed}}{ dashed border} +\item{\strong{dotted}}{ dotted border} +\item{\strong{thick}}{ thick border} +\item{\strong{double}}{ double line border} +\item{\strong{hair}}{ Hairline border} +\item{\strong{mediumDashed}}{ medium weight dashed border} +\item{\strong{dashDot}}{ dash-dot border} +\item{\strong{mediumDashDot}}{ medium weight dash-dot border} +\item{\strong{dashDotDot}}{ dash-dot-dot border} +\item{\strong{mediumDashDotDot}}{ medium weight dash-dot-dot border} +\item{\strong{slantDashDot}}{ slanted dash-dot border} +}} + +\item{bgFill}{Cell background fill colour. +A valid colour (belonging to colours()) or a valid hex colour beginning with "#". +-- \strong{Use for conditional formatting styles only.}} + +\item{fgFill}{Cell foreground fill colour. +A valid colour (belonging to colours()) or a valid hex colour beginning with "#"} + +\item{halign}{Horizontal alignment of cell contents +\itemize{ +\item{\strong{left}}{ Left horizontal align cell contents} +\item{\strong{right}}{ Right horizontal align cell contents} +\item{\strong{center}}{ Center horizontal align cell contents} +\item{\strong{justify}}{ Justify horizontal align cell contents} +}} + +\item{valign}{A name +Vertical alignment of cell contents +\itemize{ +\item{\strong{top}}{ Top vertical align cell contents} +\item{\strong{center}}{ Center vertical align cell contents} +\item{\strong{bottom}}{ Bottom vertical align cell contents} +}} + +\item{textDecoration}{Text styling. +\itemize{ +\item{\strong{bold}}{ Bold cell contents} +\item{\strong{strikeout}}{ Strikeout cell contents} +\item{\strong{italic}}{ Italicise cell contents} +\item{\strong{underline}}{ Underline cell contents} +\item{\strong{underline2}}{ Double underline cell contents} +\item{\strong{accounting}}{ Single accounting underline cell contents} +\item{\strong{accounting2}}{ Double accounting underline cell contents} +}} + +\item{wrapText}{Logical. If \code{TRUE} cell contents will wrap to fit in column.} + +\item{textRotation}{Rotation of text in degrees. 255 for vertical text.} + +\item{indent}{Horizontal indentation of cell contents.} + +\item{locked}{Whether cell contents are locked (if worksheet protection is turned on)} + +\item{hidden}{Whether the formula of the cell contents will be hidden (if worksheet protection is turned on)} +} +\value{ +A style object +} +\description{ +Create a new style to apply to worksheet cells +} +\examples{ +## See package vignettes for further examples + +## Modify default values of border colour and border line style +options("openxlsx.borderColour" = "#4F80BD") +options("openxlsx.borderStyle" = "thin") + +## Size 18 Arial, Bold, left horz. aligned, fill colour #1A33CC, all borders, +style <- createStyle( + fontSize = 18, fontName = "Arial", + textDecoration = "bold", halign = "left", fgFill = "#1A33CC", border = "TopBottomLeftRight" +) + +## Red, size 24, Bold, italic, underline, center aligned Font, bottom border +style <- createStyle( + fontSize = 24, fontColour = rgb(1, 0, 0), + textDecoration = c("bold", "italic", "underline"), + halign = "center", valign = "center", border = "Bottom" +) + +# borderColour is recycled for each border or all colours can be supplied + +# colour is recycled 3 times for "Top", "Bottom" & "Right" sides. +createStyle(border = "TopBottomRight", borderColour = "red") + +# supply all colours +createStyle(border = "TopBottomLeft", borderColour = c("red", "yellow", "green")) +} +\seealso{ +\code{\link[=addStyle]{addStyle()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/createWorkbook.Rd r-cran-openxlsx-4.2.5/man/createWorkbook.Rd --- r-cran-openxlsx-4.2.4/man/createWorkbook.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/createWorkbook.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,54 +1,54 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{createWorkbook} -\alias{createWorkbook} -\title{Create a new Workbook object} -\usage{ -createWorkbook( - creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"), - Sys.getenv("USER")), - title = NULL, - subject = NULL, - category = NULL -) -} -\arguments{ -\item{creator}{Creator of the workbook (your name). Defaults to login username} - -\item{title}{Workbook properties title} - -\item{subject}{Workbook properties subject} - -\item{category}{Workbook properties category} -} -\value{ -Workbook object -} -\description{ -Create a new Workbook object -} -\examples{ -## Create a new workbook -wb <- createWorkbook() - -## Save workbook to working directory -\dontrun{ -saveWorkbook(wb, file = "createWorkbookExample.xlsx", overwrite = TRUE) -} - -## Set Workbook properties -wb <- createWorkbook( - creator = "Me", - title = "title here", - subject = "this & that", - category = "something" -) -} -\seealso{ -\code{\link{loadWorkbook}} - -\code{\link{saveWorkbook}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{createWorkbook} +\alias{createWorkbook} +\title{Create a new Workbook object} +\usage{ +createWorkbook( + creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"), + Sys.getenv("USER")), + title = NULL, + subject = NULL, + category = NULL +) +} +\arguments{ +\item{creator}{Creator of the workbook (your name). Defaults to login username} + +\item{title}{Workbook properties title} + +\item{subject}{Workbook properties subject} + +\item{category}{Workbook properties category} +} +\value{ +Workbook object +} +\description{ +Create a new Workbook object +} +\examples{ +## Create a new workbook +wb <- createWorkbook() + +## Save workbook to working directory +\dontrun{ +saveWorkbook(wb, file = "createWorkbookExample.xlsx", overwrite = TRUE) +} + +## Set Workbook properties +wb <- createWorkbook( + creator = "Me", + title = "title here", + subject = "this & that", + category = "something" +) +} +\seealso{ +\code{\link[=loadWorkbook]{loadWorkbook()}} + +\code{\link[=saveWorkbook]{saveWorkbook()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/dataValidation.Rd r-cran-openxlsx-4.2.5/man/dataValidation.Rd --- r-cran-openxlsx-4.2.4/man/dataValidation.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/dataValidation.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,98 +1,98 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{dataValidation} -\alias{dataValidation} -\title{Add data validation to cells} -\usage{ -dataValidation( - wb, - sheet, - cols, - rows, - type, - operator, - value, - allowBlank = TRUE, - showInputMsg = TRUE, - showErrorMsg = TRUE -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Contiguous columns to apply conditional formatting to} - -\item{rows}{Contiguous rows to apply conditional formatting to} - -\item{type}{One of 'whole', 'decimal', 'date', 'time', 'textLength', 'list' (see examples)} - -\item{operator}{One of 'between', 'notBetween', 'equal', -'notEqual', 'greaterThan', 'lessThan', 'greaterThanOrEqual', 'lessThanOrEqual'} - -\item{value}{a vector of length 1 or 2 depending on operator (see examples)} - -\item{allowBlank}{logical} - -\item{showInputMsg}{logical} - -\item{showErrorMsg}{logical} -} -\description{ -Add Excel data validation to cells -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2") - -writeDataTable(wb, 1, x = iris[1:30, ]) - -dataValidation(wb, 1, - col = 1:3, rows = 2:31, type = "whole", - operator = "between", value = c(1, 9) -) - -dataValidation(wb, 1, - col = 5, rows = 2:31, type = "textLength", - operator = "between", value = c(4, 6) -) - - -## Date and Time cell validation -df <- data.frame( - "d" = as.Date("2016-01-01") + -5:5, - "t" = as.POSIXct("2016-01-01") + -5:5 * 10000 -) - -writeData(wb, 2, x = df) -dataValidation(wb, 2, - col = 1, rows = 2:12, type = "date", - operator = "greaterThanOrEqual", value = as.Date("2016-01-01") -) - -dataValidation(wb, 2, - col = 2, rows = 2:12, type = "time", - operator = "between", value = df$t[c(4, 8)] -) -\dontrun{ -saveWorkbook(wb, "dataValidationExample.xlsx", overwrite = TRUE) -} - - -###################################################################### -## If type == 'list' -# operator argument is ignored. - -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2") - -writeDataTable(wb, sheet = 1, x = iris[1:30, ]) -writeData(wb, sheet = 2, x = sample(iris$Sepal.Length, 10)) - -dataValidation(wb, 1, col = 1, rows = 2:31, type = "list", value = "'Sheet 2'!$A$1:$A$10") - -# openXL(wb) -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{dataValidation} +\alias{dataValidation} +\title{Add data validation to cells} +\usage{ +dataValidation( + wb, + sheet, + cols, + rows, + type, + operator, + value, + allowBlank = TRUE, + showInputMsg = TRUE, + showErrorMsg = TRUE +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Contiguous columns to apply conditional formatting to} + +\item{rows}{Contiguous rows to apply conditional formatting to} + +\item{type}{One of 'whole', 'decimal', 'date', 'time', 'textLength', 'list' (see examples)} + +\item{operator}{One of 'between', 'notBetween', 'equal', +'notEqual', 'greaterThan', 'lessThan', 'greaterThanOrEqual', 'lessThanOrEqual'} + +\item{value}{a vector of length 1 or 2 depending on operator (see examples)} + +\item{allowBlank}{logical} + +\item{showInputMsg}{logical} + +\item{showErrorMsg}{logical} +} +\description{ +Add Excel data validation to cells +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2") + +writeDataTable(wb, 1, x = iris[1:30, ]) + +dataValidation(wb, 1, + col = 1:3, rows = 2:31, type = "whole", + operator = "between", value = c(1, 9) +) + +dataValidation(wb, 1, + col = 5, rows = 2:31, type = "textLength", + operator = "between", value = c(4, 6) +) + + +## Date and Time cell validation +df <- data.frame( + "d" = as.Date("2016-01-01") + -5:5, + "t" = as.POSIXct("2016-01-01") + -5:5 * 10000 +) + +writeData(wb, 2, x = df) +dataValidation(wb, 2, + col = 1, rows = 2:12, type = "date", + operator = "greaterThanOrEqual", value = as.Date("2016-01-01") +) + +dataValidation(wb, 2, + col = 2, rows = 2:12, type = "time", + operator = "between", value = df$t[c(4, 8)] +) +\dontrun{ +saveWorkbook(wb, "dataValidationExample.xlsx", overwrite = TRUE) +} + + +###################################################################### +## If type == 'list' +# operator argument is ignored. + +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2") + +writeDataTable(wb, sheet = 1, x = iris[1:30, ]) +writeData(wb, sheet = 2, x = sample(iris$Sepal.Length, 10)) + +dataValidation(wb, 1, col = 1, rows = 2:31, type = "list", value = "'Sheet 2'!$A$1:$A$10") + +# openXL(wb) +} diff -Nru r-cran-openxlsx-4.2.4/man/deleteData.Rd r-cran-openxlsx-4.2.5/man/deleteData.Rd --- r-cran-openxlsx-4.2.4/man/deleteData.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/deleteData.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,41 +1,41 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{deleteData} -\alias{deleteData} -\title{Delete cell data} -\usage{ -deleteData(wb, sheet, cols, rows, gridExpand = FALSE) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{columns to delete data from.} - -\item{rows}{Rows to delete data from.} - -\item{gridExpand}{If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) -will be removed.} -} -\description{ -Delete contents and styling from a cell. -} -\examples{ -## write some data -wb <- createWorkbook() -addWorksheet(wb, "Worksheet 1") -x <- data.frame(matrix(runif(200), ncol = 10)) -writeData(wb, sheet = 1, x = x, startCol = 2, startRow = 3, colNames = FALSE) - -## delete some data -deleteData(wb, sheet = 1, cols = 3:5, rows = 5:7, gridExpand = TRUE) -deleteData(wb, sheet = 1, cols = 7:9, rows = 5:7, gridExpand = TRUE) -deleteData(wb, sheet = 1, cols = LETTERS, rows = 18, gridExpand = TRUE) -\dontrun{ -saveWorkbook(wb, "deleteDataExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{deleteData} +\alias{deleteData} +\title{Delete cell data} +\usage{ +deleteData(wb, sheet, cols, rows, gridExpand = FALSE) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{columns to delete data from.} + +\item{rows}{Rows to delete data from.} + +\item{gridExpand}{If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) +will be removed.} +} +\description{ +Delete contents and styling from a cell. +} +\examples{ +## write some data +wb <- createWorkbook() +addWorksheet(wb, "Worksheet 1") +x <- data.frame(matrix(runif(200), ncol = 10)) +writeData(wb, sheet = 1, x = x, startCol = 2, startRow = 3, colNames = FALSE) + +## delete some data +deleteData(wb, sheet = 1, cols = 3:5, rows = 5:7, gridExpand = TRUE) +deleteData(wb, sheet = 1, cols = 7:9, rows = 5:7, gridExpand = TRUE) +deleteData(wb, sheet = 1, cols = LETTERS, rows = 18, gridExpand = TRUE) +\dontrun{ +saveWorkbook(wb, "deleteDataExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/freezePane.Rd r-cran-openxlsx-4.2.5/man/freezePane.Rd --- r-cran-openxlsx-4.2.4/man/freezePane.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/freezePane.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,55 +1,55 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{freezePane} -\alias{freezePane} -\title{Freeze a worksheet pane} -\usage{ -freezePane( - wb, - sheet, - firstActiveRow = NULL, - firstActiveCol = NULL, - firstRow = FALSE, - firstCol = FALSE -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{firstActiveRow}{Top row of active region} - -\item{firstActiveCol}{Furthest left column of active region} - -\item{firstRow}{If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2)} - -\item{firstCol}{If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2)} -} -\description{ -Freeze a worksheet pane -} -\examples{ -## Create a new workbook -wb <- createWorkbook("Kenshin") - -## Add some worksheets -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2") -addWorksheet(wb, "Sheet 3") -addWorksheet(wb, "Sheet 4") - -## Freeze Panes -freezePane(wb, "Sheet 1", firstActiveRow = 5, firstActiveCol = 3) -freezePane(wb, "Sheet 2", firstCol = TRUE) ## shortcut to firstActiveCol = 2 -freezePane(wb, 3, firstRow = TRUE) ## shortcut to firstActiveRow = 2 -freezePane(wb, 4, firstActiveRow = 1, firstActiveCol = "D") - -## Save workbook -\dontrun{ -saveWorkbook(wb, "freezePaneExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{freezePane} +\alias{freezePane} +\title{Freeze a worksheet pane} +\usage{ +freezePane( + wb, + sheet, + firstActiveRow = NULL, + firstActiveCol = NULL, + firstRow = FALSE, + firstCol = FALSE +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{firstActiveRow}{Top row of active region} + +\item{firstActiveCol}{Furthest left column of active region} + +\item{firstRow}{If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2)} + +\item{firstCol}{If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2)} +} +\description{ +Freeze a worksheet pane +} +\examples{ +## Create a new workbook +wb <- createWorkbook("Kenshin") + +## Add some worksheets +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2") +addWorksheet(wb, "Sheet 3") +addWorksheet(wb, "Sheet 4") + +## Freeze Panes +freezePane(wb, "Sheet 1", firstActiveRow = 5, firstActiveCol = 3) +freezePane(wb, "Sheet 2", firstCol = TRUE) ## shortcut to firstActiveCol = 2 +freezePane(wb, 3, firstRow = TRUE) ## shortcut to firstActiveRow = 2 +freezePane(wb, 4, firstActiveRow = 1, firstActiveCol = "D") + +## Save workbook +\dontrun{ +saveWorkbook(wb, "freezePaneExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/getBaseFont.Rd r-cran-openxlsx-4.2.5/man/getBaseFont.Rd --- r-cran-openxlsx-4.2.4/man/getBaseFont.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getBaseFont.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,29 +1,29 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getBaseFont} -\alias{getBaseFont} -\title{Return the workbook default font} -\usage{ -getBaseFont(wb) -} -\arguments{ -\item{wb}{A workbook object} -} -\description{ -Return the workbook default font - -Returns the base font used in the workbook. -} -\examples{ -## create a workbook -wb <- createWorkbook() -getBaseFont(wb) - -## modify base font to size 10 Arial Narrow in red -modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") - -getBaseFont(wb) -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getBaseFont} +\alias{getBaseFont} +\title{Return the workbook default font} +\usage{ +getBaseFont(wb) +} +\arguments{ +\item{wb}{A workbook object} +} +\description{ +Return the workbook default font + +Returns the base font used in the workbook. +} +\examples{ +## create a workbook +wb <- createWorkbook() +getBaseFont(wb) + +## modify base font to size 10 Arial Narrow in red +modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") + +getBaseFont(wb) +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/getCellRefs.Rd r-cran-openxlsx-4.2.5/man/getCellRefs.Rd --- r-cran-openxlsx-4.2.4/man/getCellRefs.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getCellRefs.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,26 +1,26 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getCellRefs} -\alias{getCellRefs} -\title{Return excel cell coordinates from (x,y) coordinates} -\usage{ -getCellRefs(cellCoords) -} -\arguments{ -\item{cellCoords}{A data.frame with two columns coordinate pairs.} -} -\value{ -Excel alphanumeric cell reference -} -\description{ -Return excel cell coordinates from (x,y) coordinates -} -\examples{ -getCellRefs(data.frame(1, 2)) -# "B1" -getCellRefs(data.frame(1:3, 2:4)) -# "B1" "C2" "D3" -} -\author{ -Philipp Schauberger, Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getCellRefs} +\alias{getCellRefs} +\title{Return excel cell coordinates from (x,y) coordinates} +\usage{ +getCellRefs(cellCoords) +} +\arguments{ +\item{cellCoords}{A data.frame with two columns coordinate pairs.} +} +\value{ +Excel alphanumeric cell reference +} +\description{ +Return excel cell coordinates from (x,y) coordinates +} +\examples{ +getCellRefs(data.frame(1, 2)) +# "B1" +getCellRefs(data.frame(1:3, 2:4)) +# "B1" "C2" "D3" +} +\author{ +Philipp Schauberger, Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/getCreators.Rd r-cran-openxlsx-4.2.5/man/getCreators.Rd --- r-cran-openxlsx-4.2.4/man/getCreators.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getCreators.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,26 +1,26 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getCreators} -\alias{getCreators} -\title{Add another author to the meta data of the file.} -\usage{ -getCreators(wb) -} -\arguments{ -\item{wb}{A workbook object} -} -\value{ -vector of creators -} -\description{ -Just a wrapper of wb$getCreators() -Get the names of the -} -\examples{ - -wb <- createWorkbook() -getCreators(wb) -} -\author{ -Philipp Schauberger -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getCreators} +\alias{getCreators} +\title{Add another author to the meta data of the file.} +\usage{ +getCreators(wb) +} +\arguments{ +\item{wb}{A workbook object} +} +\value{ +vector of creators +} +\description{ +Just a wrapper of wb$getCreators() +Get the names of the +} +\examples{ + +wb <- createWorkbook() +getCreators(wb) +} +\author{ +Philipp Schauberger +} diff -Nru r-cran-openxlsx-4.2.4/man/getDateOrigin.Rd r-cran-openxlsx-4.2.5/man/getDateOrigin.Rd --- r-cran-openxlsx-4.2.4/man/getDateOrigin.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getDateOrigin.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,39 +1,39 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getDateOrigin} -\alias{getDateOrigin} -\title{Get the date origin an xlsx file is using} -\usage{ -getDateOrigin(xlsxFile) -} -\arguments{ -\item{xlsxFile}{An xlsx or xlsm file.} -} -\value{ -One of "1900-01-01" or "1904-01-01". -} -\description{ -Return the date origin used internally by an xlsx or xlsm file -} -\details{ -Excel stores dates as the number of days from either 1904-01-01 or 1900-01-01. This function -checks the date origin being used in an Excel file and returns is so it can be used in \code{\link{convertToDate}} -} -\examples{ - -## create a file with some dates -\dontrun{ -write.xlsx(as.Date("2015-01-10") - (0:4), file = "getDateOriginExample.xlsx") -m <- read.xlsx("getDateOriginExample.xlsx") - -## convert to dates -do <- getDateOrigin(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -convertToDate(m[[1]], do) -} -} -\seealso{ -\code{\link{convertToDate}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getDateOrigin} +\alias{getDateOrigin} +\title{Get the date origin an xlsx file is using} +\usage{ +getDateOrigin(xlsxFile) +} +\arguments{ +\item{xlsxFile}{An xlsx or xlsm file.} +} +\value{ +One of "1900-01-01" or "1904-01-01". +} +\description{ +Return the date origin used internally by an xlsx or xlsm file +} +\details{ +Excel stores dates as the number of days from either 1904-01-01 or 1900-01-01. This function +checks the date origin being used in an Excel file and returns is so it can be used in \code{\link[=convertToDate]{convertToDate()}} +} +\examples{ + +## create a file with some dates +\dontrun{ +write.xlsx(as.Date("2015-01-10") - (0:4), file = "getDateOriginExample.xlsx") +m <- read.xlsx("getDateOriginExample.xlsx") + +## convert to dates +do <- getDateOrigin(system.file("extdata", "readTest.xlsx", package = "openxlsx")) +convertToDate(m[[1]], do) +} +} +\seealso{ +\code{\link[=convertToDate]{convertToDate()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/getNamedRegions.Rd r-cran-openxlsx-4.2.5/man/getNamedRegions.Rd --- r-cran-openxlsx-4.2.4/man/getNamedRegions.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getNamedRegions.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,52 +1,53 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getNamedRegions} -\alias{getNamedRegions} -\title{Get named regions} -\usage{ -getNamedRegions(x) -} -\arguments{ -\item{x}{An xlsx file or Workbook object} -} -\description{ -Return a vector of named regions in a xlsx file or -Workbook object -} -\examples{ -## create named regions -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") - -## specify region -writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) -createNamedRegion( - wb = wb, - sheet = 1, - name = "iris", - rows = 1:(nrow(iris) + 1), - cols = 1:ncol(iris) -) - - -## using writeData 'name' argument to create a named region -writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) -\dontrun{ -out_file <- tempfile(fileext = ".xlsx") -saveWorkbook(wb, out_file, overwrite = TRUE) - -## see named regions -getNamedRegions(wb) ## From Workbook object -getNamedRegions(out_file) ## From xlsx file - -## read named regions -df <- read.xlsx(wb, namedRegion = "iris") -head(df) - -df <- read.xlsx(out_file, namedRegion = "iris2") -head(df) -} -} -\seealso{ -\code{\link{createNamedRegion}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getNamedRegions} +\alias{getNamedRegions} +\title{Get named regions} +\usage{ +getNamedRegions(x) +} +\arguments{ +\item{x}{An xlsx file or Workbook object} +} +\description{ +Return a vector of named regions in a xlsx file or +Workbook object +} +\examples{ +## create named regions +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") + +## specify region +writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) +createNamedRegion( + wb = wb, + sheet = 1, + name = "iris", + rows = 1:(nrow(iris) + 1), + cols = 1:ncol(iris) +) + + +## using writeData 'name' argument to create a named region +writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) +\dontrun{ +out_file <- tempfile(fileext = ".xlsx") +saveWorkbook(wb, out_file, overwrite = TRUE) + +## see named regions +getNamedRegions(wb) ## From Workbook object +getNamedRegions(out_file) ## From xlsx file + +## read named regions +df <- read.xlsx(wb, namedRegion = "iris") +head(df) + +df <- read.xlsx(out_file, namedRegion = "iris2") +head(df) +} + +} +\seealso{ +\code{\link[=createNamedRegion]{createNamedRegion()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/getSheetNames.Rd r-cran-openxlsx-4.2.5/man/getSheetNames.Rd --- r-cran-openxlsx-4.2.4/man/getSheetNames.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getSheetNames.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,23 +1,23 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getSheetNames} -\alias{getSheetNames} -\title{Get names of worksheets} -\usage{ -getSheetNames(file) -} -\arguments{ -\item{file}{An xlsx or xlsm file.} -} -\value{ -Character vector of worksheet names. -} -\description{ -Returns the worksheet names within an xlsx file -} -\examples{ -getSheetNames(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getSheetNames} +\alias{getSheetNames} +\title{Get names of worksheets} +\usage{ +getSheetNames(file) +} +\arguments{ +\item{file}{An xlsx or xlsm file.} +} +\value{ +Character vector of worksheet names. +} +\description{ +Returns the worksheet names within an xlsx file +} +\examples{ +getSheetNames(system.file("extdata", "readTest.xlsx", package = "openxlsx")) +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/getStyles.Rd r-cran-openxlsx-4.2.5/man/getStyles.Rd --- r-cran-openxlsx-4.2.4/man/getStyles.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getStyles.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,22 +1,22 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getStyles} -\alias{getStyles} -\title{Returns a list of all styles in the workbook} -\usage{ -getStyles(wb) -} -\arguments{ -\item{wb}{A workbook object} -} -\description{ -Returns list of style objects in the workbook -} -\examples{ -## load a workbook -wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -getStyles(wb)[1:3] -} -\seealso{ -\code{\link{replaceStyle}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getStyles} +\alias{getStyles} +\title{Returns a list of all styles in the workbook} +\usage{ +getStyles(wb) +} +\arguments{ +\item{wb}{A workbook object} +} +\description{ +Returns list of style objects in the workbook +} +\examples{ +## load a workbook +wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +getStyles(wb)[1:3] +} +\seealso{ +\code{\link[=replaceStyle]{replaceStyle()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/getTables.Rd r-cran-openxlsx-4.2.5/man/getTables.Rd --- r-cran-openxlsx-4.2.4/man/getTables.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/getTables.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,28 +1,28 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{getTables} -\alias{getTables} -\title{List Excel tables in a workbook} -\usage{ -getTables(wb, sheet) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} -} -\value{ -character vector of table names on the specified sheet -} -\description{ -List Excel tables in a workbook -} -\examples{ - -wb <- createWorkbook() -addWorksheet(wb, sheetName = "Sheet 1") -writeDataTable(wb, sheet = "Sheet 1", x = iris) -writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - -getTables(wb, sheet = "Sheet 1") -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{getTables} +\alias{getTables} +\title{List Excel tables in a workbook} +\usage{ +getTables(wb, sheet) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} +} +\value{ +character vector of table names on the specified sheet +} +\description{ +List Excel tables in a workbook +} +\examples{ + +wb <- createWorkbook() +addWorksheet(wb, sheetName = "Sheet 1") +writeDataTable(wb, sheet = "Sheet 1", x = iris) +writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + +getTables(wb, sheet = "Sheet 1") +} diff -Nru r-cran-openxlsx-4.2.4/man/groupColumns.Rd r-cran-openxlsx-4.2.5/man/groupColumns.Rd --- r-cran-openxlsx-4.2.4/man/groupColumns.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/groupColumns.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,31 +1,31 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{groupColumns} -\alias{groupColumns} -\title{Group columns} -\usage{ -groupColumns(wb, sheet, cols, hidden = FALSE) -} -\arguments{ -\item{wb}{A workbook object.} - -\item{sheet}{A name or index of a worksheet.} - -\item{cols}{Indices of cols to group.} - -\item{hidden}{Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE.} -} -\description{ -Group a selection of columns -} -\details{ -Group columns together, with the option to hide them. - -NOTE: \code{\link{setColWidths}} has a conflicting \code{hidden} parameter; changing one will update the other. -} -\seealso{ -\code{\link{ungroupColumns}} to ungroup columns. \code{\link{groupRows}} for grouping rows. -} -\author{ -Joshua Sturm -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{groupColumns} +\alias{groupColumns} +\title{Group columns} +\usage{ +groupColumns(wb, sheet, cols, hidden = FALSE) +} +\arguments{ +\item{wb}{A workbook object.} + +\item{sheet}{A name or index of a worksheet.} + +\item{cols}{Indices of cols to group.} + +\item{hidden}{Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE.} +} +\description{ +Group a selection of columns +} +\details{ +Group columns together, with the option to hide them. + +NOTE: \code{\link[=setColWidths]{setColWidths()}} has a conflicting \code{hidden} parameter; changing one will update the other. +} +\seealso{ +\code{\link[=ungroupColumns]{ungroupColumns()}} to ungroup columns. \code{\link[=groupRows]{groupRows()}} for grouping rows. +} +\author{ +Joshua Sturm +} diff -Nru r-cran-openxlsx-4.2.4/man/groupRows.Rd r-cran-openxlsx-4.2.5/man/groupRows.Rd --- r-cran-openxlsx-4.2.4/man/groupRows.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/groupRows.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,26 +1,26 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{groupRows} -\alias{groupRows} -\title{Group Rows} -\usage{ -groupRows(wb, sheet, rows, hidden = FALSE) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{rows}{Indices of rows to group} - -\item{hidden}{Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE} -} -\description{ -Group a selection of rows -} -\seealso{ -\code{\link{ungroupRows}} to ungroup rows. \code{\link{groupColumns}} for grouping columns. -} -\author{ -Joshua Sturm -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{groupRows} +\alias{groupRows} +\title{Group Rows} +\usage{ +groupRows(wb, sheet, rows, hidden = FALSE) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{rows}{Indices of rows to group} + +\item{hidden}{Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE} +} +\description{ +Group a selection of rows +} +\seealso{ +\code{\link[=ungroupRows]{ungroupRows()}} to ungroup rows. \code{\link[=groupColumns]{groupColumns()}} for grouping columns. +} +\author{ +Joshua Sturm +} diff -Nru r-cran-openxlsx-4.2.4/man/if_null_then.Rd r-cran-openxlsx-4.2.5/man/if_null_then.Rd --- r-cran-openxlsx-4.2.4/man/if_null_then.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/if_null_then.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,25 +1,25 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{if_null_then} -\alias{if_null_then} -\alias{\%||\%} -\title{If NULL then ...} -\usage{ -x \%||\% y -} -\arguments{ -\item{x}{A value to check} - -\item{y}{A value to substitute if x is null} -} -\description{ -Replace NULL -} -\examples{ -\dontrun{ -x <- NULL -x <- x \%||\% "none" -x <- x \%||\% NA -} - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{if_null_then} +\alias{if_null_then} +\alias{\%||\%} +\title{If NULL then ...} +\usage{ +x \%||\% y +} +\arguments{ +\item{x}{A value to check} + +\item{y}{A value to substitute if x is null} +} +\description{ +Replace NULL +} +\examples{ +\dontrun{ +x <- NULL +x <- x \%||\% "none" +x <- x \%||\% NA +} + +} diff -Nru r-cran-openxlsx-4.2.4/man/insertImage.Rd r-cran-openxlsx-4.2.5/man/insertImage.Rd --- r-cran-openxlsx-4.2.4/man/insertImage.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/insertImage.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,66 +1,66 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{insertImage} -\alias{insertImage} -\title{Insert an image into a worksheet} -\usage{ -insertImage( - wb, - sheet, - file, - width = 6, - height = 3, - startRow = 1, - startCol = 1, - units = "in", - dpi = 300 -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{file}{An image file. Valid file types are: jpeg, png, bmp} - -\item{width}{Width of figure.} - -\item{height}{Height of figure.} - -\item{startRow}{Row coordinate of upper left corner of the image} - -\item{startCol}{Column coordinate of upper left corner of the image} - -\item{units}{Units of width and height. Can be "in", "cm" or "px"} - -\item{dpi}{Image resolution used for conversion between units.} -} -\description{ -Insert an image into a worksheet -} -\examples{ -## Create a new workbook -wb <- createWorkbook("Ayanami") - -## Add some worksheets -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2") -addWorksheet(wb, "Sheet 3") - -## Insert images -img <- system.file("extdata", "einstein.jpg", package = "openxlsx") -insertImage(wb, "Sheet 1", img, startRow = 5, startCol = 3, width = 6, height = 5) -insertImage(wb, 2, img, startRow = 2, startCol = 2) -insertImage(wb, 3, img, width = 15, height = 12, startRow = 3, startCol = "G", units = "cm") - -## Save workbook -\dontrun{ -saveWorkbook(wb, "insertImageExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{insertPlot}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{insertImage} +\alias{insertImage} +\title{Insert an image into a worksheet} +\usage{ +insertImage( + wb, + sheet, + file, + width = 6, + height = 3, + startRow = 1, + startCol = 1, + units = "in", + dpi = 300 +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{file}{An image file. Valid file types are: jpeg, png, bmp} + +\item{width}{Width of figure.} + +\item{height}{Height of figure.} + +\item{startRow}{Row coordinate of upper left corner of the image} + +\item{startCol}{Column coordinate of upper left corner of the image} + +\item{units}{Units of width and height. Can be "in", "cm" or "px"} + +\item{dpi}{Image resolution used for conversion between units.} +} +\description{ +Insert an image into a worksheet +} +\examples{ +## Create a new workbook +wb <- createWorkbook("Ayanami") + +## Add some worksheets +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2") +addWorksheet(wb, "Sheet 3") + +## Insert images +img <- system.file("extdata", "einstein.jpg", package = "openxlsx") +insertImage(wb, "Sheet 1", img, startRow = 5, startCol = 3, width = 6, height = 5) +insertImage(wb, 2, img, startRow = 2, startCol = 2) +insertImage(wb, 3, img, width = 15, height = 12, startRow = 3, startCol = "G", units = "cm") + +## Save workbook +\dontrun{ +saveWorkbook(wb, "insertImageExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=insertPlot]{insertPlot()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/insertPlot.Rd r-cran-openxlsx-4.2.5/man/insertPlot.Rd --- r-cran-openxlsx-4.2.4/man/insertPlot.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/insertPlot.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,80 +1,80 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{insertPlot} -\alias{insertPlot} -\title{Insert the current plot into a worksheet} -\usage{ -insertPlot( - wb, - sheet, - width = 6, - height = 4, - xy = NULL, - startRow = 1, - startCol = 1, - fileType = "png", - units = "in", - dpi = 300 -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{width}{Width of figure. Defaults to 6in.} - -\item{height}{Height of figure . Defaults to 4in.} - -\item{xy}{Alternate way to specify startRow and startCol. A vector of length 2 of form (startcol, startRow)} - -\item{startRow}{Row coordinate of upper left corner of figure. xy[[2]] when xy is given.} - -\item{startCol}{Column coordinate of upper left corner of figure. xy[[1]] when xy is given.} - -\item{fileType}{File type of image} - -\item{units}{Units of width and height. Can be "in", "cm" or "px"} - -\item{dpi}{Image resolution} -} -\description{ -The current plot is saved to a temporary image file using dev.copy. -This file is then written to the workbook using insertImage. -} -\examples{ -\dontrun{ -## Create a new workbook -wb <- createWorkbook() - -## Add a worksheet -addWorksheet(wb, "Sheet 1", gridLines = FALSE) - -## create plot objects -require(ggplot2) -p1 <- qplot(mpg, - data = mtcars, geom = "density", - fill = as.factor(gear), alpha = I(.5), main = "Distribution of Gas Mileage" -) -p2 <- qplot(age, circumference, - data = Orange, geom = c("point", "line"), colour = Tree -) - -## Insert currently displayed plot to sheet 1, row 1, column 1 -print(p1) # plot needs to be showing -insertPlot(wb, 1, width = 5, height = 3.5, fileType = "png", units = "in") - -## Insert plot 2 -print(p2) -insertPlot(wb, 1, xy = c("J", 2), width = 16, height = 10, fileType = "png", units = "cm") - -## Save workbook -saveWorkbook(wb, "insertPlotExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{insertImage}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{insertPlot} +\alias{insertPlot} +\title{Insert the current plot into a worksheet} +\usage{ +insertPlot( + wb, + sheet, + width = 6, + height = 4, + xy = NULL, + startRow = 1, + startCol = 1, + fileType = "png", + units = "in", + dpi = 300 +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{width}{Width of figure. Defaults to 6in.} + +\item{height}{Height of figure . Defaults to 4in.} + +\item{xy}{Alternate way to specify startRow and startCol. A vector of length 2 of form (startcol, startRow)} + +\item{startRow}{Row coordinate of upper left corner of figure.\code{ xy[[2]]} when xy is given.} + +\item{startCol}{Column coordinate of upper left corner of figure. \code{xy[[1]]} when xy is given.} + +\item{fileType}{File type of image} + +\item{units}{Units of width and height. Can be "in", "cm" or "px"} + +\item{dpi}{Image resolution} +} +\description{ +The current plot is saved to a temporary image file using dev.copy. +This file is then written to the workbook using insertImage. +} +\examples{ +\dontrun{ +## Create a new workbook +wb <- createWorkbook() + +## Add a worksheet +addWorksheet(wb, "Sheet 1", gridLines = FALSE) + +## create plot objects +require(ggplot2) +p1 <- qplot(mpg, + data = mtcars, geom = "density", + fill = as.factor(gear), alpha = I(.5), main = "Distribution of Gas Mileage" +) +p2 <- qplot(age, circumference, + data = Orange, geom = c("point", "line"), colour = Tree +) + +## Insert currently displayed plot to sheet 1, row 1, column 1 +print(p1) # plot needs to be showing +insertPlot(wb, 1, width = 5, height = 3.5, fileType = "png", units = "in") + +## Insert plot 2 +print(p2) +insertPlot(wb, 1, xy = c("J", 2), width = 16, height = 10, fileType = "png", units = "cm") + +## Save workbook +saveWorkbook(wb, "insertPlotExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=insertImage]{insertImage()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/int2col.Rd r-cran-openxlsx-4.2.5/man/int2col.Rd --- r-cran-openxlsx-4.2.4/man/int2col.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/int2col.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,17 +1,17 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{int2col} -\alias{int2col} -\title{Convert integer to Excel column} -\usage{ -int2col(x) -} -\arguments{ -\item{x}{A numeric vector} -} -\description{ -Converts an integer to an Excel column label. -} -\examples{ -int2col(1:10) -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{int2col} +\alias{int2col} +\title{Convert integer to Excel column} +\usage{ +int2col(x) +} +\arguments{ +\item{x}{A numeric vector} +} +\description{ +Converts an integer to an Excel column label. +} +\examples{ +int2col(1:10) +} diff -Nru r-cran-openxlsx-4.2.4/man/loadWorkbook.Rd r-cran-openxlsx-4.2.5/man/loadWorkbook.Rd --- r-cran-openxlsx-4.2.4/man/loadWorkbook.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/loadWorkbook.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,42 +1,42 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/loadWorkbook.R -\name{loadWorkbook} -\alias{loadWorkbook} -\title{Load an existing .xlsx file} -\usage{ -loadWorkbook(file, xlsxFile = NULL, isUnzipped = FALSE) -} -\arguments{ -\item{file}{A path to an existing .xlsx or .xlsm file} - -\item{xlsxFile}{alias for file} - -\item{isUnzipped}{Set to TRUE if the xlsx file is already unzipped} -} -\value{ -Workbook object. -} -\description{ -loadWorkbook returns a workbook object conserving styles and -formatting of the original .xlsx file. -} -\examples{ -## load existing workbook from package folder -wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -names(wb) # list worksheets -wb ## view object -## Add a worksheet -addWorksheet(wb, "A new worksheet") - -## Save workbook -\dontrun{ -saveWorkbook(wb, "loadExample.xlsx", overwrite = TRUE) -} - -} -\seealso{ -\code{\link{removeWorksheet}} -} -\author{ -Alexander Walker, Philipp Schauberger -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/loadWorkbook.R +\name{loadWorkbook} +\alias{loadWorkbook} +\title{Load an existing .xlsx file} +\usage{ +loadWorkbook(file, xlsxFile = NULL, isUnzipped = FALSE) +} +\arguments{ +\item{file}{A path to an existing .xlsx or .xlsm file} + +\item{xlsxFile}{alias for file} + +\item{isUnzipped}{Set to TRUE if the xlsx file is already unzipped} +} +\value{ +Workbook object. +} +\description{ +loadWorkbook returns a workbook object conserving styles and +formatting of the original .xlsx file. +} +\examples{ +## load existing workbook from package folder +wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +names(wb) # list worksheets +wb ## view object +## Add a worksheet +addWorksheet(wb, "A new worksheet") + +## Save workbook +\dontrun{ +saveWorkbook(wb, "loadExample.xlsx", overwrite = TRUE) +} + +} +\seealso{ +\code{\link[=removeWorksheet]{removeWorksheet()}} +} +\author{ +Alexander Walker, Philipp Schauberger +} diff -Nru r-cran-openxlsx-4.2.4/man/makeHyperlinkString.Rd r-cran-openxlsx-4.2.5/man/makeHyperlinkString.Rd --- r-cran-openxlsx-4.2.4/man/makeHyperlinkString.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/makeHyperlinkString.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,92 +1,97 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/helperFunctions.R -\name{makeHyperlinkString} -\alias{makeHyperlinkString} -\title{create Excel hyperlink string} -\usage{ -makeHyperlinkString(sheet, row = 1, col = 1, text = NULL, file = NULL) -} -\arguments{ -\item{sheet}{Name of a worksheet} - -\item{row}{integer row number for hyperlink to link to} - -\item{col}{column number of letter for hyperlink to link to} - -\item{text}{display text} - -\item{file}{Excel file name to point to. If NULL hyperlink is internal.} -} -\description{ -Wrapper to create internal hyperlink string to pass to writeFormula() -} -\examples{ - -## Writing internal hyperlinks -wb <- createWorkbook() -addWorksheet(wb, "Sheet1") -addWorksheet(wb, "Sheet2") -addWorksheet(wb, "Sheet 3") -writeData(wb, sheet = 3, x = iris) - -## External Hyperlink -x <- c("https://www.google.com", "https://www.google.com.au") -names(x) <- c("google", "google Aus") -class(x) <- "hyperlink" - -writeData(wb, sheet = 1, x = x, startCol = 10) - - -## Internal Hyperlink - create hyperlink formula manually -writeFormula(wb, "Sheet1", - x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")', - startCol = 3 -) - -## Internal - No text to display using makeHyperlinkString() function -writeFormula(wb, "Sheet1", - startRow = 1, - x = makeHyperlinkString(sheet = "Sheet 3", row = 1, col = 2) -) - -## Internal - Text to display -writeFormula(wb, "Sheet1", - startRow = 2, - x = makeHyperlinkString( - sheet = "Sheet 3", row = 1, col = 2, - text = "Link to Sheet 3" - ) -) - -## Link to file - No text to display -writeFormula(wb, "Sheet1", - startRow = 4, - x = makeHyperlinkString( - sheet = "testing", row = 3, col = 10, - file = system.file("extdata", "loadExample.xlsx", package = "openxlsx") - ) -) - -## Link to file - Text to display -writeFormula(wb, "Sheet1", - startRow = 3, - x = makeHyperlinkString( - sheet = "testing", row = 3, col = 10, - file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"), - text = "Link to File." - ) -) - -## Link to external file - Text to display -writeFormula(wb, "Sheet1", - startRow = 10, startCol = 1, - x = '=HYPERLINK(\\\\"[C:/Users]\\\\", \\\\"Link to an external file\\\\")' -) -\dontrun{ -saveWorkbook(wb, "internalHyperlinks.xlsx", overwrite = TRUE) -} - -} -\seealso{ -\code{\link{writeFormula}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helperFunctions.R +\name{makeHyperlinkString} +\alias{makeHyperlinkString} +\title{create Excel hyperlink string} +\usage{ +makeHyperlinkString(sheet, row = 1, col = 1, text = NULL, file = NULL) +} +\arguments{ +\item{sheet}{Name of a worksheet} + +\item{row}{integer row number for hyperlink to link to} + +\item{col}{column number of letter for hyperlink to link to} + +\item{text}{display text} + +\item{file}{Excel file name to point to. If NULL hyperlink is internal.} +} +\description{ +Wrapper to create internal hyperlink string to pass to writeFormula(). Either link to external urls or local files or straight to cells of local Excel sheets. +} +\examples{ + +## Writing internal hyperlinks +wb <- createWorkbook() +addWorksheet(wb, "Sheet1") +addWorksheet(wb, "Sheet2") +addWorksheet(wb, "Sheet 3") +writeData(wb, sheet = 3, x = iris) + +## External Hyperlink +x <- c("https://www.google.com", "https://www.google.com.au") +names(x) <- c("google", "google Aus") +class(x) <- "hyperlink" + +writeData(wb, sheet = 1, x = x, startCol = 10) + + +## Internal Hyperlink - create hyperlink formula manually +writeFormula(wb, "Sheet1", + x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")', + startCol = 3 +) + +## Internal - No text to display using makeHyperlinkString() function +writeFormula(wb, "Sheet1", + startRow = 1, + x = makeHyperlinkString(sheet = "Sheet 3", row = 1, col = 2) +) + +## Internal - Text to display +writeFormula(wb, "Sheet1", + startRow = 2, + x = makeHyperlinkString( + sheet = "Sheet 3", row = 1, col = 2, + text = "Link to Sheet 3" + ) +) + +## Link to file - No text to display +writeFormula(wb, "Sheet1", + startRow = 4, + x = makeHyperlinkString( + sheet = "testing", row = 3, col = 10, + file = system.file("extdata", "loadExample.xlsx", package = "openxlsx") + ) +) + +## Link to file - Text to display +writeFormula(wb, "Sheet1", + startRow = 3, + x = makeHyperlinkString( + sheet = "testing", row = 3, col = 10, + file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"), + text = "Link to File." + ) +) + +## Link to external file - Text to display +writeFormula(wb, "Sheet1", + startRow = 10, startCol = 1, + x = '=HYPERLINK(\\\\"[C:/Users]\\\\", \\\\"Link to an external file\\\\")' +) + +## Link to internal file +x = makeHyperlinkString(text = "test.png", file = "D:/somepath/somepicture.png") +writeFormula(wb, "Sheet1", startRow = 11, startCol = 1, x = x) + +\dontrun{ +saveWorkbook(wb, "internalHyperlinks.xlsx", overwrite = TRUE) +} + +} +\seealso{ +\code{\link[=writeFormula]{writeFormula()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/mergeCells.Rd r-cran-openxlsx-4.2.5/man/mergeCells.Rd --- r-cran-openxlsx-4.2.4/man/mergeCells.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/mergeCells.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,58 +1,58 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{mergeCells} -\alias{mergeCells} -\title{Merge cells within a worksheet} -\usage{ -mergeCells(wb, sheet, cols, rows) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Columns to merge} - -\item{rows}{corresponding rows to merge} -} -\description{ -Merge cells within a worksheet -} -\details{ -As merged region must be rectangular, only min and max of cols and rows are used. -} -\examples{ -## Create a new workbook -wb <- createWorkbook() - -## Add a worksheet -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2") - -## Merge cells: Row 2 column C to F (3:6) -mergeCells(wb, "Sheet 1", cols = 2, rows = 3:6) - -## Merge cells:Rows 10 to 20 columns A to J (1:10) -mergeCells(wb, 1, cols = 1:10, rows = 10:20) - -## Intersecting merges -mergeCells(wb, 2, cols = 1:10, rows = 1) -mergeCells(wb, 2, cols = 5:10, rows = 2) -mergeCells(wb, 2, cols = c(1, 10), rows = 12) ## equivalent to 1:10 as only min/max are used -# mergeCells(wb, 2, cols = 1, rows = c(1,10)) # Throws error because intersects existing merge - -## remove merged cells -removeCellMerge(wb, 2, cols = 1, rows = 1) # removes any intersecting merges -mergeCells(wb, 2, cols = 1, rows = 1:10) # Now this works - -## Save workbook -\dontrun{ -saveWorkbook(wb, "mergeCellsExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{removeCellMerge}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{mergeCells} +\alias{mergeCells} +\title{Merge cells within a worksheet} +\usage{ +mergeCells(wb, sheet, cols, rows) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Columns to merge} + +\item{rows}{corresponding rows to merge} +} +\description{ +Merge cells within a worksheet +} +\details{ +As merged region must be rectangular, only min and max of cols and rows are used. +} +\examples{ +## Create a new workbook +wb <- createWorkbook() + +## Add a worksheet +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2") + +## Merge cells: Row 2 column C to F (3:6) +mergeCells(wb, "Sheet 1", cols = 2, rows = 3:6) + +## Merge cells:Rows 10 to 20 columns A to J (1:10) +mergeCells(wb, 1, cols = 1:10, rows = 10:20) + +## Intersecting merges +mergeCells(wb, 2, cols = 1:10, rows = 1) +mergeCells(wb, 2, cols = 5:10, rows = 2) +mergeCells(wb, 2, cols = c(1, 10), rows = 12) ## equivalent to 1:10 as only min/max are used +# mergeCells(wb, 2, cols = 1, rows = c(1,10)) # Throws error because intersects existing merge + +## remove merged cells +removeCellMerge(wb, 2, cols = 1, rows = 1) # removes any intersecting merges +mergeCells(wb, 2, cols = 1, rows = 1:10) # Now this works + +## Save workbook +\dontrun{ +saveWorkbook(wb, "mergeCellsExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=removeCellMerge]{removeCellMerge()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/modifyBaseFont.Rd r-cran-openxlsx-4.2.5/man/modifyBaseFont.Rd --- r-cran-openxlsx-4.2.4/man/modifyBaseFont.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/modifyBaseFont.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,40 +1,40 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{modifyBaseFont} -\alias{modifyBaseFont} -\title{Modify the default font} -\usage{ -modifyBaseFont(wb, fontSize = 11, fontColour = "black", fontName = "Calibri") -} -\arguments{ -\item{wb}{A workbook object} - -\item{fontSize}{font size} - -\item{fontColour}{font colour} - -\item{fontName}{Name of a font} -} -\description{ -Modify the default font for this workbook -} -\details{ -The font name is not validated in anyway. Excel replaces unknown font names -with Arial. Base font is black, size 11, Calibri. -} -\examples{ -## create a workbook -wb <- createWorkbook() -addWorksheet(wb, "S1") -## modify base font to size 10 Arial Narrow in red -modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") - -writeData(wb, "S1", iris) -writeDataTable(wb, "S1", x = iris, startCol = 10) ## font colour does not affect tables -\dontrun{ -saveWorkbook(wb, "modifyBaseFontExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{modifyBaseFont} +\alias{modifyBaseFont} +\title{Modify the default font} +\usage{ +modifyBaseFont(wb, fontSize = 11, fontColour = "black", fontName = "Calibri") +} +\arguments{ +\item{wb}{A workbook object} + +\item{fontSize}{font size} + +\item{fontColour}{font colour} + +\item{fontName}{Name of a font} +} +\description{ +Modify the default font for this workbook +} +\details{ +The font name is not validated in anyway. Excel replaces unknown font names +with Arial. Base font is black, size 11, Calibri. +} +\examples{ +## create a workbook +wb <- createWorkbook() +addWorksheet(wb, "S1") +## modify base font to size 10 Arial Narrow in red +modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") + +writeData(wb, "S1", iris) +writeDataTable(wb, "S1", x = iris, startCol = 10) ## font colour does not affect tables +\dontrun{ +saveWorkbook(wb, "modifyBaseFontExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/NamedRegion.Rd r-cran-openxlsx-4.2.5/man/NamedRegion.Rd --- r-cran-openxlsx-4.2.4/man/NamedRegion.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/NamedRegion.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{createNamedRegion} +\alias{createNamedRegion} +\alias{deleteNamedRegion} +\title{Create / delete a named region.} +\usage{ +createNamedRegion(wb, sheet, cols, rows, name, overwrite = FALSE) + +deleteNamedRegion(wb, name) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Numeric vector specifying columns to include in region} + +\item{rows}{Numeric vector specifying rows to include in region} + +\item{name}{Name for region. A character vector of length 1. Note region names musts be case-insensitive unique.} + +\item{overwrite}{Boolean. Overwrite if exists ? Default to FALSE} +} +\description{ +Create / delete a named region +} +\details{ +Region is given by: min(cols):max(cols) X min(rows):max(rows) +} +\examples{ +## create named regions +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") + +## specify region +writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) +createNamedRegion( + wb = wb, + sheet = 1, + name = "iris", + rows = 1:(nrow(iris) + 1), + cols = 1:ncol(iris) +) + + +## using writeData 'name' argument +writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) + +out_file <- tempfile(fileext = ".xlsx") +\dontrun{ +saveWorkbook(wb, out_file, overwrite = TRUE) + +## see named regions +getNamedRegions(wb) ## From Workbook object +getNamedRegions(out_file) ## From xlsx file + +## delete one +deleteNamedRegion(wb = wb, name = "iris2") +getNamedRegions(wb) + +## read named regions +df <- read.xlsx(wb, namedRegion = "iris") +head(df) + +df <- read.xlsx(out_file, namedRegion = "iris2") +head(df) +} + +} +\seealso{ +\code{\link[=getNamedRegions]{getNamedRegions()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/names.Rd r-cran-openxlsx-4.2.5/man/names.Rd --- r-cran-openxlsx-4.2.4/man/names.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/names.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,32 +1,32 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{names} -\alias{names} -\alias{names.Workbook} -\alias{names<-.Workbook} -\title{get or set worksheet names} -\usage{ -\method{names}{Workbook}(x) - -\method{names}{Workbook}(x) <- value -} -\arguments{ -\item{x}{A \code{Workbook} object} - -\item{value}{a character vector the same length as wb} -} -\description{ -get or set worksheet names -} -\examples{ - -wb <- createWorkbook() -addWorksheet(wb, "S1") -addWorksheet(wb, "S2") -addWorksheet(wb, "S3") - -names(wb) -names(wb)[[2]] <- "S2a" -names(wb) -names(wb) <- paste("Sheet", 1:3) -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{names} +\alias{names} +\alias{names.Workbook} +\alias{names<-.Workbook} +\title{get or set worksheet names} +\usage{ +\method{names}{Workbook}(x) + +\method{names}{Workbook}(x) <- value +} +\arguments{ +\item{x}{A \code{Workbook} object} + +\item{value}{a character vector the same length as wb} +} +\description{ +get or set worksheet names +} +\examples{ + +wb <- createWorkbook() +addWorksheet(wb, "S1") +addWorksheet(wb, "S2") +addWorksheet(wb, "S3") + +names(wb) +names(wb)[[2]] <- "S2a" +names(wb) +names(wb) <- paste("Sheet", 1:3) +} diff -Nru r-cran-openxlsx-4.2.4/man/openXL.Rd r-cran-openxlsx-4.2.5/man/openXL.Rd --- r-cran-openxlsx-4.2.4/man/openXL.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/openXL.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,43 +1,43 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/openXL.R -\name{openXL} -\alias{openXL} -\title{Open a Microsoft Excel file (xls/xlsx) or an openxlsx Workbook} -\usage{ -openXL(file=NULL) -} -\arguments{ -\item{file}{path to the Excel (xls/xlsx) file or Workbook object.} -} -\description{ -This function tries to open a Microsoft Excel -(xls/xlsx) file or an openxlsx Workbook with the proper -application, in a portable manner. - -In Windows (c) and Mac (c), it uses system default handlers, -given the file type. - -In Linux it searches (via \code{which}) for available xls/xlsx -reader applications (unless \code{options('openxlsx.excelApp')} -is set to the app bin path), and if it finds anything, sets -\code{options('openxlsx.excelApp')} to the program choosen by -the user via a menu (if many are present, otherwise it will -set the only available). Currently searched for apps are -Libreoffice/Openoffice (\code{soffice} bin), Gnumeric -(\code{gnumeric}) and Calligra Sheets (\code{calligrasheets}). -} -\examples{ -# file example -example(writeData) -# openXL("writeDataExample.xlsx") - -# (not yet saved) Workbook example -wb <- createWorkbook() -x <- mtcars[1:6, ] -addWorksheet(wb, "Cars") -writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) -# openXL(wb) -} -\author{ -Luca Braglia -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/openXL.R +\name{openXL} +\alias{openXL} +\title{Open a Microsoft Excel file (xls/xlsx) or an openxlsx Workbook} +\usage{ +openXL(file=NULL) +} +\arguments{ +\item{file}{path to the Excel (xls/xlsx) file or Workbook object.} +} +\description{ +This function tries to open a Microsoft Excel +(xls/xlsx) file or an openxlsx Workbook with the proper +application, in a portable manner. + +In Windows (c) and Mac (c), it uses system default handlers, +given the file type. + +In Linux it searches (via \code{which}) for available xls/xlsx +reader applications (unless \code{options('openxlsx.excelApp')} +is set to the app bin path), and if it finds anything, sets +\code{options('openxlsx.excelApp')} to the program choosen by +the user via a menu (if many are present, otherwise it will +set the only available). Currently searched for apps are +Libreoffice/Openoffice (\code{soffice} bin), Gnumeric +(\code{gnumeric}) and Calligra Sheets (\code{calligrasheets}). +} +\examples{ +# file example +example(writeData) +# openXL("writeDataExample.xlsx") + +# (not yet saved) Workbook example +wb <- createWorkbook() +x <- mtcars[1:6, ] +addWorksheet(wb, "Cars") +writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) +# openXL(wb) +} +\author{ +Luca Braglia +} diff -Nru r-cran-openxlsx-4.2.4/man/openxlsxFontSizeLookupTable.Rd r-cran-openxlsx-4.2.5/man/openxlsxFontSizeLookupTable.Rd --- r-cran-openxlsx-4.2.4/man/openxlsxFontSizeLookupTable.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/openxlsxFontSizeLookupTable.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,19 +1,19 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-fontSizeLookupTables.R -\docType{data} -\name{openxlsxFontSizeLookupTable} -\alias{openxlsxFontSizeLookupTable} -\alias{openxlsxFontSizeLookupTableBold} -\title{Font Size Lookup tables} -\format{ -A data.frame with column names corresponding to font names -} -\usage{ -openxlsxFontSizeLookupTable - -openxlsxFontSizeLookupTableBold -} -\description{ -Lookup tables for font size -} -\keyword{datasets} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-fontSizeLookupTables.R +\docType{data} +\name{openxlsxFontSizeLookupTable} +\alias{openxlsxFontSizeLookupTable} +\alias{openxlsxFontSizeLookupTableBold} +\title{Font Size Lookup tables} +\format{ +A data.frame with column names corresponding to font names +} +\usage{ +openxlsxFontSizeLookupTable + +openxlsxFontSizeLookupTableBold +} +\description{ +Lookup tables for font size +} +\keyword{datasets} diff -Nru r-cran-openxlsx-4.2.4/man/openxlsx_options.Rd r-cran-openxlsx-4.2.5/man/openxlsx_options.Rd --- r-cran-openxlsx-4.2.4/man/openxlsx_options.Rd 2021-06-08 14:29:52.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/openxlsx_options.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,45 +1,45 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/openxlsx.R -\docType{data} -\name{openxlsx_options} -\alias{openxlsx_options} -\alias{op.openxlsx} -\alias{openxlsx_getOp} -\alias{openxlsx_setOp} -\title{openxlsx Options} -\format{ -An object of class \code{list} of length 34. -} -\usage{ -op.openxlsx - -openxlsx_getOp(x, default = NULL) - -openxlsx_setOp(x, value) -} -\arguments{ -\item{x}{An option name (\code{"openxlsx."} prefix optional)} - -\item{default}{A default value if \code{NULL}} - -\item{value}{The new value for the option (optional if x is a named list)} -} -\description{ -See and get the openxlsx options -} -\details{ -\code{openxlsx_getOp()} retrieves the \code{"openxlsx"} options found in - \code{op.openxlsx}. If none are set (currently `NULL`) retrieves the - default option from \code{op.openxlsx}. This will also check that the - intended option is a standard option (listed in \code{op.openxlsx}) and - will provide a warning otherwise. - -\code{openxlsx_setOp()} is a safer way to set an option as it will first - check that the option is a standard option (as above) before setting. -} -\examples{ -openxlsx_getOp("borders") -op.openxlsx[["openxlsx.borders"]] - -} -\keyword{datasets} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/openxlsx.R +\docType{data} +\name{openxlsx_options} +\alias{openxlsx_options} +\alias{op.openxlsx} +\alias{openxlsx_getOp} +\alias{openxlsx_setOp} +\title{openxlsx Options} +\format{ +An object of class \code{list} of length 34. +} +\usage{ +op.openxlsx + +openxlsx_getOp(x, default = NULL) + +openxlsx_setOp(x, value) +} +\arguments{ +\item{x}{An option name (\code{"openxlsx."} prefix optional)} + +\item{default}{A default value if \code{NULL}} + +\item{value}{The new value for the option (optional if x is a named list)} +} +\description{ +See and get the openxlsx options +} +\details{ +\code{openxlsx_getOp()} retrieves the \code{"openxlsx"} options found in +\code{op.openxlsx}. If none are set (currently \code{NULL}) retrieves the +default option from \code{op.openxlsx}. This will also check that the +intended option is a standard option (listed in \code{op.openxlsx}) and +will provide a warning otherwise. + +\code{openxlsx_setOp()} is a safer way to set an option as it will first +check that the option is a standard option (as above) before setting. +} +\examples{ +openxlsx_getOp("borders") +op.openxlsx[["openxlsx.borders"]] + +} +\keyword{datasets} diff -Nru r-cran-openxlsx-4.2.4/man/openxlsx.Rd r-cran-openxlsx-4.2.5/man/openxlsx.Rd --- r-cran-openxlsx-4.2.4/man/openxlsx.Rd 2021-06-08 14:29:52.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/openxlsx.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,53 +1,53 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/openxlsx.R -\docType{package} -\name{openxlsx} -\alias{openxlsx} -\title{xlsx reading, writing and editing.} -\description{ -openxlsx simplifies the the process of writing and styling Excel xlsx files from R -and removes the dependency on Java. -} -\details{ -The openxlsx package uses global options, most to simplify formatting. These - are stored in the \code{op.openxlsx} object. - -\describe{ - \item{openxlsx.bandedCols}{FALSE} - \item{openxlsx.bandedRows}{TRUE} - \item{openxlsx.borderColour}{"black"} - \item{openxlsx.borders}{"none"} - \item{openxlsx.borderStyle}{"thin"} - \item{openxlsx.compressionLevel}{"9"} - \item{openxlsx.creator}{""} - \item{openxlsx.dateFormat}{"mm/dd/yyyy"} - \item{openxlsx.datetimeFormat}{"yyyy-mm-dd hh:mm:ss"} - \item{openxlsx.headerStyle}{NULL} - \item{openxlsx.keepNA}{FALSE} - \item{openxlsx.na.string}{NULL} - \item{openxlsx.numFmt}{NULL} - \item{openxlsx.orientation}{"portrait"} - \item{openxlsx.paperSize}{9} - \item{openxlsx.tabColour}{"TableStyleLight9"} - \item{openxlsx.tableStyle}{"TableStyleLight9"} - \item{openxlsx.withFilter}{NA Whether to write data with or without a - filter. If NA will make filters with \code{writeDataTable} and will not for - \code{writeData}} -} - -See the Formatting vignette for examples. - -Additional options -} -\seealso{ -\itemize{ - \item{\code{vignette("Introduction", package = "openxlsx")}} - \item{\code{vignette("formatting", package = "openxlsx")}} - \item{\code{\link{writeData}}} - \item{\code{\link{writeDataTable}}} - \item{\code{\link{write.xlsx}}} - \item{\code{\link{read.xlsx}}} - \item{\code{\link{op.openxlsx}}} - } -for examples -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/openxlsx.R +\docType{package} +\name{openxlsx} +\alias{openxlsx} +\title{xlsx reading, writing and editing.} +\description{ +openxlsx simplifies the the process of writing and styling Excel xlsx files from R +and removes the dependency on Java. +} +\details{ +The openxlsx package uses global options, most to simplify formatting. These +are stored in the \code{op.openxlsx} object. + +\describe{ +\item{openxlsx.bandedCols}{FALSE} +\item{openxlsx.bandedRows}{TRUE} +\item{openxlsx.borderColour}{"black"} +\item{openxlsx.borders}{"none"} +\item{openxlsx.borderStyle}{"thin"} +\item{openxlsx.compressionLevel}{"9"} +\item{openxlsx.creator}{""} +\item{openxlsx.dateFormat}{"mm/dd/yyyy"} +\item{openxlsx.datetimeFormat}{"yyyy-mm-dd hh:mm:ss"} +\item{openxlsx.headerStyle}{NULL} +\item{openxlsx.keepNA}{FALSE} +\item{openxlsx.na.string}{NULL} +\item{openxlsx.numFmt}{NULL} +\item{openxlsx.orientation}{"portrait"} +\item{openxlsx.paperSize}{9} +\item{openxlsx.tabColour}{"TableStyleLight9"} +\item{openxlsx.tableStyle}{"TableStyleLight9"} +\item{openxlsx.withFilter}{NA Whether to write data with or without a +filter. If NA will make filters with \code{writeDataTable} and will not for +\code{writeData}} +} + +See the Formatting vignette for examples. + +Additional options +} +\seealso{ +\itemize{ +\item{\code{vignette("Introduction", package = "openxlsx")}} +\item{\code{vignette("formatting", package = "openxlsx")}} +\item{\code{\link[=writeData]{writeData()}}} +\item{\code{\link[=writeDataTable]{writeDataTable()}}} +\item{\code{\link[=write.xlsx]{write.xlsx()}}} +\item{\code{\link[=read.xlsx]{read.xlsx()}}} +\item{\code{\link[=op.openxlsx]{op.openxlsx()}}} +} +for examples +} diff -Nru r-cran-openxlsx-4.2.4/man/pageBreak.Rd r-cran-openxlsx-4.2.5/man/pageBreak.Rd --- r-cran-openxlsx-4.2.4/man/pageBreak.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/pageBreak.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,36 +1,36 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{pageBreak} -\alias{pageBreak} -\title{add a page break to a worksheet} -\usage{ -pageBreak(wb, sheet, i, type = "row") -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{i}{row or column number to insert page break.} - -\item{type}{One of "row" or "column" for a row break or column break.} -} -\description{ -insert page breaks into a worksheet -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -writeData(wb, sheet = 1, x = iris) - -pageBreak(wb, sheet = 1, i = 10, type = "row") -pageBreak(wb, sheet = 1, i = 20, type = "row") -pageBreak(wb, sheet = 1, i = 2, type = "column") -\dontrun{ -saveWorkbook(wb, "pageBreakExample.xlsx", TRUE) -} -## In Excel: View tab -> Page Break Preview -} -\seealso{ -\code{\link{addWorksheet}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{pageBreak} +\alias{pageBreak} +\title{add a page break to a worksheet} +\usage{ +pageBreak(wb, sheet, i, type = "row") +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{i}{row or column number to insert page break.} + +\item{type}{One of "row" or "column" for a row break or column break.} +} +\description{ +insert page breaks into a worksheet +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +writeData(wb, sheet = 1, x = iris) + +pageBreak(wb, sheet = 1, i = 10, type = "row") +pageBreak(wb, sheet = 1, i = 20, type = "row") +pageBreak(wb, sheet = 1, i = 2, type = "column") +\dontrun{ +saveWorkbook(wb, "pageBreakExample.xlsx", TRUE) +} +## In Excel: View tab -> Page Break Preview +} +\seealso{ +\code{\link[=addWorksheet]{addWorksheet()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/pageSetup.Rd r-cran-openxlsx-4.2.5/man/pageSetup.Rd --- r-cran-openxlsx-4.2.4/man/pageSetup.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/pageSetup.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,165 +1,165 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{pageSetup} -\alias{pageSetup} -\title{Set page margins, orientation and print scaling} -\usage{ -pageSetup( - wb, - sheet, - orientation = NULL, - scale = 100, - left = 0.7, - right = 0.7, - top = 0.75, - bottom = 0.75, - header = 0.3, - footer = 0.3, - fitToWidth = FALSE, - fitToHeight = FALSE, - paperSize = NULL, - printTitleRows = NULL, - printTitleCols = NULL, - summaryRow = NULL, - summaryCol = NULL -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{orientation}{Page orientation. One of "portrait" or "landscape"} - -\item{scale}{Print scaling. Numeric value between 10 and 400} - -\item{left}{left page margin in inches} - -\item{right}{right page margin in inches} - -\item{top}{top page margin in inches} - -\item{bottom}{bottom page margin in inches} - -\item{header}{header margin in inches} - -\item{footer}{footer margin in inches} - -\item{fitToWidth}{If \code{TRUE}, worksheet is scaled to fit to page width on printing.} - -\item{fitToHeight}{If \code{TRUE}, worksheet is scaled to fit to page height on printing.} - -\item{paperSize}{See details. Default value is 9 (A4 paper).} - -\item{printTitleRows}{Rows to repeat at top of page when printing. Integer vector.} - -\item{printTitleCols}{Columns to repeat at left when printing. Integer vector.} - -\item{summaryRow}{Location of summary rows in groupings. One of "Above" or "Below".} - -\item{summaryCol}{Location of summary columns in groupings. One of "Right" or "Left".} -} -\description{ -Set page margins, orientation and print scaling -} -\details{ -paperSize is an integer corresponding to: -\itemize{ -\item{\bold{1}}{ Letter paper (8.5 in. by 11 in.)} -\item{\bold{2}}{ Letter small paper (8.5 in. by 11 in.)} -\item{\bold{3}}{ Tabloid paper (11 in. by 17 in.)} -\item{\bold{4}}{ Ledger paper (17 in. by 11 in.)} -\item{\bold{5}}{ Legal paper (8.5 in. by 14 in.)} -\item{\bold{6}}{ Statement paper (5.5 in. by 8.5 in.)} -\item{\bold{7}}{ Executive paper (7.25 in. by 10.5 in.)} -\item{\bold{8}}{ A3 paper (297 mm by 420 mm)} -\item{\bold{9}}{ A4 paper (210 mm by 297 mm)} -\item{\bold{10}}{ A4 small paper (210 mm by 297 mm)} -\item{\bold{11}}{ A5 paper (148 mm by 210 mm)} -\item{\bold{12}}{ B4 paper (250 mm by 353 mm)} -\item{\bold{13}}{ B5 paper (176 mm by 250 mm)} -\item{\bold{14}}{ Folio paper (8.5 in. by 13 in.)} -\item{\bold{15}}{ Quarto paper (215 mm by 275 mm)} -\item{\bold{16}}{ Standard paper (10 in. by 14 in.)} -\item{\bold{17}}{ Standard paper (11 in. by 17 in.)} -\item{\bold{18}}{ Note paper (8.5 in. by 11 in.)} -\item{\bold{19}}{ #9 envelope (3.875 in. by 8.875 in.)} -\item{\bold{20}}{ #10 envelope (4.125 in. by 9.5 in.)} -\item{\bold{21}}{ #11 envelope (4.5 in. by 10.375 in.)} -\item{\bold{22}}{ #12 envelope (4.75 in. by 11 in.)} -\item{\bold{23}}{ #14 envelope (5 in. by 11.5 in.)} -\item{\bold{24}}{ C paper (17 in. by 22 in.)} -\item{\bold{25}}{ D paper (22 in. by 34 in.)} -\item{\bold{26}}{ E paper (34 in. by 44 in.)} -\item{\bold{27}}{ DL envelope (110 mm by 220 mm)} -\item{\bold{28}}{ C5 envelope (162 mm by 229 mm)} -\item{\bold{29}}{ C3 envelope (324 mm by 458 mm)} -\item{\bold{30}}{ C4 envelope (229 mm by 324 mm)} -\item{\bold{31}}{ C6 envelope (114 mm by 162 mm)} -\item{\bold{32}}{ C65 envelope (114 mm by 229 mm)} -\item{\bold{33}}{ B4 envelope (250 mm by 353 mm)} -\item{\bold{34}}{ B5 envelope (176 mm by 250 mm)} -\item{\bold{35}}{ B6 envelope (176 mm by 125 mm)} -\item{\bold{36}}{ Italy envelope (110 mm by 230 mm)} -\item{\bold{37}}{ Monarch envelope (3.875 in. by 7.5 in.).} -\item{\bold{38}}{ 6 3/4 envelope (3.625 in. by 6.5 in.)} -\item{\bold{39}}{ US standard fanfold (14.875 in. by 11 in.)} -\item{\bold{40}}{ German standard fanfold (8.5 in. by 12 in.)} -\item{\bold{41}}{ German legal fanfold (8.5 in. by 13 in.)} -\item{\bold{42}}{ ISO B4 (250 mm by 353 mm)} -\item{\bold{43}}{ Japanese double postcard (200 mm by 148 mm)} -\item{\bold{44}}{ Standard paper (9 in. by 11 in.)} -\item{\bold{45}}{ Standard paper (10 in. by 11 in.)} -\item{\bold{46}}{ Standard paper (15 in. by 11 in.)} -\item{\bold{47}}{ Invite envelope (220 mm by 220 mm)} -\item{\bold{50}}{ Letter extra paper (9.275 in. by 12 in.)} -\item{\bold{51}}{ Legal extra paper (9.275 in. by 15 in.)} -\item{\bold{52}}{ Tabloid extra paper (11.69 in. by 18 in.)} -\item{\bold{53}}{ A4 extra paper (236 mm by 322 mm)} -\item{\bold{54}}{ Letter transverse paper (8.275 in. by 11 in.)} -\item{\bold{55}}{ A4 transverse paper (210 mm by 297 mm)} -\item{\bold{56}}{ Letter extra transverse paper (9.275 in. by 12 in.)} -\item{\bold{57}}{ SuperA/SuperA/A4 paper (227 mm by 356 mm)} -\item{\bold{58}}{ SuperB/SuperB/A3 paper (305 mm by 487 mm)} -\item{\bold{59}}{ Letter plus paper (8.5 in. by 12.69 in.)} -\item{\bold{60}}{ A4 plus paper (210 mm by 330 mm)} -\item{\bold{61}}{ A5 transverse paper (148 mm by 210 mm)} -\item{\bold{62}}{ JIS B5 transverse paper (182 mm by 257 mm)} -\item{\bold{63}}{ A3 extra paper (322 mm by 445 mm)} -\item{\bold{64}}{ A5 extra paper (174 mm by 235 mm)} -\item{\bold{65}}{ ISO B5 extra paper (201 mm by 276 mm)} -\item{\bold{66}}{ A2 paper (420 mm by 594 mm)} -\item{\bold{67}}{ A3 transverse paper (297 mm by 420 mm)} -\item{\bold{68}}{ A3 extra transverse paper (322 mm by 445 mm)} -} -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "S1") -addWorksheet(wb, "S2") -writeDataTable(wb, 1, x = iris[1:30, ]) -writeDataTable(wb, 2, x = iris[1:30, ], xy = c("C", 5)) - -## landscape page scaled to 50\% -pageSetup(wb, sheet = 1, orientation = "landscape", scale = 50) - -## portrait page scales to 300\% with 0.5in left and right margins -pageSetup(wb, sheet = 2, orientation = "portrait", scale = 300, left = 0.5, right = 0.5) - - -## print titles -addWorksheet(wb, "print_title_rows") -addWorksheet(wb, "print_title_cols") - -writeData(wb, "print_title_rows", rbind(iris, iris, iris, iris)) -writeData(wb, "print_title_cols", x = rbind(mtcars, mtcars, mtcars), rowNames = TRUE) - -pageSetup(wb, sheet = "print_title_rows", printTitleRows = 1) ## first row -pageSetup(wb, sheet = "print_title_cols", printTitleCols = 1, printTitleRows = 1) -\dontrun{ -saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker, Joshua Sturm -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{pageSetup} +\alias{pageSetup} +\title{Set page margins, orientation and print scaling} +\usage{ +pageSetup( + wb, + sheet, + orientation = NULL, + scale = 100, + left = 0.7, + right = 0.7, + top = 0.75, + bottom = 0.75, + header = 0.3, + footer = 0.3, + fitToWidth = FALSE, + fitToHeight = FALSE, + paperSize = NULL, + printTitleRows = NULL, + printTitleCols = NULL, + summaryRow = NULL, + summaryCol = NULL +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{orientation}{Page orientation. One of "portrait" or "landscape"} + +\item{scale}{Print scaling. Numeric value between 10 and 400} + +\item{left}{left page margin in inches} + +\item{right}{right page margin in inches} + +\item{top}{top page margin in inches} + +\item{bottom}{bottom page margin in inches} + +\item{header}{header margin in inches} + +\item{footer}{footer margin in inches} + +\item{fitToWidth}{If \code{TRUE}, worksheet is scaled to fit to page width on printing.} + +\item{fitToHeight}{If \code{TRUE}, worksheet is scaled to fit to page height on printing.} + +\item{paperSize}{See details. Default value is 9 (A4 paper).} + +\item{printTitleRows}{Rows to repeat at top of page when printing. Integer vector.} + +\item{printTitleCols}{Columns to repeat at left when printing. Integer vector.} + +\item{summaryRow}{Location of summary rows in groupings. One of "Above" or "Below".} + +\item{summaryCol}{Location of summary columns in groupings. One of "Right" or "Left".} +} +\description{ +Set page margins, orientation and print scaling +} +\details{ +paperSize is an integer corresponding to: +\itemize{ +\item{\strong{1}}{ Letter paper (8.5 in. by 11 in.)} +\item{\strong{2}}{ Letter small paper (8.5 in. by 11 in.)} +\item{\strong{3}}{ Tabloid paper (11 in. by 17 in.)} +\item{\strong{4}}{ Ledger paper (17 in. by 11 in.)} +\item{\strong{5}}{ Legal paper (8.5 in. by 14 in.)} +\item{\strong{6}}{ Statement paper (5.5 in. by 8.5 in.)} +\item{\strong{7}}{ Executive paper (7.25 in. by 10.5 in.)} +\item{\strong{8}}{ A3 paper (297 mm by 420 mm)} +\item{\strong{9}}{ A4 paper (210 mm by 297 mm)} +\item{\strong{10}}{ A4 small paper (210 mm by 297 mm)} +\item{\strong{11}}{ A5 paper (148 mm by 210 mm)} +\item{\strong{12}}{ B4 paper (250 mm by 353 mm)} +\item{\strong{13}}{ B5 paper (176 mm by 250 mm)} +\item{\strong{14}}{ Folio paper (8.5 in. by 13 in.)} +\item{\strong{15}}{ Quarto paper (215 mm by 275 mm)} +\item{\strong{16}}{ Standard paper (10 in. by 14 in.)} +\item{\strong{17}}{ Standard paper (11 in. by 17 in.)} +\item{\strong{18}}{ Note paper (8.5 in. by 11 in.)} +\item{\strong{19}}{ #9 envelope (3.875 in. by 8.875 in.)} +\item{\strong{20}}{ #10 envelope (4.125 in. by 9.5 in.)} +\item{\strong{21}}{ #11 envelope (4.5 in. by 10.375 in.)} +\item{\strong{22}}{ #12 envelope (4.75 in. by 11 in.)} +\item{\strong{23}}{ #14 envelope (5 in. by 11.5 in.)} +\item{\strong{24}}{ C paper (17 in. by 22 in.)} +\item{\strong{25}}{ D paper (22 in. by 34 in.)} +\item{\strong{26}}{ E paper (34 in. by 44 in.)} +\item{\strong{27}}{ DL envelope (110 mm by 220 mm)} +\item{\strong{28}}{ C5 envelope (162 mm by 229 mm)} +\item{\strong{29}}{ C3 envelope (324 mm by 458 mm)} +\item{\strong{30}}{ C4 envelope (229 mm by 324 mm)} +\item{\strong{31}}{ C6 envelope (114 mm by 162 mm)} +\item{\strong{32}}{ C65 envelope (114 mm by 229 mm)} +\item{\strong{33}}{ B4 envelope (250 mm by 353 mm)} +\item{\strong{34}}{ B5 envelope (176 mm by 250 mm)} +\item{\strong{35}}{ B6 envelope (176 mm by 125 mm)} +\item{\strong{36}}{ Italy envelope (110 mm by 230 mm)} +\item{\strong{37}}{ Monarch envelope (3.875 in. by 7.5 in.).} +\item{\strong{38}}{ 6 3/4 envelope (3.625 in. by 6.5 in.)} +\item{\strong{39}}{ US standard fanfold (14.875 in. by 11 in.)} +\item{\strong{40}}{ German standard fanfold (8.5 in. by 12 in.)} +\item{\strong{41}}{ German legal fanfold (8.5 in. by 13 in.)} +\item{\strong{42}}{ ISO B4 (250 mm by 353 mm)} +\item{\strong{43}}{ Japanese double postcard (200 mm by 148 mm)} +\item{\strong{44}}{ Standard paper (9 in. by 11 in.)} +\item{\strong{45}}{ Standard paper (10 in. by 11 in.)} +\item{\strong{46}}{ Standard paper (15 in. by 11 in.)} +\item{\strong{47}}{ Invite envelope (220 mm by 220 mm)} +\item{\strong{50}}{ Letter extra paper (9.275 in. by 12 in.)} +\item{\strong{51}}{ Legal extra paper (9.275 in. by 15 in.)} +\item{\strong{52}}{ Tabloid extra paper (11.69 in. by 18 in.)} +\item{\strong{53}}{ A4 extra paper (236 mm by 322 mm)} +\item{\strong{54}}{ Letter transverse paper (8.275 in. by 11 in.)} +\item{\strong{55}}{ A4 transverse paper (210 mm by 297 mm)} +\item{\strong{56}}{ Letter extra transverse paper (9.275 in. by 12 in.)} +\item{\strong{57}}{ SuperA/SuperA/A4 paper (227 mm by 356 mm)} +\item{\strong{58}}{ SuperB/SuperB/A3 paper (305 mm by 487 mm)} +\item{\strong{59}}{ Letter plus paper (8.5 in. by 12.69 in.)} +\item{\strong{60}}{ A4 plus paper (210 mm by 330 mm)} +\item{\strong{61}}{ A5 transverse paper (148 mm by 210 mm)} +\item{\strong{62}}{ JIS B5 transverse paper (182 mm by 257 mm)} +\item{\strong{63}}{ A3 extra paper (322 mm by 445 mm)} +\item{\strong{64}}{ A5 extra paper (174 mm by 235 mm)} +\item{\strong{65}}{ ISO B5 extra paper (201 mm by 276 mm)} +\item{\strong{66}}{ A2 paper (420 mm by 594 mm)} +\item{\strong{67}}{ A3 transverse paper (297 mm by 420 mm)} +\item{\strong{68}}{ A3 extra transverse paper (322 mm by 445 mm)} +} +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "S1") +addWorksheet(wb, "S2") +writeDataTable(wb, 1, x = iris[1:30, ]) +writeDataTable(wb, 2, x = iris[1:30, ], xy = c("C", 5)) + +## landscape page scaled to 50\% +pageSetup(wb, sheet = 1, orientation = "landscape", scale = 50) + +## portrait page scales to 300\% with 0.5in left and right margins +pageSetup(wb, sheet = 2, orientation = "portrait", scale = 300, left = 0.5, right = 0.5) + + +## print titles +addWorksheet(wb, "print_title_rows") +addWorksheet(wb, "print_title_cols") + +writeData(wb, "print_title_rows", rbind(iris, iris, iris, iris)) +writeData(wb, "print_title_cols", x = rbind(mtcars, mtcars, mtcars), rowNames = TRUE) + +pageSetup(wb, sheet = "print_title_rows", printTitleRows = 1) ## first row +pageSetup(wb, sheet = "print_title_cols", printTitleCols = 1, printTitleRows = 1) +\dontrun{ +saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker, Joshua Sturm +} diff -Nru r-cran-openxlsx-4.2.4/man/protectWorkbook.Rd r-cran-openxlsx-4.2.5/man/protectWorkbook.Rd --- r-cran-openxlsx-4.2.4/man/protectWorkbook.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/protectWorkbook.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,44 +1,47 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{protectWorkbook} -\alias{protectWorkbook} -\title{Protect a workbook from modifications} -\usage{ -protectWorkbook( - wb, - protect = TRUE, - password = NULL, - lockStructure = FALSE, - lockWindows = FALSE -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{protect}{Whether to protect or unprotect the sheet (default=TRUE)} - -\item{password}{(optional) password required to unprotect the workbook} - -\item{lockStructure}{Whether the workbook structure should be locked} - -\item{lockWindows}{Whether the window position of the spreadsheet should be locked} -} -\description{ -Protect or unprotect a workbook from modifications by the user in the graphical user interface. Replaces an existing protection. -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "S1") -protectWorkbook(wb, protect = TRUE, password = "Password", lockStructure = TRUE) -\dontrun{ -saveWorkbook(wb, "WorkBook_Protection.xlsx", overwrite = TRUE) -} -# Remove the protection -protectWorkbook(wb, protect = FALSE) -\dontrun{ -saveWorkbook(wb, "WorkBook_Protection_unprotected.xlsx", overwrite = TRUE) -} -} -\author{ -Reinhold Kainhofer -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{protectWorkbook} +\alias{protectWorkbook} +\title{Protect a workbook from modifications} +\usage{ +protectWorkbook( + wb, + protect = TRUE, + password = NULL, + lockStructure = FALSE, + lockWindows = FALSE, + type = 1L +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{protect}{Whether to protect or unprotect the sheet (default=TRUE)} + +\item{password}{(optional) password required to unprotect the workbook} + +\item{lockStructure}{Whether the workbook structure should be locked} + +\item{lockWindows}{Whether the window position of the spreadsheet should be locked} + +\item{type}{Lock type, default 1. From the xml documentation: 1 - Document is password protected. 2 - Document is recommended to be opened as read-only. 4 - Document is enforced to be opened as read-only. 8 - Document is locked for annotation.} +} +\description{ +Protect or unprotect a workbook from modifications by the user in the graphical user interface. Replaces an existing protection. +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "S1") +protectWorkbook(wb, protect = TRUE, password = "Password", lockStructure = TRUE) +\dontrun{ +saveWorkbook(wb, "WorkBook_Protection.xlsx", overwrite = TRUE) +} +# Remove the protection +protectWorkbook(wb, protect = FALSE) +\dontrun{ +saveWorkbook(wb, "WorkBook_Protection_unprotected.xlsx", overwrite = TRUE) +} +} +\author{ +Reinhold Kainhofer +} diff -Nru r-cran-openxlsx-4.2.4/man/protectWorksheet.Rd r-cran-openxlsx-4.2.5/man/protectWorksheet.Rd --- r-cran-openxlsx-4.2.4/man/protectWorksheet.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/protectWorksheet.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,90 +1,90 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{protectWorksheet} -\alias{protectWorksheet} -\title{Protect a worksheet from modifications} -\usage{ -protectWorksheet( - wb, - sheet, - protect = TRUE, - password = NULL, - lockSelectingLockedCells = NULL, - lockSelectingUnlockedCells = NULL, - lockFormattingCells = NULL, - lockFormattingColumns = NULL, - lockFormattingRows = NULL, - lockInsertingColumns = NULL, - lockInsertingRows = NULL, - lockInsertingHyperlinks = NULL, - lockDeletingColumns = NULL, - lockDeletingRows = NULL, - lockSorting = NULL, - lockAutoFilter = NULL, - lockPivotTables = NULL, - lockObjects = NULL, - lockScenarios = NULL -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{protect}{Whether to protect or unprotect the sheet (default=TRUE)} - -\item{password}{(optional) password required to unprotect the worksheet} - -\item{lockSelectingLockedCells}{Whether selecting locked cells is locked} - -\item{lockSelectingUnlockedCells}{Whether selecting unlocked cells is locked} - -\item{lockFormattingCells}{Whether formatting cells is locked} - -\item{lockFormattingColumns}{Whether formatting columns is locked} - -\item{lockFormattingRows}{Whether formatting rows is locked} - -\item{lockInsertingColumns}{Whether inserting columns is locked} - -\item{lockInsertingRows}{Whether inserting rows is locked} - -\item{lockInsertingHyperlinks}{Whether inserting hyperlinks is locked} - -\item{lockDeletingColumns}{Whether deleting columns is locked} - -\item{lockDeletingRows}{Whether deleting rows is locked} - -\item{lockSorting}{Whether sorting is locked} - -\item{lockAutoFilter}{Whether auto-filter is locked} - -\item{lockPivotTables}{Whether pivot tables are locked} - -\item{lockObjects}{Whether objects are locked} - -\item{lockScenarios}{Whether scenarios are locked} -} -\description{ -Protect or unprotect a worksheet from modifications by the user in the graphical user interface. Replaces an existing protection. -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "S1") -writeDataTable(wb, 1, x = iris[1:30, ]) -# Formatting cells / columns is allowed , but inserting / deleting columns is protected: -protectWorksheet(wb, "S1", - protect = TRUE, - lockFormattingCells = FALSE, lockFormattingColumns = FALSE, - lockInsertingColumns = TRUE, lockDeletingColumns = TRUE -) - -# Remove the protection -protectWorksheet(wb, "S1", protect = FALSE) -\dontrun{ -saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) -} -} -\author{ -Reinhold Kainhofer -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{protectWorksheet} +\alias{protectWorksheet} +\title{Protect a worksheet from modifications} +\usage{ +protectWorksheet( + wb, + sheet, + protect = TRUE, + password = NULL, + lockSelectingLockedCells = NULL, + lockSelectingUnlockedCells = NULL, + lockFormattingCells = NULL, + lockFormattingColumns = NULL, + lockFormattingRows = NULL, + lockInsertingColumns = NULL, + lockInsertingRows = NULL, + lockInsertingHyperlinks = NULL, + lockDeletingColumns = NULL, + lockDeletingRows = NULL, + lockSorting = NULL, + lockAutoFilter = NULL, + lockPivotTables = NULL, + lockObjects = NULL, + lockScenarios = NULL +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{protect}{Whether to protect or unprotect the sheet (default=TRUE)} + +\item{password}{(optional) password required to unprotect the worksheet} + +\item{lockSelectingLockedCells}{Whether selecting locked cells is locked} + +\item{lockSelectingUnlockedCells}{Whether selecting unlocked cells is locked} + +\item{lockFormattingCells}{Whether formatting cells is locked} + +\item{lockFormattingColumns}{Whether formatting columns is locked} + +\item{lockFormattingRows}{Whether formatting rows is locked} + +\item{lockInsertingColumns}{Whether inserting columns is locked} + +\item{lockInsertingRows}{Whether inserting rows is locked} + +\item{lockInsertingHyperlinks}{Whether inserting hyperlinks is locked} + +\item{lockDeletingColumns}{Whether deleting columns is locked} + +\item{lockDeletingRows}{Whether deleting rows is locked} + +\item{lockSorting}{Whether sorting is locked} + +\item{lockAutoFilter}{Whether auto-filter is locked} + +\item{lockPivotTables}{Whether pivot tables are locked} + +\item{lockObjects}{Whether objects are locked} + +\item{lockScenarios}{Whether scenarios are locked} +} +\description{ +Protect or unprotect a worksheet from modifications by the user in the graphical user interface. Replaces an existing protection. +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "S1") +writeDataTable(wb, 1, x = iris[1:30, ]) +# Formatting cells / columns is allowed , but inserting / deleting columns is protected: +protectWorksheet(wb, "S1", + protect = TRUE, + lockFormattingCells = FALSE, lockFormattingColumns = FALSE, + lockInsertingColumns = TRUE, lockDeletingColumns = TRUE +) + +# Remove the protection +protectWorksheet(wb, "S1", protect = FALSE) +\dontrun{ +saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) +} +} +\author{ +Reinhold Kainhofer +} diff -Nru r-cran-openxlsx-4.2.4/man/readWorkbook.Rd r-cran-openxlsx-4.2.5/man/readWorkbook.Rd --- r-cran-openxlsx-4.2.4/man/readWorkbook.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/readWorkbook.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,84 +1,84 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/readWorkbook.R -\name{readWorkbook} -\alias{readWorkbook} -\title{Read from an Excel file or Workbook object} -\usage{ -readWorkbook( - xlsxFile, - sheet = 1, - startRow = 1, - colNames = TRUE, - rowNames = FALSE, - detectDates = FALSE, - skipEmptyRows = TRUE, - skipEmptyCols = TRUE, - rows = NULL, - cols = NULL, - check.names = FALSE, - sep.names = ".", - namedRegion = NULL, - na.strings = "NA", - fillMergedCells = FALSE -) -} -\arguments{ -\item{xlsxFile}{An xlsx file, Workbook object or URL to xlsx file.} - -\item{sheet}{The name or index of the sheet to read data from.} - -\item{startRow}{first row to begin looking for data. Empty rows at the top of a file are always skipped, -regardless of the value of startRow.} - -\item{colNames}{If \code{TRUE}, the first row of data will be used as column names.} - -\item{rowNames}{If \code{TRUE}, first column of data will be used as row names.} - -\item{detectDates}{If \code{TRUE}, attempt to recognise dates and perform conversion.} - -\item{skipEmptyRows}{If \code{TRUE}, empty rows are skipped else empty rows after the first row containing data -will return a row of NAs.} - -\item{skipEmptyCols}{If \code{TRUE}, empty columns are skipped.} - -\item{rows}{A numeric vector specifying which rows in the Excel file to read. -If NULL, all rows are read.} - -\item{cols}{A numeric vector specifying which columns in the Excel file to read. -If NULL, all columns are read.} - -\item{check.names}{logical. If TRUE then the names of the variables in the data frame -are checked to ensure that they are syntactically valid variable names} - -\item{sep.names}{One character which substitutes blanks in column names. By default, "."} - -\item{namedRegion}{A named region in the Workbook. If not NULL startRow, rows and cols parameters are ignored.} - -\item{na.strings}{A character vector of strings which are to be interpreted as NA. Blank cells will be returned as NA.} - -\item{fillMergedCells}{If TRUE, the value in a merged cell is given to all cells within the merge.} -} -\value{ -data.frame -} -\description{ -Read data from an Excel file or Workbook object into a data.frame -} -\details{ -Creates a data.frame of all data in worksheet. -} -\examples{ -xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") -df1 <- readWorkbook(xlsxFile = xlsxFile, sheet = 1) - -xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") -df1 <- readWorkbook(xlsxFile = xlsxFile, sheet = 1, rows = c(1, 3, 5), cols = 1:3) -} -\seealso{ -\code{\link{getNamedRegions}} - -\code{\link{read.xlsx}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readWorkbook.R +\name{readWorkbook} +\alias{readWorkbook} +\title{Read from an Excel file or Workbook object} +\usage{ +readWorkbook( + xlsxFile, + sheet = 1, + startRow = 1, + colNames = TRUE, + rowNames = FALSE, + detectDates = FALSE, + skipEmptyRows = TRUE, + skipEmptyCols = TRUE, + rows = NULL, + cols = NULL, + check.names = FALSE, + sep.names = ".", + namedRegion = NULL, + na.strings = "NA", + fillMergedCells = FALSE +) +} +\arguments{ +\item{xlsxFile}{An xlsx file, Workbook object or URL to xlsx file.} + +\item{sheet}{The name or index of the sheet to read data from.} + +\item{startRow}{first row to begin looking for data. Empty rows at the top of a file are always skipped, +regardless of the value of startRow.} + +\item{colNames}{If \code{TRUE}, the first row of data will be used as column names.} + +\item{rowNames}{If \code{TRUE}, first column of data will be used as row names.} + +\item{detectDates}{If \code{TRUE}, attempt to recognise dates and perform conversion.} + +\item{skipEmptyRows}{If \code{TRUE}, empty rows are skipped else empty rows after the first row containing data +will return a row of NAs.} + +\item{skipEmptyCols}{If \code{TRUE}, empty columns are skipped.} + +\item{rows}{A numeric vector specifying which rows in the Excel file to read. +If NULL, all rows are read.} + +\item{cols}{A numeric vector specifying which columns in the Excel file to read. +If NULL, all columns are read.} + +\item{check.names}{logical. If TRUE then the names of the variables in the data frame +are checked to ensure that they are syntactically valid variable names} + +\item{sep.names}{One character which substitutes blanks in column names. By default, "."} + +\item{namedRegion}{A named region in the Workbook. If not NULL startRow, rows and cols parameters are ignored.} + +\item{na.strings}{A character vector of strings which are to be interpreted as NA. Blank cells will be returned as NA.} + +\item{fillMergedCells}{If TRUE, the value in a merged cell is given to all cells within the merge.} +} +\value{ +data.frame +} +\description{ +Read data from an Excel file or Workbook object into a data.frame +} +\details{ +Creates a data.frame of all data in worksheet. +} +\examples{ +xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") +df1 <- readWorkbook(xlsxFile = xlsxFile, sheet = 1) + +xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") +df1 <- readWorkbook(xlsxFile = xlsxFile, sheet = 1, rows = c(1, 3, 5), cols = 1:3) +} +\seealso{ +\code{\link[=getNamedRegions]{getNamedRegions()}} + +\code{\link[=read.xlsx]{read.xlsx()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/read.xlsx.Rd r-cran-openxlsx-4.2.5/man/read.xlsx.Rd --- r-cran-openxlsx-4.2.4/man/read.xlsx.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/read.xlsx.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,114 +1,114 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/readWorkbook.R -\name{read.xlsx} -\alias{read.xlsx} -\title{Read from an Excel file or Workbook object} -\usage{ -read.xlsx( - xlsxFile, - sheet, - startRow = 1, - colNames = TRUE, - rowNames = FALSE, - detectDates = FALSE, - skipEmptyRows = TRUE, - skipEmptyCols = TRUE, - rows = NULL, - cols = NULL, - check.names = FALSE, - sep.names = ".", - namedRegion = NULL, - na.strings = "NA", - fillMergedCells = FALSE -) -} -\arguments{ -\item{xlsxFile}{An xlsx file, Workbook object or URL to xlsx file.} - -\item{sheet}{The name or index of the sheet to read data from.} - -\item{startRow}{first row to begin looking for data. Empty rows at the top of a file are always skipped, -regardless of the value of startRow.} - -\item{colNames}{If \code{TRUE}, the first row of data will be used as column names.} - -\item{rowNames}{If \code{TRUE}, first column of data will be used as row names.} - -\item{detectDates}{If \code{TRUE}, attempt to recognise dates and perform conversion.} - -\item{skipEmptyRows}{If \code{TRUE}, empty rows are skipped else empty rows after the first row containing data -will return a row of NAs.} - -\item{skipEmptyCols}{If \code{TRUE}, empty columns are skipped.} - -\item{rows}{A numeric vector specifying which rows in the Excel file to read. -If NULL, all rows are read.} - -\item{cols}{A numeric vector specifying which columns in the Excel file to read. -If NULL, all columns are read.} - -\item{check.names}{logical. If TRUE then the names of the variables in the data frame -are checked to ensure that they are syntactically valid variable names} - -\item{sep.names}{One character which substitutes blanks in column names. By default, "."} - -\item{namedRegion}{A named region in the Workbook. If not NULL startRow, rows and cols parameters are ignored.} - -\item{na.strings}{A character vector of strings which are to be interpreted as NA. Blank cells will be returned as NA.} - -\item{fillMergedCells}{If TRUE, the value in a merged cell is given to all cells within the merge.} -} -\value{ -data.frame -} -\description{ -Read data from an Excel file or Workbook object into a data.frame -} -\details{ -Formulae written using writeFormula to a Workbook object will not get picked up by read.xlsx(). -This is because only the formula is written and left to be evaluated when the file is opened in Excel. -Opening, saving and closing the file with Excel will resolve this. -} -\examples{ - -xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") -df1 <- read.xlsx(xlsxFile = xlsxFile, sheet = 1, skipEmptyRows = FALSE) -sapply(df1, class) - -df2 <- read.xlsx(xlsxFile = xlsxFile, sheet = 3, skipEmptyRows = TRUE) -df2$Date <- convertToDate(df2$Date) -sapply(df2, class) -head(df2) - -df2 <- read.xlsx( - xlsxFile = xlsxFile, sheet = 3, skipEmptyRows = TRUE, - detectDates = TRUE -) -sapply(df2, class) -head(df2) - -wb <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -df3 <- read.xlsx(wb, sheet = 2, skipEmptyRows = FALSE, colNames = TRUE) -df4 <- read.xlsx(xlsxFile, sheet = 2, skipEmptyRows = FALSE, colNames = TRUE) -all.equal(df3, df4) - -wb <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -df3 <- read.xlsx(wb, - sheet = 2, skipEmptyRows = FALSE, - cols = c(1, 4), rows = c(1, 3, 4) -) - -## URL -## -\dontrun{ -xlsxFile <- "https://github.com/awalker89/openxlsx/raw/master/inst/readTest.xlsx" -head(read.xlsx(xlsxFile)) -} - -} -\seealso{ -\code{\link{getNamedRegions}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readWorkbook.R +\name{read.xlsx} +\alias{read.xlsx} +\title{Read from an Excel file or Workbook object} +\usage{ +read.xlsx( + xlsxFile, + sheet, + startRow = 1, + colNames = TRUE, + rowNames = FALSE, + detectDates = FALSE, + skipEmptyRows = TRUE, + skipEmptyCols = TRUE, + rows = NULL, + cols = NULL, + check.names = FALSE, + sep.names = ".", + namedRegion = NULL, + na.strings = "NA", + fillMergedCells = FALSE +) +} +\arguments{ +\item{xlsxFile}{An xlsx file, Workbook object or URL to xlsx file.} + +\item{sheet}{The name or index of the sheet to read data from.} + +\item{startRow}{first row to begin looking for data. Empty rows at the top of a file are always skipped, +regardless of the value of startRow.} + +\item{colNames}{If \code{TRUE}, the first row of data will be used as column names.} + +\item{rowNames}{If \code{TRUE}, first column of data will be used as row names.} + +\item{detectDates}{If \code{TRUE}, attempt to recognise dates and perform conversion.} + +\item{skipEmptyRows}{If \code{TRUE}, empty rows are skipped else empty rows after the first row containing data +will return a row of NAs.} + +\item{skipEmptyCols}{If \code{TRUE}, empty columns are skipped.} + +\item{rows}{A numeric vector specifying which rows in the Excel file to read. +If NULL, all rows are read.} + +\item{cols}{A numeric vector specifying which columns in the Excel file to read. +If NULL, all columns are read.} + +\item{check.names}{logical. If TRUE then the names of the variables in the data frame +are checked to ensure that they are syntactically valid variable names} + +\item{sep.names}{One character which substitutes blanks in column names. By default, "."} + +\item{namedRegion}{A named region in the Workbook. If not NULL startRow, rows and cols parameters are ignored.} + +\item{na.strings}{A character vector of strings which are to be interpreted as NA. Blank cells will be returned as NA.} + +\item{fillMergedCells}{If TRUE, the value in a merged cell is given to all cells within the merge.} +} +\value{ +data.frame +} +\description{ +Read data from an Excel file or Workbook object into a data.frame +} +\details{ +Formulae written using writeFormula to a Workbook object will not get picked up by read.xlsx(). +This is because only the formula is written and left to be evaluated when the file is opened in Excel. +Opening, saving and closing the file with Excel will resolve this. +} +\examples{ + +xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") +df1 <- read.xlsx(xlsxFile = xlsxFile, sheet = 1, skipEmptyRows = FALSE) +sapply(df1, class) + +df2 <- read.xlsx(xlsxFile = xlsxFile, sheet = 3, skipEmptyRows = TRUE) +df2$Date <- convertToDate(df2$Date) +sapply(df2, class) +head(df2) + +df2 <- read.xlsx( + xlsxFile = xlsxFile, sheet = 3, skipEmptyRows = TRUE, + detectDates = TRUE +) +sapply(df2, class) +head(df2) + +wb <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) +df3 <- read.xlsx(wb, sheet = 2, skipEmptyRows = FALSE, colNames = TRUE) +df4 <- read.xlsx(xlsxFile, sheet = 2, skipEmptyRows = FALSE, colNames = TRUE) +all.equal(df3, df4) + +wb <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) +df3 <- read.xlsx(wb, + sheet = 2, skipEmptyRows = FALSE, + cols = c(1, 4), rows = c(1, 3, 4) +) + +## URL +## +\dontrun{ +xlsxFile <- "https://github.com/awalker89/openxlsx/raw/master/inst/readTest.xlsx" +head(read.xlsx(xlsxFile)) +} + +} +\seealso{ +\code{\link[=getNamedRegions]{getNamedRegions()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/removeCellMerge.Rd r-cran-openxlsx-4.2.5/man/removeCellMerge.Rd --- r-cran-openxlsx-4.2.4/man/removeCellMerge.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/removeCellMerge.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,27 +1,27 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{removeCellMerge} -\alias{removeCellMerge} -\title{Create a new Workbook object} -\usage{ -removeCellMerge(wb, sheet, cols, rows) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{vector of column indices} - -\item{rows}{vector of row indices} -} -\description{ -Unmerges any merged cells that intersect -with the region specified by, min(cols):max(cols) X min(rows):max(rows) -} -\seealso{ -\code{\link{mergeCells}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{removeCellMerge} +\alias{removeCellMerge} +\title{Create a new Workbook object} +\usage{ +removeCellMerge(wb, sheet, cols, rows) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{vector of column indices} + +\item{rows}{vector of row indices} +} +\description{ +Unmerges any merged cells that intersect +with the region specified by, min(cols):max(cols) X min(rows):max(rows) +} +\seealso{ +\code{\link[=mergeCells]{mergeCells()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/removeColWidths.Rd r-cran-openxlsx-4.2.5/man/removeColWidths.Rd --- r-cran-openxlsx-4.2.4/man/removeColWidths.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/removeColWidths.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,34 +1,34 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{removeColWidths} -\alias{removeColWidths} -\title{Remove column widths from a worksheet} -\usage{ -removeColWidths(wb, sheet, cols) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Indices of columns to remove custom width (if any) from.} -} -\description{ -Remove column widths from a worksheet -} -\examples{ -## Create a new workbook -wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) - -## remove column widths in columns 1 to 20 -removeColWidths(wb, 1, cols = 1:20) -\dontrun{ -saveWorkbook(wb, "removeColWidthsExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{setColWidths}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{removeColWidths} +\alias{removeColWidths} +\title{Remove column widths from a worksheet} +\usage{ +removeColWidths(wb, sheet, cols) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Indices of columns to remove custom width (if any) from.} +} +\description{ +Remove column widths from a worksheet +} +\examples{ +## Create a new workbook +wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) + +## remove column widths in columns 1 to 20 +removeColWidths(wb, 1, cols = 1:20) +\dontrun{ +saveWorkbook(wb, "removeColWidthsExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=setColWidths]{setColWidths()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/removeComment.Rd r-cran-openxlsx-4.2.5/man/removeComment.Rd --- r-cran-openxlsx-4.2.4/man/removeComment.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/removeComment.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,28 +1,28 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CommentClass.R -\name{removeComment} -\alias{removeComment} -\title{Remove a comment from a cell} -\usage{ -removeComment(wb, sheet, cols, rows, gridExpand = TRUE) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A vector of names or indices of worksheets} - -\item{cols}{Columns to delete comments from} - -\item{rows}{Rows to delete comments from} - -\item{gridExpand}{If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) -will be removed.} -} -\description{ -Remove a cell comment from a worksheet -} -\seealso{ -\code{\link{createComment}} - -\code{\link{writeComment}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CommentClass.R +\name{removeComment} +\alias{removeComment} +\title{Remove a comment from a cell} +\usage{ +removeComment(wb, sheet, cols, rows, gridExpand = TRUE) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A vector of names or indices of worksheets} + +\item{cols}{Columns to delete comments from} + +\item{rows}{Rows to delete comments from} + +\item{gridExpand}{If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) +will be removed.} +} +\description{ +Remove a cell comment from a worksheet +} +\seealso{ +\code{\link[=createComment]{createComment()}} + +\code{\link[=writeComment]{writeComment()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/removeFilter.Rd r-cran-openxlsx-4.2.5/man/removeFilter.Rd --- r-cran-openxlsx-4.2.4/man/removeFilter.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/removeFilter.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,38 +1,38 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{removeFilter} -\alias{removeFilter} -\title{Remove a worksheet filter} -\usage{ -removeFilter(wb, sheet) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A vector of names or indices of worksheets} -} -\description{ -Removes filters from addFilter() and writeData() -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -addWorksheet(wb, "Sheet 2") -addWorksheet(wb, "Sheet 3") - -writeData(wb, 1, iris) -addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) - -## Equivalently -writeData(wb, 2, x = iris, withFilter = TRUE) - -## Similarly -writeDataTable(wb, 3, iris) - -## remove filters -removeFilter(wb, 1:2) ## remove filters -removeFilter(wb, 3) ## Does not affect tables! -\dontrun{ -saveWorkbook(wb, file = "removeFilterExample.xlsx", overwrite = TRUE) -} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{removeFilter} +\alias{removeFilter} +\title{Remove a worksheet filter} +\usage{ +removeFilter(wb, sheet) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A vector of names or indices of worksheets} +} +\description{ +Removes filters from addFilter() and writeData() +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +addWorksheet(wb, "Sheet 2") +addWorksheet(wb, "Sheet 3") + +writeData(wb, 1, iris) +addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) + +## Equivalently +writeData(wb, 2, x = iris, withFilter = TRUE) + +## Similarly +writeDataTable(wb, 3, iris) + +## remove filters +removeFilter(wb, 1:2) ## remove filters +removeFilter(wb, 3) ## Does not affect tables! +\dontrun{ +saveWorkbook(wb, file = "removeFilterExample.xlsx", overwrite = TRUE) +} +} diff -Nru r-cran-openxlsx-4.2.4/man/removeRowHeights.Rd r-cran-openxlsx-4.2.5/man/removeRowHeights.Rd --- r-cran-openxlsx-4.2.4/man/removeRowHeights.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/removeRowHeights.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,34 +1,34 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{removeRowHeights} -\alias{removeRowHeights} -\title{Remove custom row heights from a worksheet} -\usage{ -removeRowHeights(wb, sheet, rows) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{rows}{Indices of rows to remove custom height (if any) from.} -} -\description{ -Remove row heights from a worksheet -} -\examples{ -## Create a new workbook -wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) - -## remove any custom row heights in rows 1 to 10 -removeRowHeights(wb, 1, rows = 1:10) -\dontrun{ -saveWorkbook(wb, "removeRowHeightsExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{setRowHeights}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{removeRowHeights} +\alias{removeRowHeights} +\title{Remove custom row heights from a worksheet} +\usage{ +removeRowHeights(wb, sheet, rows) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{rows}{Indices of rows to remove custom height (if any) from.} +} +\description{ +Remove row heights from a worksheet +} +\examples{ +## Create a new workbook +wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) + +## remove any custom row heights in rows 1 to 10 +removeRowHeights(wb, 1, rows = 1:10) +\dontrun{ +saveWorkbook(wb, "removeRowHeightsExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=setRowHeights]{setRowHeights()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/removeTable.Rd r-cran-openxlsx-4.2.5/man/removeTable.Rd --- r-cran-openxlsx-4.2.4/man/removeTable.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/removeTable.Rd 2021-12-13 08:14:43.000000000 +0000 @@ -1,48 +1,48 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{removeTable} -\alias{removeTable} -\title{Remove an Excel table in a workbook} -\usage{ -removeTable(wb, sheet, table) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{table}{Name of table to remove. See \code{\link{getTables}}} -} -\value{ -character vector of table names on the specified sheet -} -\description{ -List Excel tables in a workbook -} -\examples{ - -wb <- createWorkbook() -addWorksheet(wb, sheetName = "Sheet 1") -addWorksheet(wb, sheetName = "Sheet 2") -writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") -writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - - -removeWorksheet(wb, sheet = 1) ## delete worksheet removes table objects - -writeDataTable(wb, sheet = 1, x = iris, tableName = "iris") -writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - -## removeTable() deletes table object and all data -getTables(wb, sheet = 1) -removeTable(wb = wb, sheet = 1, table = "iris") -writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) - -getTables(wb, sheet = 1) -removeTable(wb = wb, sheet = 1, table = "iris") -writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) -\dontrun{ -saveWorkbook(wb = wb, file = "removeTableExample.xlsx", overwrite = TRUE) -} - -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{removeTable} +\alias{removeTable} +\title{Remove an Excel table in a workbook} +\usage{ +removeTable(wb, sheet, table) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{table}{Name of table to remove. See \code{\link[=getTables]{getTables()}}} +} +\value{ +character vector of table names on the specified sheet +} +\description{ +List Excel tables in a workbook +} +\examples{ + +wb <- createWorkbook() +addWorksheet(wb, sheetName = "Sheet 1") +addWorksheet(wb, sheetName = "Sheet 2") +writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") +writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + + +removeWorksheet(wb, sheet = 1) ## delete worksheet removes table objects + +writeDataTable(wb, sheet = 1, x = iris, tableName = "iris") +writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + +## removeTable() deletes table object and all data +getTables(wb, sheet = 1) +removeTable(wb = wb, sheet = 1, table = "iris") +writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) + +getTables(wb, sheet = 1) +removeTable(wb = wb, sheet = 1, table = "iris") +writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) +\dontrun{ +saveWorkbook(wb = wb, file = "removeTableExample.xlsx", overwrite = TRUE) +} + +} diff -Nru r-cran-openxlsx-4.2.4/man/removeWorksheet.Rd r-cran-openxlsx-4.2.5/man/removeWorksheet.Rd --- r-cran-openxlsx-4.2.4/man/removeWorksheet.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/removeWorksheet.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,33 +1,33 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{removeWorksheet} -\alias{removeWorksheet} -\title{Remove a worksheet from a workbook} -\usage{ -removeWorksheet(wb, sheet) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} -} -\description{ -Remove a worksheet from a Workbook object - -Remove a worksheet from a workbook -} -\examples{ -## load a workbook -wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) - -## Remove sheet 2 -removeWorksheet(wb, 2) - -## save the modified workbook -\dontrun{ -saveWorkbook(wb, "removeWorksheetExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{removeWorksheet} +\alias{removeWorksheet} +\title{Remove a worksheet from a workbook} +\usage{ +removeWorksheet(wb, sheet) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} +} +\description{ +Remove a worksheet from a Workbook object + +Remove a worksheet from a workbook +} +\examples{ +## load a workbook +wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) + +## Remove sheet 2 +removeWorksheet(wb, 2) + +## save the modified workbook +\dontrun{ +saveWorkbook(wb, "removeWorksheetExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/renameWorksheet.Rd r-cran-openxlsx-4.2.5/man/renameWorksheet.Rd --- r-cran-openxlsx-4.2.4/man/renameWorksheet.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/renameWorksheet.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,48 +1,48 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{renameWorksheet} -\alias{renameWorksheet} -\title{Rename a worksheet} -\usage{ -renameWorksheet(wb, sheet, newName) -} -\arguments{ -\item{wb}{A Workbook object containing a worksheet} - -\item{sheet}{The name or index of the worksheet to rename} - -\item{newName}{The new name of the worksheet. No longer than 31 chars.} -} -\description{ -Rename a worksheet -} -\details{ -DEPRECATED. Use \code{\link{names}} -} -\examples{ - -## Create a new workbook -wb <- createWorkbook("CREATOR") - -## Add 3 worksheets -addWorksheet(wb, "Worksheet Name") -addWorksheet(wb, "This is worksheet 2") -addWorksheet(wb, "Not the best name") - -#' ## rename all worksheets -names(wb) <- c("A", "B", "C") - - -## Rename worksheet 1 & 3 -renameWorksheet(wb, 1, "New name for sheet 1") -names(wb)[[1]] <- "New name for sheet 1" -names(wb)[[3]] <- "A better name" - -## Save workbook -\dontrun{ -saveWorkbook(wb, "renameWorksheetExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{renameWorksheet} +\alias{renameWorksheet} +\title{Rename a worksheet} +\usage{ +renameWorksheet(wb, sheet, newName) +} +\arguments{ +\item{wb}{A Workbook object containing a worksheet} + +\item{sheet}{The name or index of the worksheet to rename} + +\item{newName}{The new name of the worksheet. No longer than 31 chars.} +} +\description{ +Rename a worksheet +} +\details{ +DEPRECATED. Use \code{\link[=names]{names()}} +} +\examples{ + +## Create a new workbook +wb <- createWorkbook("CREATOR") + +## Add 3 worksheets +addWorksheet(wb, "Worksheet Name") +addWorksheet(wb, "This is worksheet 2") +addWorksheet(wb, "Not the best name") + +#' ## rename all worksheets +names(wb) <- c("A", "B", "C") + + +## Rename worksheet 1 & 3 +renameWorksheet(wb, 1, "New name for sheet 1") +names(wb)[[1]] <- "New name for sheet 1" +names(wb)[[3]] <- "A better name" + +## Save workbook +\dontrun{ +saveWorkbook(wb, "renameWorksheetExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/replaceStyle.Rd r-cran-openxlsx-4.2.5/man/replaceStyle.Rd --- r-cran-openxlsx-4.2.4/man/replaceStyle.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/replaceStyle.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,44 +1,44 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{replaceStyle} -\alias{replaceStyle} -\title{Replace an existing cell style} -\usage{ -replaceStyle(wb, index, newStyle) -} -\arguments{ -\item{wb}{A workbook object} - -\item{index}{Index of style object to replace} - -\item{newStyle}{A style to replace the existing style as position index} -} -\description{ -Replace an existing cell style - -Replace a style object -} -\examples{ - -## load a workbook -wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) - -## create a new style and replace style 2 - -newStyle <- createStyle(fgFill = "#00FF00") - -## replace style 2 -getStyles(wb)[1:3] ## prints styles -replaceStyle(wb, 2, newStyle = newStyle) - -## Save workbook -\dontrun{ -saveWorkbook(wb, "replaceStyleExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{getStyles}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{replaceStyle} +\alias{replaceStyle} +\title{Replace an existing cell style} +\usage{ +replaceStyle(wb, index, newStyle) +} +\arguments{ +\item{wb}{A workbook object} + +\item{index}{Index of style object to replace} + +\item{newStyle}{A style to replace the existing style as position index} +} +\description{ +Replace an existing cell style + +Replace a style object +} +\examples{ + +## load a workbook +wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) + +## create a new style and replace style 2 + +newStyle <- createStyle(fgFill = "#00FF00") + +## replace style 2 +getStyles(wb)[1:3] ## prints styles +replaceStyle(wb, 2, newStyle = newStyle) + +## Save workbook +\dontrun{ +saveWorkbook(wb, "replaceStyleExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=getStyles]{getStyles()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/saveWorkbook.Rd r-cran-openxlsx-4.2.5/man/saveWorkbook.Rd --- r-cran-openxlsx-4.2.4/man/saveWorkbook.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/saveWorkbook.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,45 +1,45 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{saveWorkbook} -\alias{saveWorkbook} -\title{save Workbook to file} -\usage{ -saveWorkbook(wb, file, overwrite = FALSE, returnValue = FALSE) -} -\arguments{ -\item{wb}{A Workbook object to write to file} - -\item{file}{A character string naming an xlsx file} - -\item{overwrite}{If \code{TRUE}, overwrite any existing file.} - -\item{returnValue}{If \code{TRUE}, returns \code{TRUE} in case of a success, else \code{FALSE}. -If flag is \code{FALSE}, then no return value is returned.} -} -\description{ -save a Workbook object to file -} -\examples{ -## Create a new workbook and add a worksheet -wb <- createWorkbook("Creator of workbook") -addWorksheet(wb, sheetName = "My first worksheet") - -## Save workbook to working directory -\dontrun{ -saveWorkbook(wb, file = "saveWorkbookExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{createWorkbook}} - -\code{\link{addWorksheet}} - -\code{\link{loadWorkbook}} - -\code{\link{writeData}} - -\code{\link{writeDataTable}} -} -\author{ -Alexander Walker, Philipp Schauberger -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{saveWorkbook} +\alias{saveWorkbook} +\title{save Workbook to file} +\usage{ +saveWorkbook(wb, file, overwrite = FALSE, returnValue = FALSE) +} +\arguments{ +\item{wb}{A Workbook object to write to file} + +\item{file}{A character string naming an xlsx file} + +\item{overwrite}{If \code{TRUE}, overwrite any existing file.} + +\item{returnValue}{If \code{TRUE}, returns \code{TRUE} in case of a success, else \code{FALSE}. +If flag is \code{FALSE}, then no return value is returned.} +} +\description{ +save a Workbook object to file +} +\examples{ +## Create a new workbook and add a worksheet +wb <- createWorkbook("Creator of workbook") +addWorksheet(wb, sheetName = "My first worksheet") + +## Save workbook to working directory +\dontrun{ +saveWorkbook(wb, file = "saveWorkbookExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=createWorkbook]{createWorkbook()}} + +\code{\link[=addWorksheet]{addWorksheet()}} + +\code{\link[=loadWorkbook]{loadWorkbook()}} + +\code{\link[=writeData]{writeData()}} + +\code{\link[=writeDataTable]{writeDataTable()}} +} +\author{ +Alexander Walker, Philipp Schauberger +} diff -Nru r-cran-openxlsx-4.2.4/man/setColWidths.Rd r-cran-openxlsx-4.2.5/man/setColWidths.Rd --- r-cran-openxlsx-4.2.4/man/setColWidths.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/setColWidths.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,71 +1,71 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{setColWidths} -\alias{setColWidths} -\title{Set worksheet column widths} -\usage{ -setColWidths( - wb, - sheet, - cols, - widths = 8.43, - hidden = rep(FALSE, length(cols)), - ignoreMergedCells = FALSE -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Indices of cols to set width} - -\item{widths}{widths to set cols to specified in Excel column width units or "auto" for automatic sizing. The widths argument is -recycled to the length of cols.} - -\item{hidden}{Logical vector. If TRUE the column is hidden.} - -\item{ignoreMergedCells}{Ignore any cells that have been merged with other cells in the calculation of "auto" column widths.} -} -\description{ -Set worksheet column widths to specific width or "auto". -} -\details{ -The global min and max column width for "auto" columns is set by (default values show): -\itemize{ - \item{options("openxlsx.minWidth" = 3)} - \item{options("openxlsx.maxWidth" = 250)} ## This is the maximum width allowed in Excel -} - -NOTE: The calculation of column widths can be slow for large worksheets. - -NOTE: The \code{hidden} parameter may conflict with the one set in \code{groupColumns}; changing one will update the other. -} -\examples{ -## Create a new workbook -wb <- createWorkbook() - -## Add a worksheet -addWorksheet(wb, "Sheet 1") - - -## set col widths -setColWidths(wb, 1, cols = c(1, 4, 6, 7, 9), widths = c(16, 15, 12, 18, 33)) - -## auto columns -addWorksheet(wb, "Sheet 2") -writeData(wb, sheet = 2, x = iris) -setColWidths(wb, sheet = 2, cols = 1:5, widths = "auto") - -## Save workbook -\dontrun{ -saveWorkbook(wb, "setColWidthsExample.xlsx", overwrite = TRUE) -} - -} -\seealso{ -\code{\link{removeColWidths}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{setColWidths} +\alias{setColWidths} +\title{Set worksheet column widths} +\usage{ +setColWidths( + wb, + sheet, + cols, + widths = 8.43, + hidden = rep(FALSE, length(cols)), + ignoreMergedCells = FALSE +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Indices of cols to set width} + +\item{widths}{widths to set cols to specified in Excel column width units or "auto" for automatic sizing. The widths argument is +recycled to the length of cols.} + +\item{hidden}{Logical vector. If TRUE the column is hidden.} + +\item{ignoreMergedCells}{Ignore any cells that have been merged with other cells in the calculation of "auto" column widths.} +} +\description{ +Set worksheet column widths to specific width or "auto". +} +\details{ +The global min and max column width for "auto" columns is set by (default values show): +\itemize{ +\item{options("openxlsx.minWidth" = 3)} +\item{options("openxlsx.maxWidth" = 250)} ## This is the maximum width allowed in Excel +} + +NOTE: The calculation of column widths can be slow for large worksheets. + +NOTE: The \code{hidden} parameter may conflict with the one set in \code{groupColumns}; changing one will update the other. +} +\examples{ +## Create a new workbook +wb <- createWorkbook() + +## Add a worksheet +addWorksheet(wb, "Sheet 1") + + +## set col widths +setColWidths(wb, 1, cols = c(1, 4, 6, 7, 9), widths = c(16, 15, 12, 18, 33)) + +## auto columns +addWorksheet(wb, "Sheet 2") +writeData(wb, sheet = 2, x = iris) +setColWidths(wb, sheet = 2, cols = 1:5, widths = "auto") + +## Save workbook +\dontrun{ +saveWorkbook(wb, "setColWidthsExample.xlsx", overwrite = TRUE) +} + +} +\seealso{ +\code{\link[=removeColWidths]{removeColWidths()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/setFooter.Rd r-cran-openxlsx-4.2.5/man/setFooter.Rd --- r-cran-openxlsx-4.2.4/man/setFooter.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/setFooter.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,40 +1,40 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{setFooter} -\alias{setFooter} -\title{Set footer for all worksheets} -\usage{ -setFooter(wb, text, position = "center") -} -\arguments{ -\item{wb}{A workbook object} - -\item{text}{footer text. A character vector of length 1.} - -\item{position}{Position of text in footer. One of "left", "center" or "right"} -} -\description{ -DEPRECATED -} -\examples{ -\dontrun{ -wb <- createWorkbook("Edgar Anderson") -addWorksheet(wb, "S1") -writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) - -## set all headers -setHeader(wb, "This is a header", position = "center") -setHeader(wb, "To the left", position = "left") -setHeader(wb, "On the right", position = "right") - -## set all footers -setFooter(wb, "Center Footer Here", position = "center") -setFooter(wb, "Bottom left", position = "left") -setFooter(wb, Sys.Date(), position = "right") - -saveWorkbook(wb, "headerFooterExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{setFooter} +\alias{setFooter} +\title{Set footer for all worksheets} +\usage{ +setFooter(wb, text, position = "center") +} +\arguments{ +\item{wb}{A workbook object} + +\item{text}{footer text. A character vector of length 1.} + +\item{position}{Position of text in footer. One of "left", "center" or "right"} +} +\description{ +DEPRECATED +} +\examples{ +\dontrun{ +wb <- createWorkbook("Edgar Anderson") +addWorksheet(wb, "S1") +writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) + +## set all headers +setHeader(wb, "This is a header", position = "center") +setHeader(wb, "To the left", position = "left") +setHeader(wb, "On the right", position = "right") + +## set all footers +setFooter(wb, "Center Footer Here", position = "center") +setFooter(wb, "Bottom left", position = "left") +setFooter(wb, Sys.Date(), position = "right") + +saveWorkbook(wb, "headerFooterExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/setHeaderFooter.Rd r-cran-openxlsx-4.2.5/man/setHeaderFooter.Rd --- r-cran-openxlsx-4.2.4/man/setHeaderFooter.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/setHeaderFooter.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,101 +1,101 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{setHeaderFooter} -\alias{setHeaderFooter} -\title{Set document headers and footers} -\usage{ -setHeaderFooter( - wb, - sheet, - header = NULL, - footer = NULL, - evenHeader = NULL, - evenFooter = NULL, - firstHeader = NULL, - firstFooter = NULL -) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{header}{document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} - -\item{footer}{document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} - -\item{evenHeader}{document header for even pages.} - -\item{evenFooter}{document footer for even pages.} - -\item{firstHeader}{document header for first page only.} - -\item{firstFooter}{document footer for first page only.} -} -\description{ -Set document headers and footers -} -\details{ -Headers and footers can contain special tags -\itemize{ - \item{\bold{&[Page]}}{ Page number} - \item{\bold{&[Pages]}}{ Number of pages} - \item{\bold{&[Date]}}{ Current date} - \item{\bold{&[Time]}}{ Current time} - \item{\bold{&[Path]}}{ File path} - \item{\bold{&[File]}}{ File name} - \item{\bold{&[Tab]}}{ Worksheet name} -} -} -\examples{ -wb <- createWorkbook() - -addWorksheet(wb, "S1") -addWorksheet(wb, "S2") -addWorksheet(wb, "S3") -addWorksheet(wb, "S4") - -writeData(wb, 1, 1:400) -writeData(wb, 2, 1:400) -writeData(wb, 3, 3:400) -writeData(wb, 4, 3:400) - -setHeaderFooter(wb, - sheet = "S1", - header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), - footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), - evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), - evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), - firstHeader = c("TOP", "OF FIRST", "PAGE"), - firstFooter = c("BOTTOM", "OF FIRST", "PAGE") -) - -setHeaderFooter(wb, - sheet = 2, - header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), - footer = c("&[Path]&[File]", NA, "&[Tab]"), - firstHeader = c(NA, "Center Header of First Page", NA), - firstFooter = c(NA, "Center Footer of First Page", NA) -) - -setHeaderFooter(wb, - sheet = 3, - header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), - footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") -) - -setHeaderFooter(wb, - sheet = 4, - firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), - firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") -) -\dontrun{ -saveWorkbook(wb, "setHeaderFooterExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{addWorksheet}} to set headers and footers when adding a worksheet -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{setHeaderFooter} +\alias{setHeaderFooter} +\title{Set document headers and footers} +\usage{ +setHeaderFooter( + wb, + sheet, + header = NULL, + footer = NULL, + evenHeader = NULL, + evenFooter = NULL, + firstHeader = NULL, + firstFooter = NULL +) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{header}{document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} + +\item{footer}{document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.} + +\item{evenHeader}{document header for even pages.} + +\item{evenFooter}{document footer for even pages.} + +\item{firstHeader}{document header for first page only.} + +\item{firstFooter}{document footer for first page only.} +} +\description{ +Set document headers and footers +} +\details{ +Headers and footers can contain special tags +\itemize{ +\item{\strong{&[Page]}}{ Page number} +\item{\strong{&[Pages]}}{ Number of pages} +\item{\strong{&[Date]}}{ Current date} +\item{\strong{&[Time]}}{ Current time} +\item{\strong{&[Path]}}{ File path} +\item{\strong{&[File]}}{ File name} +\item{\strong{&[Tab]}}{ Worksheet name} +} +} +\examples{ +wb <- createWorkbook() + +addWorksheet(wb, "S1") +addWorksheet(wb, "S2") +addWorksheet(wb, "S3") +addWorksheet(wb, "S4") + +writeData(wb, 1, 1:400) +writeData(wb, 2, 1:400) +writeData(wb, 3, 3:400) +writeData(wb, 4, 3:400) + +setHeaderFooter(wb, + sheet = "S1", + header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), + footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), + evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), + evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), + firstHeader = c("TOP", "OF FIRST", "PAGE"), + firstFooter = c("BOTTOM", "OF FIRST", "PAGE") +) + +setHeaderFooter(wb, + sheet = 2, + header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), + footer = c("&[Path]&[File]", NA, "&[Tab]"), + firstHeader = c(NA, "Center Header of First Page", NA), + firstFooter = c(NA, "Center Footer of First Page", NA) +) + +setHeaderFooter(wb, + sheet = 3, + header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), + footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") +) + +setHeaderFooter(wb, + sheet = 4, + firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), + firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") +) +\dontrun{ +saveWorkbook(wb, "setHeaderFooterExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=addWorksheet]{addWorksheet()}} to set headers and footers when adding a worksheet +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/setHeader.Rd r-cran-openxlsx-4.2.5/man/setHeader.Rd --- r-cran-openxlsx-4.2.4/man/setHeader.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/setHeader.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,40 +1,40 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{setHeader} -\alias{setHeader} -\title{Set header for all worksheets} -\usage{ -setHeader(wb, text, position = "center") -} -\arguments{ -\item{wb}{A workbook object} - -\item{text}{header text. A character vector of length 1.} - -\item{position}{Position of text in header. One of "left", "center" or "right"} -} -\description{ -DEPRECATED -} -\examples{ -\dontrun{ -wb <- createWorkbook("Edgar Anderson") -addWorksheet(wb, "S1") -writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) - -## set all headers -setHeader(wb, "This is a header", position = "center") -setHeader(wb, "To the left", position = "left") -setHeader(wb, "On the right", position = "right") - -## set all footers -setFooter(wb, "Center Footer Here", position = "center") -setFooter(wb, "Bottom left", position = "left") -setFooter(wb, Sys.Date(), position = "right") - -saveWorkbook(wb, "headerHeaderExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{setHeader} +\alias{setHeader} +\title{Set header for all worksheets} +\usage{ +setHeader(wb, text, position = "center") +} +\arguments{ +\item{wb}{A workbook object} + +\item{text}{header text. A character vector of length 1.} + +\item{position}{Position of text in header. One of "left", "center" or "right"} +} +\description{ +DEPRECATED +} +\examples{ +\dontrun{ +wb <- createWorkbook("Edgar Anderson") +addWorksheet(wb, "S1") +writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) + +## set all headers +setHeader(wb, "This is a header", position = "center") +setHeader(wb, "To the left", position = "left") +setHeader(wb, "On the right", position = "right") + +## set all footers +setFooter(wb, "Center Footer Here", position = "center") +setFooter(wb, "Bottom left", position = "left") +setFooter(wb, Sys.Date(), position = "right") + +saveWorkbook(wb, "headerHeaderExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/setLastModifiedBy.Rd r-cran-openxlsx-4.2.5/man/setLastModifiedBy.Rd --- r-cran-openxlsx-4.2.4/man/setLastModifiedBy.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/setLastModifiedBy.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,24 +1,24 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{setLastModifiedBy} -\alias{setLastModifiedBy} -\title{Add another author to the meta data of the file.} -\usage{ -setLastModifiedBy(wb, LastModifiedBy) -} -\arguments{ -\item{wb}{A workbook object} - -\item{LastModifiedBy}{A string object with the name of the LastModifiedBy-User} -} -\description{ -Just a wrapper of wb$changeLastModifiedBy() -} -\examples{ - -wb <- createWorkbook() -setLastModifiedBy(wb, "test") -} -\author{ -Philipp Schauberger -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{setLastModifiedBy} +\alias{setLastModifiedBy} +\title{Add another author to the meta data of the file.} +\usage{ +setLastModifiedBy(wb, LastModifiedBy) +} +\arguments{ +\item{wb}{A workbook object} + +\item{LastModifiedBy}{A string object with the name of the LastModifiedBy-User} +} +\description{ +Just a wrapper of wb$changeLastModifiedBy() +} +\examples{ + +wb <- createWorkbook() +setLastModifiedBy(wb, "test") +} +\author{ +Philipp Schauberger +} diff -Nru r-cran-openxlsx-4.2.4/man/setRowHeights.Rd r-cran-openxlsx-4.2.5/man/setRowHeights.Rd --- r-cran-openxlsx-4.2.4/man/setRowHeights.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/setRowHeights.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,44 +1,44 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{setRowHeights} -\alias{setRowHeights} -\title{Set worksheet row heights} -\usage{ -setRowHeights(wb, sheet, rows, heights) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{rows}{Indices of rows to set height} - -\item{heights}{Heights to set rows to specified in Excel column height units.} -} -\description{ -Set worksheet row heights -} -\examples{ -## Create a new workbook -wb <- createWorkbook() - -## Add a worksheet -addWorksheet(wb, "Sheet 1") - -## set row heights -setRowHeights(wb, 1, rows = c(1, 4, 22, 2, 19), heights = c(24, 28, 32, 42, 33)) - -## overwrite row 1 height -setRowHeights(wb, 1, rows = 1, heights = 40) - -## Save workbook -\dontrun{ -saveWorkbook(wb, "setRowHeightsExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{removeRowHeights}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{setRowHeights} +\alias{setRowHeights} +\title{Set worksheet row heights} +\usage{ +setRowHeights(wb, sheet, rows, heights) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{rows}{Indices of rows to set height} + +\item{heights}{Heights to set rows to specified in Excel column height units.} +} +\description{ +Set worksheet row heights +} +\examples{ +## Create a new workbook +wb <- createWorkbook() + +## Add a worksheet +addWorksheet(wb, "Sheet 1") + +## set row heights +setRowHeights(wb, 1, rows = c(1, 4, 22, 2, 19), heights = c(24, 28, 32, 42, 33)) + +## overwrite row 1 height +setRowHeights(wb, 1, rows = 1, heights = 40) + +## Save workbook +\dontrun{ +saveWorkbook(wb, "setRowHeightsExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=removeRowHeights]{removeRowHeights()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/sheets.Rd r-cran-openxlsx-4.2.5/man/sheets.Rd --- r-cran-openxlsx-4.2.4/man/sheets.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/sheets.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,44 +1,44 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{sheets} -\alias{sheets} -\title{Returns names of worksheets.} -\usage{ -sheets(wb) -} -\arguments{ -\item{wb}{A workbook object} -} -\value{ -Name of worksheet(s) for a given index -} -\description{ -DEPRECATED. Use names(). -} -\details{ -DEPRECATED. Use \code{\link{names}} -} -\examples{ - -## Create a new workbook -wb <- createWorkbook() - -## Add some worksheets -addWorksheet(wb, "Worksheet Name") -addWorksheet(wb, "This is worksheet 2") -addWorksheet(wb, "The third worksheet") - -## Return names of sheets, can not be used for assignment. -names(wb) -# openXL(wb) - -names(wb) <- c("A", "B", "C") -names(wb) -# openXL(wb) -} -\seealso{ -\code{\link{names}} to rename a worksheet in a Workbook -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{sheets} +\alias{sheets} +\title{Returns names of worksheets.} +\usage{ +sheets(wb) +} +\arguments{ +\item{wb}{A workbook object} +} +\value{ +Name of worksheet(s) for a given index +} +\description{ +DEPRECATED. Use names(). +} +\details{ +DEPRECATED. Use \code{\link[=names]{names()}} +} +\examples{ + +## Create a new workbook +wb <- createWorkbook() + +## Add some worksheets +addWorksheet(wb, "Worksheet Name") +addWorksheet(wb, "This is worksheet 2") +addWorksheet(wb, "The third worksheet") + +## Return names of sheets, can not be used for assignment. +names(wb) +# openXL(wb) + +names(wb) <- c("A", "B", "C") +names(wb) +# openXL(wb) +} +\seealso{ +\code{\link[=names]{names()}} to rename a worksheet in a Workbook +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/sheetVisibility.Rd r-cran-openxlsx-4.2.5/man/sheetVisibility.Rd --- r-cran-openxlsx-4.2.4/man/sheetVisibility.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/sheetVisibility.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,37 +1,37 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{sheetVisibility} -\alias{sheetVisibility} -\alias{sheetVisibility<-} -\title{Get/set worksheet visible state} -\usage{ -sheetVisibility(wb) - -sheetVisibility(wb) <- value -} -\arguments{ -\item{wb}{A workbook object} - -\item{value}{a logical/character vector the same length as sheetVisibility(wb)} -} -\value{ -Character vector of worksheet names. - -Vector of "hidden", "visible", "veryHidden" -} -\description{ -Get and set worksheet visible state -} -\examples{ - -wb <- createWorkbook() -addWorksheet(wb, sheetName = "S1", visible = FALSE) -addWorksheet(wb, sheetName = "S2", visible = TRUE) -addWorksheet(wb, sheetName = "S3", visible = FALSE) - -sheetVisibility(wb) -sheetVisibility(wb)[1] <- TRUE ## show sheet 1 -sheetVisibility(wb)[2] <- FALSE ## hide sheet 2 -sheetVisibility(wb)[3] <- "hidden" ## hide sheet 3 -sheetVisibility(wb)[3] <- "veryHidden" ## hide sheet 3 from UI -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{sheetVisibility} +\alias{sheetVisibility} +\alias{sheetVisibility<-} +\title{Get/set worksheet visible state} +\usage{ +sheetVisibility(wb) + +sheetVisibility(wb) <- value +} +\arguments{ +\item{wb}{A workbook object} + +\item{value}{a logical/character vector the same length as sheetVisibility(wb)} +} +\value{ +Character vector of worksheet names. + +Vector of "hidden", "visible", "veryHidden" +} +\description{ +Get and set worksheet visible state +} +\examples{ + +wb <- createWorkbook() +addWorksheet(wb, sheetName = "S1", visible = FALSE) +addWorksheet(wb, sheetName = "S2", visible = TRUE) +addWorksheet(wb, sheetName = "S3", visible = FALSE) + +sheetVisibility(wb) +sheetVisibility(wb)[1] <- TRUE ## show sheet 1 +sheetVisibility(wb)[2] <- FALSE ## hide sheet 2 +sheetVisibility(wb)[3] <- "hidden" ## hide sheet 3 +sheetVisibility(wb)[3] <- "veryHidden" ## hide sheet 3 from UI +} diff -Nru r-cran-openxlsx-4.2.4/man/sheetVisible.Rd r-cran-openxlsx-4.2.5/man/sheetVisible.Rd --- r-cran-openxlsx-4.2.4/man/sheetVisible.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/sheetVisible.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,38 +1,38 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{sheetVisible} -\alias{sheetVisible} -\alias{sheetVisible<-} -\title{Get worksheet visible state.} -\usage{ -sheetVisible(wb) - -sheetVisible(wb) <- value -} -\arguments{ -\item{wb}{A workbook object} - -\item{value}{a logical vector the same length as sheetVisible(wb)} -} -\value{ -Character vector of worksheet names. - -TRUE if sheet is visible, FALSE if sheet is hidden -} -\description{ -DEPRECATED - Use function 'sheetVisibility() -} -\examples{ - -wb <- createWorkbook() -addWorksheet(wb, sheetName = "S1", visible = FALSE) -addWorksheet(wb, sheetName = "S2", visible = TRUE) -addWorksheet(wb, sheetName = "S3", visible = FALSE) - -sheetVisible(wb) -sheetVisible(wb)[1] <- TRUE ## show sheet 1 -sheetVisible(wb)[2] <- FALSE ## hide sheet 2 -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{sheetVisible} +\alias{sheetVisible} +\alias{sheetVisible<-} +\title{Get worksheet visible state.} +\usage{ +sheetVisible(wb) + +sheetVisible(wb) <- value +} +\arguments{ +\item{wb}{A workbook object} + +\item{value}{a logical vector the same length as sheetVisible(wb)} +} +\value{ +Character vector of worksheet names. + +TRUE if sheet is visible, FALSE if sheet is hidden +} +\description{ +DEPRECATED - Use function 'sheetVisibility() +} +\examples{ + +wb <- createWorkbook() +addWorksheet(wb, sheetName = "S1", visible = FALSE) +addWorksheet(wb, sheetName = "S2", visible = TRUE) +addWorksheet(wb, sheetName = "S3", visible = FALSE) + +sheetVisible(wb) +sheetVisible(wb)[1] <- TRUE ## show sheet 1 +sheetVisible(wb)[2] <- FALSE ## hide sheet 2 +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/showGridLines.Rd r-cran-openxlsx-4.2.5/man/showGridLines.Rd --- r-cran-openxlsx-4.2.4/man/showGridLines.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/showGridLines.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,30 +1,30 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{showGridLines} -\alias{showGridLines} -\title{Set worksheet gridlines to show or hide.} -\usage{ -showGridLines(wb, sheet, showGridLines = FALSE) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{showGridLines}{A logical. If \code{FALSE}, grid lines are hidden.} -} -\description{ -Set worksheet gridlines to show or hide. -} -\examples{ -wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -names(wb) ## list worksheets in workbook -showGridLines(wb, 1, showGridLines = FALSE) -showGridLines(wb, "testing", showGridLines = FALSE) -\dontrun{ -saveWorkbook(wb, "showGridLinesExample.xlsx", overwrite = TRUE) -} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{showGridLines} +\alias{showGridLines} +\title{Set worksheet gridlines to show or hide.} +\usage{ +showGridLines(wb, sheet, showGridLines = FALSE) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{showGridLines}{A logical. If \code{FALSE}, grid lines are hidden.} +} +\description{ +Set worksheet gridlines to show or hide. +} +\examples{ +wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +names(wb) ## list worksheets in workbook +showGridLines(wb, 1, showGridLines = FALSE) +showGridLines(wb, "testing", showGridLines = FALSE) +\dontrun{ +saveWorkbook(wb, "showGridLinesExample.xlsx", overwrite = TRUE) +} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/temp_xlsx.Rd r-cran-openxlsx-4.2.5/man/temp_xlsx.Rd --- r-cran-openxlsx-4.2.4/man/temp_xlsx.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/temp_xlsx.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{temp_xlsx} +\alias{temp_xlsx} +\title{helper function to create tempory directory for testing purpose} +\usage{ +temp_xlsx(name = "temp_xlsx") +} +\arguments{ +\item{name}{for the temp file} +} +\description{ +helper function to create tempory directory for testing purpose +} diff -Nru r-cran-openxlsx-4.2.4/man/ungroupColumns.Rd r-cran-openxlsx-4.2.5/man/ungroupColumns.Rd --- r-cran-openxlsx-4.2.4/man/ungroupColumns.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/ungroupColumns.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,27 +1,27 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{ungroupColumns} -\alias{ungroupColumns} -\title{Ungroup Columns} -\usage{ -ungroupColumns(wb, sheet, cols) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{cols}{Indices of columns to ungroup} -} -\description{ -Ungroup a selection of columns -} -\details{ -If column was previously hidden, it will now be shown -} -\seealso{ -\code{\link{ungroupRows}} To ungroup rows -} -\author{ -Joshua Sturm -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{ungroupColumns} +\alias{ungroupColumns} +\title{Ungroup Columns} +\usage{ +ungroupColumns(wb, sheet, cols) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{cols}{Indices of columns to ungroup} +} +\description{ +Ungroup a selection of columns +} +\details{ +If column was previously hidden, it will now be shown +} +\seealso{ +\code{\link[=ungroupRows]{ungroupRows()}} To ungroup rows +} +\author{ +Joshua Sturm +} diff -Nru r-cran-openxlsx-4.2.4/man/ungroupRows.Rd r-cran-openxlsx-4.2.5/man/ungroupRows.Rd --- r-cran-openxlsx-4.2.4/man/ungroupRows.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/ungroupRows.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,27 +1,27 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{ungroupRows} -\alias{ungroupRows} -\title{Ungroup Rows} -\usage{ -ungroupRows(wb, sheet, rows) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A name or index of a worksheet} - -\item{rows}{Indices of rows to ungroup} -} -\description{ -Ungroup a selection of rows -} -\details{ -If row was previously hidden, it will now be shown -} -\seealso{ -\code{\link{ungroupColumns}} -} -\author{ -Joshua Sturm -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{ungroupRows} +\alias{ungroupRows} +\title{Ungroup Rows} +\usage{ +ungroupRows(wb, sheet, rows) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A name or index of a worksheet} + +\item{rows}{Indices of rows to ungroup} +} +\description{ +Ungroup a selection of rows +} +\details{ +If row was previously hidden, it will now be shown +} +\seealso{ +\code{\link[=ungroupColumns]{ungroupColumns()}} +} +\author{ +Joshua Sturm +} diff -Nru r-cran-openxlsx-4.2.4/man/worksheetOrder.Rd r-cran-openxlsx-4.2.5/man/worksheetOrder.Rd --- r-cran-openxlsx-4.2.4/man/worksheetOrder.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/worksheetOrder.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,49 +1,49 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/wrappers.R -\name{worksheetOrder} -\alias{worksheetOrder} -\alias{worksheetOrder<-} -\title{Order of worksheets in xlsx file} -\usage{ -worksheetOrder(wb) - -worksheetOrder(wb) <- value -} -\arguments{ -\item{wb}{A workbook object} - -\item{value}{Vector specifying order to write worksheets to file} -} -\description{ -Get/set order of worksheets in a Workbook object -} -\details{ -This function does not reorder the worksheets within the workbook object, it simply -shuffles the order when writing to file. -} -\examples{ -## setup a workbook with 3 worksheets -wb <- createWorkbook() -addWorksheet(wb = wb, sheetName = "Sheet 1", gridLines = FALSE) -writeDataTable(wb = wb, sheet = 1, x = iris) - -addWorksheet(wb = wb, sheetName = "mtcars (Sheet 2)", gridLines = FALSE) -writeData(wb = wb, sheet = 2, x = mtcars) - -addWorksheet(wb = wb, sheetName = "Sheet 3", gridLines = FALSE) -writeData(wb = wb, sheet = 3, x = Formaldehyde) - -worksheetOrder(wb) -names(wb) -worksheetOrder(wb) <- c(1, 3, 2) # switch position of sheets 2 & 3 -writeData(wb, 2, 'This is still the "mtcars" worksheet', startCol = 15) -worksheetOrder(wb) -names(wb) ## ordering within workbook is not changed -\dontrun{ -saveWorkbook(wb, "worksheetOrderExample.xlsx", overwrite = TRUE) -} -worksheetOrder(wb) <- c(3, 2, 1) -\dontrun{ -saveWorkbook(wb, "worksheetOrderExample2.xlsx", overwrite = TRUE) -} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrappers.R +\name{worksheetOrder} +\alias{worksheetOrder} +\alias{worksheetOrder<-} +\title{Order of worksheets in xlsx file} +\usage{ +worksheetOrder(wb) + +worksheetOrder(wb) <- value +} +\arguments{ +\item{wb}{A workbook object} + +\item{value}{Vector specifying order to write worksheets to file} +} +\description{ +Get/set order of worksheets in a Workbook object +} +\details{ +This function does not reorder the worksheets within the workbook object, it simply +shuffles the order when writing to file. +} +\examples{ +## setup a workbook with 3 worksheets +wb <- createWorkbook() +addWorksheet(wb = wb, sheetName = "Sheet 1", gridLines = FALSE) +writeDataTable(wb = wb, sheet = 1, x = iris) + +addWorksheet(wb = wb, sheetName = "mtcars (Sheet 2)", gridLines = FALSE) +writeData(wb = wb, sheet = 2, x = mtcars) + +addWorksheet(wb = wb, sheetName = "Sheet 3", gridLines = FALSE) +writeData(wb = wb, sheet = 3, x = Formaldehyde) + +worksheetOrder(wb) +names(wb) +worksheetOrder(wb) <- c(1, 3, 2) # switch position of sheets 2 & 3 +writeData(wb, 2, 'This is still the "mtcars" worksheet', startCol = 15) +worksheetOrder(wb) +names(wb) ## ordering within workbook is not changed +\dontrun{ +saveWorkbook(wb, "worksheetOrderExample.xlsx", overwrite = TRUE) +} +worksheetOrder(wb) <- c(3, 2, 1) +\dontrun{ +saveWorkbook(wb, "worksheetOrderExample2.xlsx", overwrite = TRUE) +} +} diff -Nru r-cran-openxlsx-4.2.4/man/writeComment.Rd r-cran-openxlsx-4.2.5/man/writeComment.Rd --- r-cran-openxlsx-4.2.4/man/writeComment.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/writeComment.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,47 +1,47 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CommentClass.R -\name{writeComment} -\alias{writeComment} -\title{write a cell comment} -\usage{ -writeComment(wb, sheet, col, row, comment, xy = NULL) -} -\arguments{ -\item{wb}{A workbook object} - -\item{sheet}{A vector of names or indices of worksheets} - -\item{col}{Column a column number of letter} - -\item{row}{A row number.} - -\item{comment}{A Comment object. See \code{\link{createComment}}.} - -\item{xy}{An alternative to specifying \code{col} and -\code{row} individually. A vector of the form -\code{c(col, row)}.} -} -\description{ -Write a Comment object to a worksheet -} -\examples{ -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") - -c1 <- createComment(comment = "this is comment") -writeComment(wb, 1, col = "B", row = 10, comment = c1) - -s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) -s2 <- createStyle(fontSize = 9, fontColour = "black") - -c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) -c2 - -writeComment(wb, 1, col = 6, row = 3, comment = c2) -\dontrun{ -saveWorkbook(wb, file = "writeCommentExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{createComment}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CommentClass.R +\name{writeComment} +\alias{writeComment} +\title{write a cell comment} +\usage{ +writeComment(wb, sheet, col, row, comment, xy = NULL) +} +\arguments{ +\item{wb}{A workbook object} + +\item{sheet}{A vector of names or indices of worksheets} + +\item{col}{Column a column number of letter} + +\item{row}{A row number.} + +\item{comment}{A Comment object. See \code{\link[=createComment]{createComment()}}.} + +\item{xy}{An alternative to specifying \code{col} and +\code{row} individually. A vector of the form +\code{c(col, row)}.} +} +\description{ +Write a Comment object to a worksheet +} +\examples{ +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") + +c1 <- createComment(comment = "this is comment") +writeComment(wb, 1, col = "B", row = 10, comment = c1) + +s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) +s2 <- createStyle(fontSize = 9, fontColour = "black") + +c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) +c2 + +writeComment(wb, 1, col = 6, row = 3, comment = c2) +\dontrun{ +saveWorkbook(wb, file = "writeCommentExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=createComment]{createComment()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/writeData.Rd r-cran-openxlsx-4.2.5/man/writeData.Rd --- r-cran-openxlsx-4.2.4/man/writeData.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/writeData.Rd 2021-12-13 12:05:14.000000000 +0000 @@ -1,213 +1,213 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/writeData.R -\name{writeData} -\alias{writeData} -\title{Write an object to a worksheet} -\usage{ -writeData( - wb, - sheet, - x, - startCol = 1, - startRow = 1, - array = FALSE, - xy = NULL, - colNames = TRUE, - rowNames = FALSE, - headerStyle = openxlsx_getOp("headerStyle"), - borders = openxlsx_getOp("borders", "none"), - borderColour = openxlsx_getOp("borderColour", "black"), - borderStyle = openxlsx_getOp("borderStyle", "thin"), - withFilter = openxlsx_getOp("withFilter", FALSE), - keepNA = openxlsx_getOp("keepNA", FALSE), - na.string = openxlsx_getOp("na.string"), - name = NULL, - sep = ", ", - col.names, - row.names -) -} -\arguments{ -\item{wb}{A Workbook object containing a worksheet.} - -\item{sheet}{The worksheet to write to. Can be the worksheet index or name.} - -\item{x}{Object to be written. For classes supported look at the examples.} - -\item{startCol}{A vector specifying the starting column to write to.} - -\item{startRow}{A vector specifying the starting row to write to.} - -\item{array}{A bool if the function written is of type array} - -\item{xy}{An alternative to specifying \code{startCol} and -\code{startRow} individually. A vector of the form -\code{c(startCol, startRow)}.} - -\item{colNames}{If \code{TRUE}, column names of x are written.} - -\item{rowNames}{If \code{TRUE}, data.frame row names of x are written.} - -\item{headerStyle}{Custom style to apply to column names.} - -\item{borders}{Either "\code{none}" (default), "\code{surrounding}", -"\code{columns}", "\code{rows}" or \emph{respective abbreviations}. If -"\code{surrounding}", a border is drawn around the data. If "\code{rows}", -a surrounding border is drawn with a border around each row. If -"\code{columns}", a surrounding border is drawn with a border between -each column. If "\code{all}" all cell borders are drawn.} - -\item{borderColour}{Colour of cell border. A valid colour (belonging to \code{colours()} or a hex colour code, eg see \href{https://www.webfx.com/web-design/color-picker/}{here}).} - -\item{borderStyle}{Border line style -\itemize{ - \item{\bold{none}}{ no border} - \item{\bold{thin}}{ thin border} - \item{\bold{medium}}{ medium border} - \item{\bold{dashed}}{ dashed border} - \item{\bold{dotted}}{ dotted border} - \item{\bold{thick}}{ thick border} - \item{\bold{double}}{ double line border} - \item{\bold{hair}}{ hairline border} - \item{\bold{mediumDashed}}{ medium weight dashed border} - \item{\bold{dashDot}}{ dash-dot border} - \item{\bold{mediumDashDot}}{ medium weight dash-dot border} - \item{\bold{dashDotDot}}{ dash-dot-dot border} - \item{\bold{mediumDashDotDot}}{ medium weight dash-dot-dot border} - \item{\bold{slantDashDot}}{ slanted dash-dot border} - }} - -\item{withFilter}{If \code{TRUE} or \code{NA}, add filters to the column name row. NOTE can only have one filter per worksheet.} - -\item{keepNA}{If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty.} - -\item{na.string}{If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel.} - -\item{name}{If not NULL, a named region is defined.} - -\item{sep}{Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep).} - -\item{row.names, col.names}{Deprecated, please use \code{rowNames}, \code{colNames} instead} -} -\value{ -invisible(0) -} -\description{ -Write an object to worksheet with optional styling. -} -\details{ -Formulae written using writeFormula to a Workbook object will not get picked up by read.xlsx(). -This is because only the formula is written and left to Excel to evaluate the formula when the file is opened in Excel. -} -\examples{ - -## See formatting vignette for further examples. - -## Options for default styling (These are the defaults) -options("openxlsx.borderColour" = "black") -options("openxlsx.borderStyle" = "thin") -options("openxlsx.dateFormat" = "mm/dd/yyyy") -options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -options("openxlsx.numFmt" = NULL) - -## Change the default border colour to #4F81BD -options("openxlsx.borderColour" = "#4F81BD") - - -##################################################################################### -## Create Workbook object and add worksheets -wb <- createWorkbook() - -## Add worksheets -addWorksheet(wb, "Cars") -addWorksheet(wb, "Formula") - - -x <- mtcars[1:6, ] -writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) - -##################################################################################### -## Bordering - -writeData(wb, "Cars", x, - rowNames = TRUE, startCol = "O", startRow = 3, - borders = "surrounding", borderColour = "black" -) ## black border - -writeData(wb, "Cars", x, - rowNames = TRUE, - startCol = 2, startRow = 12, borders = "columns" -) - -writeData(wb, "Cars", x, - rowNames = TRUE, - startCol = "O", startRow = 12, borders = "rows" -) - - -##################################################################################### -## Header Styles - -hs1 <- createStyle( - fgFill = "#DCE6F1", halign = "CENTER", textDecoration = "italic", - border = "Bottom" -) - -writeData(wb, "Cars", x, - colNames = TRUE, rowNames = TRUE, startCol = "B", - startRow = 23, borders = "rows", headerStyle = hs1, borderStyle = "dashed" -) - - -hs2 <- createStyle( - fontColour = "#ffffff", fgFill = "#4F80BD", - halign = "center", valign = "center", textDecoration = "bold", - border = "TopBottomLeftRight" -) - -writeData(wb, "Cars", x, - colNames = TRUE, rowNames = TRUE, - startCol = "O", startRow = 23, borders = "columns", headerStyle = hs2 -) - - - - -##################################################################################### -## Hyperlinks -## - vectors/columns with class 'hyperlink' are written as hyperlinks' - -v <- rep("https://CRAN.R-project.org/", 4) -names(v) <- paste0("Hyperlink", 1:4) # Optional: names will be used as display text -class(v) <- "hyperlink" -writeData(wb, "Cars", x = v, xy = c("B", 32)) - - -##################################################################################### -## Formulas -## - vectors/columns with class 'formula' are written as formulas' - -df <- data.frame( - x = 1:3, y = 1:3, - z = paste0(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), - stringsAsFactors = FALSE -) - -class(df$z) <- c(class(df$z), "formula") - -writeData(wb, sheet = "Formula", x = df) - - -##################################################################################### -## Save workbook -## Open in excel without saving file: openXL(wb) -\dontrun{ -saveWorkbook(wb, "writeDataExample.xlsx", overwrite = TRUE) -} -} -\seealso{ -\code{\link{writeDataTable}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/writeData.R +\name{writeData} +\alias{writeData} +\title{Write an object to a worksheet} +\usage{ +writeData( + wb, + sheet, + x, + startCol = 1, + startRow = 1, + array = FALSE, + xy = NULL, + colNames = TRUE, + rowNames = FALSE, + headerStyle = openxlsx_getOp("headerStyle"), + borders = openxlsx_getOp("borders", "none"), + borderColour = openxlsx_getOp("borderColour", "black"), + borderStyle = openxlsx_getOp("borderStyle", "thin"), + withFilter = openxlsx_getOp("withFilter", FALSE), + keepNA = openxlsx_getOp("keepNA", FALSE), + na.string = openxlsx_getOp("na.string"), + name = NULL, + sep = ", ", + col.names, + row.names +) +} +\arguments{ +\item{wb}{A Workbook object containing a worksheet.} + +\item{sheet}{The worksheet to write to. Can be the worksheet index or name.} + +\item{x}{Object to be written. For classes supported look at the examples.} + +\item{startCol}{A vector specifying the starting column to write to.} + +\item{startRow}{A vector specifying the starting row to write to.} + +\item{array}{A bool if the function written is of type array} + +\item{xy}{An alternative to specifying \code{startCol} and +\code{startRow} individually. A vector of the form +\code{c(startCol, startRow)}.} + +\item{colNames}{If \code{TRUE}, column names of x are written.} + +\item{rowNames}{If \code{TRUE}, data.frame row names of x are written.} + +\item{headerStyle}{Custom style to apply to column names.} + +\item{borders}{Either "\code{none}" (default), "\code{surrounding}", +"\code{columns}", "\code{rows}" or \emph{respective abbreviations}. If +"\code{surrounding}", a border is drawn around the data. If "\code{rows}", +a surrounding border is drawn with a border around each row. If +"\code{columns}", a surrounding border is drawn with a border between +each column. If "\code{all}" all cell borders are drawn.} + +\item{borderColour}{Colour of cell border. A valid colour (belonging to \code{colours()} or a hex colour code, eg see \href{https://www.w3schools.com/colors/colors_picker.asp}{here}).} + +\item{borderStyle}{Border line style +\itemize{ +\item{\strong{none}}{ no border} +\item{\strong{thin}}{ thin border} +\item{\strong{medium}}{ medium border} +\item{\strong{dashed}}{ dashed border} +\item{\strong{dotted}}{ dotted border} +\item{\strong{thick}}{ thick border} +\item{\strong{double}}{ double line border} +\item{\strong{hair}}{ hairline border} +\item{\strong{mediumDashed}}{ medium weight dashed border} +\item{\strong{dashDot}}{ dash-dot border} +\item{\strong{mediumDashDot}}{ medium weight dash-dot border} +\item{\strong{dashDotDot}}{ dash-dot-dot border} +\item{\strong{mediumDashDotDot}}{ medium weight dash-dot-dot border} +\item{\strong{slantDashDot}}{ slanted dash-dot border} +}} + +\item{withFilter}{If \code{TRUE} or \code{NA}, add filters to the column name row. NOTE can only have one filter per worksheet.} + +\item{keepNA}{If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty.} + +\item{na.string}{If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel.} + +\item{name}{If not NULL, a named region is defined.} + +\item{sep}{Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep).} + +\item{row.names, col.names}{Deprecated, please use \code{rowNames}, \code{colNames} instead} +} +\value{ +invisible(0) +} +\description{ +Write an object to worksheet with optional styling. +} +\details{ +Formulae written using writeFormula to a Workbook object will not get picked up by read.xlsx(). +This is because only the formula is written and left to Excel to evaluate the formula when the file is opened in Excel. +} +\examples{ + +## See formatting vignette for further examples. + +## Options for default styling (These are the defaults) +options("openxlsx.borderColour" = "black") +options("openxlsx.borderStyle" = "thin") +options("openxlsx.dateFormat" = "mm/dd/yyyy") +options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +options("openxlsx.numFmt" = NULL) + +## Change the default border colour to #4F81BD +options("openxlsx.borderColour" = "#4F81BD") + + +##################################################################################### +## Create Workbook object and add worksheets +wb <- createWorkbook() + +## Add worksheets +addWorksheet(wb, "Cars") +addWorksheet(wb, "Formula") + + +x <- mtcars[1:6, ] +writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) + +##################################################################################### +## Bordering + +writeData(wb, "Cars", x, + rowNames = TRUE, startCol = "O", startRow = 3, + borders = "surrounding", borderColour = "black" +) ## black border + +writeData(wb, "Cars", x, + rowNames = TRUE, + startCol = 2, startRow = 12, borders = "columns" +) + +writeData(wb, "Cars", x, + rowNames = TRUE, + startCol = "O", startRow = 12, borders = "rows" +) + + +##################################################################################### +## Header Styles + +hs1 <- createStyle( + fgFill = "#DCE6F1", halign = "CENTER", textDecoration = "italic", + border = "Bottom" +) + +writeData(wb, "Cars", x, + colNames = TRUE, rowNames = TRUE, startCol = "B", + startRow = 23, borders = "rows", headerStyle = hs1, borderStyle = "dashed" +) + + +hs2 <- createStyle( + fontColour = "#ffffff", fgFill = "#4F80BD", + halign = "center", valign = "center", textDecoration = "bold", + border = "TopBottomLeftRight" +) + +writeData(wb, "Cars", x, + colNames = TRUE, rowNames = TRUE, + startCol = "O", startRow = 23, borders = "columns", headerStyle = hs2 +) + + + + +##################################################################################### +## Hyperlinks +## - vectors/columns with class 'hyperlink' are written as hyperlinks' + +v <- rep("https://CRAN.R-project.org/", 4) +names(v) <- paste0("Hyperlink", 1:4) # Optional: names will be used as display text +class(v) <- "hyperlink" +writeData(wb, "Cars", x = v, xy = c("B", 32)) + + +##################################################################################### +## Formulas +## - vectors/columns with class 'formula' are written as formulas' + +df <- data.frame( + x = 1:3, y = 1:3, + z = paste0(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), + stringsAsFactors = FALSE +) + +class(df$z) <- c(class(df$z), "formula") + +writeData(wb, sheet = "Formula", x = df) + + +##################################################################################### +## Save workbook +## Open in excel without saving file: openXL(wb) +\dontrun{ +saveWorkbook(wb, "writeDataExample.xlsx", overwrite = TRUE) +} +} +\seealso{ +\code{\link[=writeDataTable]{writeDataTable()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/writeDataTable.Rd r-cran-openxlsx-4.2.5/man/writeDataTable.Rd --- r-cran-openxlsx-4.2.4/man/writeDataTable.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/writeDataTable.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,195 +1,195 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/writeDataTable.R -\name{writeDataTable} -\alias{writeDataTable} -\title{Write to a worksheet as an Excel table} -\usage{ -writeDataTable( - wb, - sheet, - x, - startCol = 1, - startRow = 1, - xy = NULL, - colNames = TRUE, - rowNames = FALSE, - tableStyle = openxlsx_getOp("tableStyle", "TableStyleLight9"), - tableName = NULL, - headerStyle = openxlsx_getOp("headerStyle"), - withFilter = openxlsx_getOp("withFilter", TRUE), - keepNA = openxlsx_getOp("keepNA", FALSE), - na.string = openxlsx_getOp("na.string"), - sep = ", ", - stack = FALSE, - firstColumn = openxlsx_getOp("firstColumn", FALSE), - lastColumn = openxlsx_getOp("lastColumn", FALSE), - bandedRows = openxlsx_getOp("bandedRows", TRUE), - bandedCols = openxlsx_getOp("bandedCols", FALSE), - col.names, - row.names -) -} -\arguments{ -\item{wb}{A Workbook object containing a -worksheet.} - -\item{sheet}{The worksheet to write to. Can be the worksheet index or name.} - -\item{x}{A dataframe.} - -\item{startCol}{A vector specifying the starting column to write df} - -\item{startRow}{A vector specifying the starting row to write df} - -\item{xy}{An alternative to specifying startCol and startRow individually. -A vector of the form c(startCol, startRow)} - -\item{colNames}{If \code{TRUE}, column names of x are written.} - -\item{rowNames}{If \code{TRUE}, row names of x are written.} - -\item{tableStyle}{Any excel table style name or "none" (see "formatting" vignette).} - -\item{tableName}{name of table in workbook. The table name must be unique.} - -\item{headerStyle}{Custom style to apply to column names.} - -\item{withFilter}{If \code{TRUE} or \code{NA}, columns with have filters in the first row.} - -\item{keepNA}{If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty.} - -\item{na.string}{If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel.} - -\item{sep}{Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep).} - -\item{stack}{If \code{TRUE} the new style is merged with any existing cell styles. If FALSE, any -existing style is replaced by the new style. -\cr\cr -\cr\bold{The below options correspond to Excel table options:} -\cr -\if{html}{\figure{tableoptions.png}{options: width="40\%" alt="Figure: table_options.png"}} -\if{latex}{\figure{tableoptions.pdf}{options: width=7cm}}} - -\item{firstColumn}{logical. If TRUE, the first column is bold} - -\item{lastColumn}{logical. If TRUE, the last column is bold} - -\item{bandedRows}{logical. If TRUE, rows are colour banded} - -\item{bandedCols}{logical. If TRUE, the columns are colour banded} - -\item{row.names, col.names}{Deprecated, please use \code{rowNames}, \code{colNames} instead} -} -\description{ -Write to a worksheet and format as an Excel table -} -\details{ -columns of x with class Date/POSIXt, currency, accounting, -hyperlink, percentage are automatically styled as dates, currency, accounting, -hyperlinks, percentages respectively. -} -\examples{ -## see package vignettes for further examples. - -##################################################################################### -## Create Workbook object and add worksheets -wb <- createWorkbook() -addWorksheet(wb, "S1") -addWorksheet(wb, "S2") -addWorksheet(wb, "S3") - - -##################################################################################### -## -- write data.frame as an Excel table with column filters -## -- default table style is "TableStyleMedium2" - -writeDataTable(wb, "S1", x = iris) - -writeDataTable(wb, "S2", - x = mtcars, xy = c("B", 3), rowNames = TRUE, - tableStyle = "TableStyleLight9" -) - -df <- data.frame( - "Date" = Sys.Date() - 0:19, - "T" = TRUE, "F" = FALSE, - "Time" = Sys.time() - 0:19 * 60 * 60, - "Cash" = paste("$", 1:20), "Cash2" = 31:50, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(0, 1, length.out = 20), - "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE -) - -## openxlsx will apply default Excel styling for these classes -class(df$Cash) <- c(class(df$Cash), "currency") -class(df$Cash2) <- c(class(df$Cash2), "accounting") -class(df$hLink) <- "hyperlink" -class(df$Percentage) <- c(class(df$Percentage), "percentage") -class(df$TinyNumbers) <- c(class(df$TinyNumbers), "scientific") - -writeDataTable(wb, "S3", x = df, startRow = 4, rowNames = TRUE, tableStyle = "TableStyleMedium9") - -##################################################################################### -## Additional Header Styling and remove column filters - -writeDataTable(wb, - sheet = 1, x = iris, startCol = 7, headerStyle = createStyle(textRotation = 45), - withFilter = FALSE -) - - -##################################################################################### -## Save workbook -## Open in excel without saving file: openXL(wb) -\dontrun{ -saveWorkbook(wb, "writeDataTableExample.xlsx", overwrite = TRUE) -} - - - - - -##################################################################################### -## Pre-defined table styles gallery - -wb <- createWorkbook(paste0("tableStylesGallery.xlsx")) -addWorksheet(wb, "Style Samples") -for (i in 1:21) { - style <- paste0("TableStyleLight", i) - writeDataTable(wb, - x = data.frame(style), sheet = 1, - tableStyle = style, startRow = 1, startCol = i * 3 - 2 - ) -} - -for (i in 1:28) { - style <- paste0("TableStyleMedium", i) - writeDataTable(wb, - x = data.frame(style), sheet = 1, - tableStyle = style, startRow = 4, startCol = i * 3 - 2 - ) -} - -for (i in 1:11) { - style <- paste0("TableStyleDark", i) - writeDataTable(wb, - x = data.frame(style), sheet = 1, - tableStyle = style, startRow = 7, startCol = i * 3 - 2 - ) -} - -## openXL(wb) -\dontrun{ -saveWorkbook(wb, file = "tableStylesGallery.xlsx", overwrite = TRUE) -} - -} -\seealso{ -\code{\link{addWorksheet}} - -\code{\link{writeData}} - -\code{\link{removeTable}} - -\code{\link{getTables}} -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/writeDataTable.R +\name{writeDataTable} +\alias{writeDataTable} +\title{Write to a worksheet as an Excel table} +\usage{ +writeDataTable( + wb, + sheet, + x, + startCol = 1, + startRow = 1, + xy = NULL, + colNames = TRUE, + rowNames = FALSE, + tableStyle = openxlsx_getOp("tableStyle", "TableStyleLight9"), + tableName = NULL, + headerStyle = openxlsx_getOp("headerStyle"), + withFilter = openxlsx_getOp("withFilter", TRUE), + keepNA = openxlsx_getOp("keepNA", FALSE), + na.string = openxlsx_getOp("na.string"), + sep = ", ", + stack = FALSE, + firstColumn = openxlsx_getOp("firstColumn", FALSE), + lastColumn = openxlsx_getOp("lastColumn", FALSE), + bandedRows = openxlsx_getOp("bandedRows", TRUE), + bandedCols = openxlsx_getOp("bandedCols", FALSE), + col.names, + row.names +) +} +\arguments{ +\item{wb}{A Workbook object containing a +worksheet.} + +\item{sheet}{The worksheet to write to. Can be the worksheet index or name.} + +\item{x}{A dataframe.} + +\item{startCol}{A vector specifying the starting column to write df} + +\item{startRow}{A vector specifying the starting row to write df} + +\item{xy}{An alternative to specifying startCol and startRow individually. +A vector of the form c(startCol, startRow)} + +\item{colNames}{If \code{TRUE}, column names of x are written.} + +\item{rowNames}{If \code{TRUE}, row names of x are written.} + +\item{tableStyle}{Any excel table style name or "none" (see "formatting" vignette).} + +\item{tableName}{name of table in workbook. The table name must be unique.} + +\item{headerStyle}{Custom style to apply to column names.} + +\item{withFilter}{If \code{TRUE} or \code{NA}, columns with have filters in the first row.} + +\item{keepNA}{If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty.} + +\item{na.string}{If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel.} + +\item{sep}{Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep).} + +\item{stack}{If \code{TRUE} the new style is merged with any existing cell styles. If FALSE, any +existing style is replaced by the new style. +\cr\cr +\cr\strong{The below options correspond to Excel table options:} +\cr +\if{html}{\figure{tableoptions.png}{options: width="40\%" alt="Figure: table_options.png"}} +\if{latex}{\figure{tableoptions.pdf}{options: width=7cm}}} + +\item{firstColumn}{logical. If TRUE, the first column is bold} + +\item{lastColumn}{logical. If TRUE, the last column is bold} + +\item{bandedRows}{logical. If TRUE, rows are colour banded} + +\item{bandedCols}{logical. If TRUE, the columns are colour banded} + +\item{row.names, col.names}{Deprecated, please use \code{rowNames}, \code{colNames} instead} +} +\description{ +Write to a worksheet and format as an Excel table +} +\details{ +columns of x with class Date/POSIXt, currency, accounting, +hyperlink, percentage are automatically styled as dates, currency, accounting, +hyperlinks, percentages respectively. +} +\examples{ +## see package vignettes for further examples. + +##################################################################################### +## Create Workbook object and add worksheets +wb <- createWorkbook() +addWorksheet(wb, "S1") +addWorksheet(wb, "S2") +addWorksheet(wb, "S3") + + +##################################################################################### +## -- write data.frame as an Excel table with column filters +## -- default table style is "TableStyleMedium2" + +writeDataTable(wb, "S1", x = iris) + +writeDataTable(wb, "S2", + x = mtcars, xy = c("B", 3), rowNames = TRUE, + tableStyle = "TableStyleLight9" +) + +df <- data.frame( + "Date" = Sys.Date() - 0:19, + "T" = TRUE, "F" = FALSE, + "Time" = Sys.time() - 0:19 * 60 * 60, + "Cash" = paste("$", 1:20), "Cash2" = 31:50, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(0, 1, length.out = 20), + "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE +) + +## openxlsx will apply default Excel styling for these classes +class(df$Cash) <- c(class(df$Cash), "currency") +class(df$Cash2) <- c(class(df$Cash2), "accounting") +class(df$hLink) <- "hyperlink" +class(df$Percentage) <- c(class(df$Percentage), "percentage") +class(df$TinyNumbers) <- c(class(df$TinyNumbers), "scientific") + +writeDataTable(wb, "S3", x = df, startRow = 4, rowNames = TRUE, tableStyle = "TableStyleMedium9") + +##################################################################################### +## Additional Header Styling and remove column filters + +writeDataTable(wb, + sheet = 1, x = iris, startCol = 7, headerStyle = createStyle(textRotation = 45), + withFilter = FALSE +) + + +##################################################################################### +## Save workbook +## Open in excel without saving file: openXL(wb) +\dontrun{ +saveWorkbook(wb, "writeDataTableExample.xlsx", overwrite = TRUE) +} + + + + + +##################################################################################### +## Pre-defined table styles gallery + +wb <- createWorkbook(paste0("tableStylesGallery.xlsx")) +addWorksheet(wb, "Style Samples") +for (i in 1:21) { + style <- paste0("TableStyleLight", i) + writeDataTable(wb, + x = data.frame(style), sheet = 1, + tableStyle = style, startRow = 1, startCol = i * 3 - 2 + ) +} + +for (i in 1:28) { + style <- paste0("TableStyleMedium", i) + writeDataTable(wb, + x = data.frame(style), sheet = 1, + tableStyle = style, startRow = 4, startCol = i * 3 - 2 + ) +} + +for (i in 1:11) { + style <- paste0("TableStyleDark", i) + writeDataTable(wb, + x = data.frame(style), sheet = 1, + tableStyle = style, startRow = 7, startCol = i * 3 - 2 + ) +} + +## openXL(wb) +\dontrun{ +saveWorkbook(wb, file = "tableStylesGallery.xlsx", overwrite = TRUE) +} + +} +\seealso{ +\code{\link[=addWorksheet]{addWorksheet()}} + +\code{\link[=writeData]{writeData()}} + +\code{\link[=removeTable]{removeTable()}} + +\code{\link[=getTables]{getTables()}} +} diff -Nru r-cran-openxlsx-4.2.4/man/writeFormula.Rd r-cran-openxlsx-4.2.5/man/writeFormula.Rd --- r-cran-openxlsx-4.2.4/man/writeFormula.Rd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/writeFormula.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,115 +1,115 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/writeData.R -\name{writeFormula} -\alias{writeFormula} -\title{Write a character vector as an Excel Formula} -\usage{ -writeFormula( - wb, - sheet, - x, - startCol = 1, - startRow = 1, - array = FALSE, - xy = NULL -) -} -\arguments{ -\item{wb}{A Workbook object containing a worksheet.} - -\item{sheet}{The worksheet to write to. Can be the worksheet index or name.} - -\item{x}{A character vector.} - -\item{startCol}{A vector specifying the starting column to write to.} - -\item{startRow}{A vector specifying the starting row to write to.} - -\item{array}{A bool if the function written is of type array} - -\item{xy}{An alternative to specifying \code{startCol} and -\code{startRow} individually. A vector of the form -\code{c(startCol, startRow)}.} -} -\description{ -Write a a character vector containing Excel formula to a worksheet. -} -\details{ -Currently only the english version of functions are supported. Please don't use the local translation. -The examples below show a small list of possible formulas: -\itemize{ - \item{SUM(B2:B4)} - \item{AVERAGE(B2:B4)} - \item{MIN(B2:B4)} - \item{MAX(B2:B4)} - \item{...} - -} -} -\examples{ - -## There are 3 ways to write a formula - -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -writeData(wb, "Sheet 1", x = iris) - -## SEE int2col() to convert int to Excel column label - -## 1. - As a character vector using writeFormula - -v <- c("SUM(A2:A151)", "AVERAGE(B2:B151)") ## skip header row -writeFormula(wb, sheet = 1, x = v, startCol = 10, startRow = 2) -writeFormula(wb, 1, x = "A2 + B2", startCol = 10, startRow = 10) - - -## 2. - As a data.frame column with class "formula" using writeData - -df <- data.frame( - x = 1:3, - y = 1:3, - z = paste(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), - z2 = sprintf("ADDRESS(1,\%s)", 1:3), - stringsAsFactors = FALSE -) - -class(df$z) <- c(class(df$z), "formula") -class(df$z2) <- c(class(df$z2), "formula") - -addWorksheet(wb, "Sheet 2") -writeData(wb, sheet = 2, x = df) - - - -## 3. - As a vector with class "formula" using writeData - -v2 <- c("SUM(A2:A4)", "AVERAGE(B2:B4)", "MEDIAN(C2:C4)") -class(v2) <- c(class(v2), "formula") - -writeData(wb, sheet = 2, x = v2, startCol = 10, startRow = 2) - -## Save workbook -\dontrun{ -saveWorkbook(wb, "writeFormulaExample.xlsx", overwrite = TRUE) -} - - -## 4. - Writing internal hyperlinks - -wb <- createWorkbook() -addWorksheet(wb, "Sheet1") -addWorksheet(wb, "Sheet2") -writeFormula(wb, "Sheet1", x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")') - -## Save workbook -\dontrun{ -saveWorkbook(wb, "writeFormulaHyperlinkExample.xlsx", overwrite = TRUE) -} - -} -\seealso{ -\code{\link{writeData}} -} -\author{ -Alexander Walker -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/writeData.R +\name{writeFormula} +\alias{writeFormula} +\title{Write a character vector as an Excel Formula} +\usage{ +writeFormula( + wb, + sheet, + x, + startCol = 1, + startRow = 1, + array = FALSE, + xy = NULL +) +} +\arguments{ +\item{wb}{A Workbook object containing a worksheet.} + +\item{sheet}{The worksheet to write to. Can be the worksheet index or name.} + +\item{x}{A character vector.} + +\item{startCol}{A vector specifying the starting column to write to.} + +\item{startRow}{A vector specifying the starting row to write to.} + +\item{array}{A bool if the function written is of type array} + +\item{xy}{An alternative to specifying \code{startCol} and +\code{startRow} individually. A vector of the form +\code{c(startCol, startRow)}.} +} +\description{ +Write a a character vector containing Excel formula to a worksheet. +} +\details{ +Currently only the english version of functions are supported. Please don't use the local translation. +The examples below show a small list of possible formulas: +\itemize{ +\item{SUM(B2:B4)} +\item{AVERAGE(B2:B4)} +\item{MIN(B2:B4)} +\item{MAX(B2:B4)} +\item{...} + +} +} +\examples{ + +## There are 3 ways to write a formula + +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +writeData(wb, "Sheet 1", x = iris) + +## SEE int2col() to convert int to Excel column label + +## 1. - As a character vector using writeFormula + +v <- c("SUM(A2:A151)", "AVERAGE(B2:B151)") ## skip header row +writeFormula(wb, sheet = 1, x = v, startCol = 10, startRow = 2) +writeFormula(wb, 1, x = "A2 + B2", startCol = 10, startRow = 10) + + +## 2. - As a data.frame column with class "formula" using writeData + +df <- data.frame( + x = 1:3, + y = 1:3, + z = paste(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), + z2 = sprintf("ADDRESS(1,\%s)", 1:3), + stringsAsFactors = FALSE +) + +class(df$z) <- c(class(df$z), "formula") +class(df$z2) <- c(class(df$z2), "formula") + +addWorksheet(wb, "Sheet 2") +writeData(wb, sheet = 2, x = df) + + + +## 3. - As a vector with class "formula" using writeData + +v2 <- c("SUM(A2:A4)", "AVERAGE(B2:B4)", "MEDIAN(C2:C4)") +class(v2) <- c(class(v2), "formula") + +writeData(wb, sheet = 2, x = v2, startCol = 10, startRow = 2) + +## Save workbook +\dontrun{ +saveWorkbook(wb, "writeFormulaExample.xlsx", overwrite = TRUE) +} + + +## 4. - Writing internal hyperlinks + +wb <- createWorkbook() +addWorksheet(wb, "Sheet1") +addWorksheet(wb, "Sheet2") +writeFormula(wb, "Sheet1", x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")') + +## Save workbook +\dontrun{ +saveWorkbook(wb, "writeFormulaHyperlinkExample.xlsx", overwrite = TRUE) +} + +} +\seealso{ +\code{\link[=writeData]{writeData()}} \code{\link[=makeHyperlinkString]{makeHyperlinkString()}} +} +\author{ +Alexander Walker +} diff -Nru r-cran-openxlsx-4.2.4/man/write.xlsx.Rd r-cran-openxlsx-4.2.5/man/write.xlsx.Rd --- r-cran-openxlsx-4.2.4/man/write.xlsx.Rd 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/man/write.xlsx.Rd 2021-12-13 08:14:44.000000000 +0000 @@ -1,152 +1,132 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/writexlsx.R -\name{write.xlsx} -\alias{write.xlsx} -\title{write data to an xlsx file} -\usage{ -write.xlsx(x, file, asTable = FALSE, overwrite = FALSE, ...) -} -\arguments{ -\item{x}{A data.frame or a (named) list of objects that can be handled by -\code{\link{writeData}} or \code{\link{writeDataTable}} to write to file} - -\item{file}{A file path to save the xlsx file} - -\item{asTable}{If \code{TRUE} will use \code{\link{writeDataTable}} rather -than \code{\link{writeData}} to write \code{x} to the file (default: -\code{FALSE})} - -\item{overwrite}{If `TRUE` will save over `file` if present (default: `FALSE`) - -\itemize{ - \item{createWorkbook} - \item{addWorksheet} - \item{writeData} - \item{freezePane} - \item{saveWorkbook} -} - -see details.} - -\item{...}{Additional arguments passed to \code{\link{writeData}}, -\code{\link{writeDataTable}}, \code{\link{setColWidths}}} -} -\value{ -A workbook object -} -\description{ -write a data.frame or list of data.frames to an xlsx file -} -\details{ -Optional parameters are: - -\bold{createWorkbook Parameters} -\itemize{ - \item{\bold{creator}}{ A string specifying the workbook author} -} - -\bold{addWorksheet Parameters} -\itemize{ - \item{\bold{sheetName}}{ Name of the worksheet} - \item{\bold{gridLines}}{ A logical. If \code{FALSE}, the worksheet grid lines will be hidden.} - \item{\bold{tabColour}}{ Colour of the worksheet tab. A valid colour (belonging to colours()) - or a valid hex colour beginning with "#".} - \item{\bold{zoom}}{ A numeric between 10 and 400. Worksheet zoom level as a percentage.} -} - -\bold{writeData/writeDataTable Parameters} -\itemize{ - \item{\bold{startCol}}{ A vector specifying the starting column(s) to write df} - \item{\bold{startRow}}{ A vector specifying the starting row(s) to write df} - \item{\bold{xy}}{ An alternative to specifying startCol and startRow individually. - A vector of the form c(startCol, startRow)} - \item{\bold{colNames or col.names}}{ If \code{TRUE}, column names of x are written.} - \item{\bold{rowNames or row.names}}{ If \code{TRUE}, row names of x are written.} - \item{\bold{headerStyle}}{ Custom style to apply to column names.} - \item{\bold{borders}}{ Either "surrounding", "columns" or "rows" or NULL. If "surrounding", a border is drawn around the -data. If "rows", a surrounding border is drawn a border around each row. If "columns", a surrounding border is drawn with a border -between each column. If "\code{all}" all cell borders are drawn.} - \item{\bold{borderColour}}{ Colour of cell border} - \item{\bold{borderStyle}}{ Border line style.} - \item{\bold{keepNA}} {If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty. Defaults to FALSE.} - \item{\bold{na.string}} {If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel. Defaults to NULL.} -} - -\bold{freezePane Parameters} -\itemize{ - \item{\bold{firstActiveRow}} {Top row of active region to freeze pane.} - \item{\bold{firstActiveCol}} {Furthest left column of active region to freeze pane.} - \item{\bold{firstRow}} {If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2)} - \item{\bold{firstCol}} {If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2)} -} - -\bold{colWidths Parameters} -\itemize{ - \item{\bold{colWidths}} {May be a single value for all columns (or "auto"), or a list of vectors that will be recycled for each sheet (see examples)} -} - - -\bold{saveWorkbook Parameters} -\itemize{ - \item{\bold{overwrite}}{ Overwrite existing file (Defaults to TRUE as with write.table)} -} - - -columns of x with class Date or POSIXt are automatically -styled as dates and datetimes respectively. -} -\examples{ - -## write to working directory -options("openxlsx.borderColour" = "#4F80BD") ## set default border colour -\dontrun{ -write.xlsx(iris, file = "writeXLSX1.xlsx", colNames = TRUE, borders = "columns") -write.xlsx(iris, file = "writeXLSX2.xlsx", colNames = TRUE, borders = "surrounding") -} - - -hs <- createStyle( - textDecoration = "BOLD", fontColour = "#FFFFFF", fontSize = 12, - fontName = "Arial Narrow", fgFill = "#4F80BD" -) -\dontrun{ -write.xlsx(iris, - file = "writeXLSX3.xlsx", - colNames = TRUE, borders = "rows", headerStyle = hs -) -} - -## Lists elements are written to individual worksheets, using list names as sheet names if available -l <- list("IRIS" = iris, "MTCATS" = mtcars, matrix(runif(1000), ncol = 5)) -\dontrun{ -write.xlsx(l, "writeList1.xlsx", colWidths = c(NA, "auto", "auto")) -} - -## different sheets can be given different parameters -\dontrun{ -write.xlsx(l, "writeList2.xlsx", - startCol = c(1, 2, 3), startRow = 2, - asTable = c(TRUE, TRUE, FALSE), withFilter = c(TRUE, FALSE, FALSE) -) -} - -# specify column widths for multiple sheets -\dontrun{ -write.xlsx(l, "writeList2.xlsx", colWidths = 20) -write.xlsx(l, "writeList2.xlsx", colWidths = list(100, 200, 300)) -write.xlsx(l, "writeList2.xlsx", colWidths = list(rep(10, 5), rep(8, 11), rep(5, 5))) -} - -} -\seealso{ -\code{\link{addWorksheet}} - -\code{\link{writeData}} - -\code{\link{createStyle}} for style parameters - -\code{\link{buildWorkbook}} -} -\author{ -Alexander Walker, Jordan Mark Barbone -} +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/writexlsx.R +\name{write.xlsx} +\alias{write.xlsx} +\title{write data to an xlsx file} +\usage{ +write.xlsx(x, file, asTable = FALSE, overwrite = TRUE, ...) +} +\arguments{ +\item{x}{A data.frame or a (named) list of objects that can be handled by +\code{\link[=writeData]{writeData()}} or \code{\link[=writeDataTable]{writeDataTable()}} to write to file} + +\item{file}{A file path to save the xlsx file} + +\item{asTable}{If \code{TRUE} will use \code{\link[=writeDataTable]{writeDataTable()}} rather +than \code{\link[=writeData]{writeData()}} to write \code{x} to the file (default: +\code{FALSE})} + +\item{overwrite}{Overwrite existing file (Defaults to \code{TRUE} as with \code{write.table})} + +\item{...}{Additional arguments passed to \code{\link[=buildWorkbook]{buildWorkbook()}}; see details} +} +\value{ +A workbook object +} +\description{ +write a data.frame or list of data.frames to an xlsx file +} +\section{Optional Parameters}{ + + +\strong{createWorkbook Parameters} +\itemize{ +\item{\strong{creator}}{ A string specifying the workbook author} +} + +\strong{addWorksheet Parameters} +\itemize{ +\item{\strong{sheetName}}{ Name of the worksheet} +\item{\strong{gridLines}}{ A logical. If \code{FALSE}, the worksheet grid lines will be hidden.} +\item{\strong{tabColour}}{ Colour of the worksheet tab. A valid colour (belonging to colours()) +or a valid hex colour beginning with "#".} +\item{\strong{zoom}}{ A numeric between 10 and 400. Worksheet zoom level as a percentage.} +} + +\strong{writeData/writeDataTable Parameters} +\itemize{ +\item{\strong{startCol}}{ A vector specifying the starting column(s) to write df} +\item{\strong{startRow}}{ A vector specifying the starting row(s) to write df} +\item{\strong{xy}}{ An alternative to specifying startCol and startRow individually. +A vector of the form c(startCol, startRow)} +\item{\strong{colNames or col.names}}{ If \code{TRUE}, column names of x are written.} +\item{\strong{rowNames or row.names}}{ If \code{TRUE}, row names of x are written.} +\item{\strong{headerStyle}}{ Custom style to apply to column names.} +\item{\strong{borders}}{ Either "surrounding", "columns" or "rows" or NULL. If "surrounding", a border is drawn around the +data. If "rows", a surrounding border is drawn a border around each row. If "columns", a surrounding border is drawn with a border +between each column. If "\code{all}" all cell borders are drawn.} +\item{\strong{borderColour}}{ Colour of cell border} +\item{\strong{borderStyle}}{ Border line style.} +\item{\strong{keepNA}} {If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty. Defaults to FALSE.} +\item{\strong{na.string}} {If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel. Defaults to NULL.} +} + +\strong{freezePane Parameters} +\itemize{ +\item{\strong{firstActiveRow}} {Top row of active region to freeze pane.} +\item{\strong{firstActiveCol}} {Furthest left column of active region to freeze pane.} +\item{\strong{firstRow}} {If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2)} +\item{\strong{firstCol}} {If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2)} +} + +\strong{colWidths Parameters} +\itemize{ +\item{\strong{colWidths}} {May be a single value for all columns (or "auto"), or a list of vectors that will be recycled for each sheet (see examples)} +} +} + +\examples{ + +## write to working directory +options("openxlsx.borderColour" = "#4F80BD") ## set default border colour +\dontrun{ +write.xlsx(iris, file = "writeXLSX1.xlsx", colNames = TRUE, borders = "columns") +write.xlsx(iris, file = "writeXLSX2.xlsx", colNames = TRUE, borders = "surrounding") +} + + +hs <- createStyle( + textDecoration = "BOLD", fontColour = "#FFFFFF", fontSize = 12, + fontName = "Arial Narrow", fgFill = "#4F80BD" +) +\dontrun{ +write.xlsx(iris, + file = "writeXLSX3.xlsx", + colNames = TRUE, borders = "rows", headerStyle = hs +) +} + +## Lists elements are written to individual worksheets, using list names as sheet names if available +l <- list("IRIS" = iris, "MTCATS" = mtcars, matrix(runif(1000), ncol = 5)) +\dontrun{ +write.xlsx(l, "writeList1.xlsx", colWidths = c(NA, "auto", "auto")) +} + +## different sheets can be given different parameters +\dontrun{ +write.xlsx(l, "writeList2.xlsx", + startCol = c(1, 2, 3), startRow = 2, + asTable = c(TRUE, TRUE, FALSE), withFilter = c(TRUE, FALSE, FALSE) +) +} + +# specify column widths for multiple sheets +\dontrun{ +write.xlsx(l, "writeList2.xlsx", colWidths = 20) +write.xlsx(l, "writeList2.xlsx", colWidths = list(100, 200, 300)) +write.xlsx(l, "writeList2.xlsx", colWidths = list(rep(10, 5), rep(8, 11), rep(5, 5))) +} + +} +\seealso{ +\code{\link[=addWorksheet]{addWorksheet()}} + +\code{\link[=writeData]{writeData()}} + +\code{\link[=createStyle]{createStyle()}} for style parameters + +\code{\link[=buildWorkbook]{buildWorkbook()}} +} +\author{ +Alexander Walker, Jordan Mark Barbone +} diff -Nru r-cran-openxlsx-4.2.4/MD5 r-cran-openxlsx-4.2.5/MD5 --- r-cran-openxlsx-4.2.4/MD5 2021-06-16 04:20:03.000000000 +0000 +++ r-cran-openxlsx-4.2.5/MD5 2021-12-14 14:20:06.000000000 +0000 @@ -1,85 +1,88 @@ -db3b9d170cf7569a3e2b887d2e531977 *DESCRIPTION -7b9a5ad7d625435b6cf87d0c7c15898d *LICENSE -98abca07875c795124fa0ab7201d725e *NAMESPACE -28766a06e05402768e7d09c81c923d26 *NEWS.md -d3542a4c8f702de7d135ca194dc5a888 *R/CommentClass.R -9b3fdf37acfe6790cbc60428d8d3a9d6 *R/HyperlinkClass.R -86e7a64744faaa38afab4ceef1b02c26 *R/RcppExports.R -c7da3c75dc0ed45e6c97e0da745b8193 *R/StyleClass.R -851278ad72156d6348c8f656717d2212 *R/WorkbookClass.R -aa2d9d56805836e661af23701d4fe5ad *R/asserts.R -8975f88e08e2f79f78914543f6c4875f *R/baseXML.R -abb0c1fd9a2c3e9e88f71e382cfd840b *R/borderFunctions.R -502ace7bcfe313e5cace874383d96288 *R/build_workbook.R -3bad4cf7533cb8c28ace7b6f13624ad1 *R/chartsheet_class.R -462742cbe2f8a93dd4e4eb7c29c7d819 *R/class_definitions.R -db25411a1c1374acecef49dd970939b2 *R/conditional_formatting.R -5fd66d46c02f92fef0da7bf017bd61b7 *R/data-fontSizeLookupTables.R -c9ad1141bcd2b5dcfbeadfe5d20c441d *R/helperFunctions.R -bf6ee2d20f863a32566a1eef90416c41 *R/loadWorkbook.R -17914458bc705cfa48e8f3d25e0b6b4d *R/onUnload.R -539850d27e746f4be1cf85073b195be3 *R/openXL.R -609be913ba8f81a81c72165d4ffd41cf *R/openxlsx-package.R -6b98ada043c964fb1938ea605744919e *R/openxlsx.R -4202e8137d74b32ba26f2215eeda327f *R/openxlsxCoerce.R -72a1993365bed2a821142ec482409e23 *R/readWorkbook.R -c6d78e1e5c77cec8b51e048e7372949a *R/sheet_data_class.R +0ee7dddc28597bfeb4535a0833d6d754 *DESCRIPTION +7b6c9251a2fc7cf0233e205091619653 *LICENSE +371afe0512d43633337c3f0bef8e0013 *NAMESPACE +1d8355aeb0b737e446388ff632f5072d *NEWS.md +aefc02086b72488b3d1bf2508eea389e *R/CommentClass.R +52ed90adfec08ebf8d6c8fd3cf30d04e *R/HyperlinkClass.R +1cfd53b832f7445b90eeac17de224123 *R/RcppExports.R +8f1e14d3db9a17e3d5e555404db1f9d0 *R/StyleClass.R +3bd32ad89d55d781ff29feaf1ebba0b2 *R/WorkbookClass.R +03dcd17147d2be65848d3f99c0677433 *R/asserts.R +37a69f7c394e43cf006f990fcf1cc6ed *R/baseXML.R +5376e1aca1eb05f899b2e0249d3a6e51 *R/borderFunctions.R +af007869aaefae8677d1435e03a9c641 *R/build_workbook.R +a3d492922ef30c79b677ec904ed7a830 *R/chartsheet_class.R +26e58b9c2e7ddd99d54a19149ef1a55e *R/class_definitions.R +14bfa2b761920db98250c1657ae6a0ff *R/conditional_formatting.R +c799fdbfef94a69869a5c3ae5a2a8f5f *R/data-fontSizeLookupTables.R +2ffb24e255de01cbf9240f33a0f870d4 *R/helperFunctions.R +02cbee7307fdd40737c3c09b7ea709b9 *R/loadWorkbook.R +c6673c95be1ed5484336ef2375cdd13c *R/onUnload.R +7ba170cbcd37ad9b51fa54ad9f9ff680 *R/openXL.R +75cfbf10fc07d8fe81b2d624c74df9dd *R/openxlsx-package.R +7c64314e40a8d14df0a9f7d2ff26288e *R/openxlsx.R +a4c54d6854a56526080440d6d5289124 *R/openxlsxCoerce.R +dd4adab0b92471e60f255c53e92367fd *R/readWorkbook.R +54f6490db5f29507421e1de8601d5c75 *R/sheet_data_class.R 6f1990036b65c51003d24a4bc17198bc *R/sysdata.rda -16db34dedb549631a87b13ed177ae27b *R/utils.R -91ee94d324113f4c08b2f394eae98457 *R/workbook_column_widths.R -8f01204a777fbe2218902f0551ed40a8 *R/workbook_read_workbook.R -073fb79bd42bb3fd40b3e944eb152802 *R/workbook_write_data.R -77a6a2579e4679ae13d285cd7f4faee4 *R/worksheet_class.R -553352001b298b76b0c63063ca861ea1 *R/wrappers.R -38302483ee4a6438a38d20c9b428b5d4 *R/writeData.R -70b30cb4985d3ea5e2dbb19e92c154a2 *R/writeDataTable.R -c0a54e6ed7ae9fb466e2d6afc98782c8 *R/writexlsx.R -b2bb1de4aa9013d6160d148d5efce133 *R/zzz.R -ca0d46b387a11428e7582f5792a60e0c *README.md -a249ffc36096b7ccb9c7ada0de7819a2 *build/vignette.rds -fe4d2ebb2a0fd92ec6211c9bf5efdc9c *inst/WORDLIST -e7841053567353ee7b1ba58318ee7f14 *inst/doc/Formatting.R -cff1495404efb362e482e0e417b6c8be *inst/doc/Formatting.Rmd -bf27248b810f905687943dcc7a8b7c97 *inst/doc/Formatting.html -0d68e393f77c4b432b6e1afe5ab06b76 *inst/doc/Introduction.R -7bd2b0ca10f205f9524eb1cd88690c7d *inst/doc/Introduction.Rmd -0715e5fb4c07c14e45e52e5439c7852e *inst/doc/Introduction.html -94cfdf8f6784785d4606805128a28659 *inst/extdata/build_font_size_lookup.R +d91747829fb03d4b8886a48ea69c7b15 *R/utils.R +b786e6732c9ce1cec2091c4b4a393027 *R/workbook_column_widths.R +8ea06682e0d27e48e89b1bf47647f003 *R/workbook_read_workbook.R +6913ec78106895729b439653888d21a4 *R/workbook_write_data.R +6df271e92451301608e8de73ef464741 *R/worksheet_class.R +f1f86635a597a1c02e49ff7254890b6b *R/wrappers.R +f4984b0ac75b865db69940204d66c521 *R/writeData.R +8df7c1096ecec9b3696e5cca8c48ce72 *R/writeDataTable.R +8bb38cde620b0b5f4302287e5b99fe80 *R/writexlsx.R +dd30c7b1d3710c3efb4e4afce40f6424 *R/zzz.R +09da45628805144d06ceca71629882ae *README.md +6f70825900d686c3ed9ee307e14fbad0 *build/vignette.rds +884ec602987c2e44ef29642b947c9764 *inst/WORDLIST +f3a680efd8bb22c5144da7750c43cc7e *inst/doc/Formatting.R +1981b3039d3a126b8bbe2a592140dc54 *inst/doc/Formatting.Rmd +e0095ab263e3377e5c381e223c8919d4 *inst/doc/Formatting.html +b4122d79e4ac41b97086744612f5d482 *inst/doc/Introduction.R +70e145f1e10533307946e36d66a4c1a5 *inst/doc/Introduction.Rmd +8ec970d6bfac532afbcdce6c527cf1f3 *inst/doc/Introduction.html +b882b13f509c96d058883be4eb6664a1 *inst/extdata/ColorTabs3.xlsx +fcbfe30b58098920c92bb7c3dce6394d *inst/extdata/build_font_size_lookup.R 13cccf9835335301211ac8d8a4785659 *inst/extdata/cloneEmptyWorksheetExample.xlsx c2f3a10132c34da8e7c70a72f52d06c5 *inst/extdata/cloneWorksheetExample.xlsx -12d59e9df767c97293b786deb7569e00 *inst/extdata/conditional_formatting_testing.R +d1aec846b3a29c873799d02567eb665c *inst/extdata/conditional_formatting_testing.R 36a7feeb6214d7e79ac8b89df3c45df0 *inst/extdata/einstein.jpg 0c1574a0171de89f03b8cfc5dcd0d0e5 *inst/extdata/groupTest.xlsx +4e2a987f8dc163fe8e53a1fe46757201 *inst/extdata/inlineStr.xlsx fb9a2de7bc2ec82fe52394335d80050d *inst/extdata/loadExample.xlsx 170b968dd1a7c0bbb8ff70ac6a53565a *inst/extdata/loadPivotTables.xlsx a26ff22341de278fefc53dd6baba61e8 *inst/extdata/loadThreadComment.xlsx -d148fd0b486ea7486d529a6d83ef36a1 *inst/extdata/load_xlsx_testing.R +8123c907acba826714a9219c82cf1b81 *inst/extdata/load_xlsx_testing.R b880cccb0e6a0573c9107453505ee04a *inst/extdata/namedRegions.xlsx 5c6ee667b971ee565af8d65a715176fe *inst/extdata/namedRegions2.xlsx e02ca6f0caae9cd6dc155c8c76b2c7eb *inst/extdata/namedRegions3.xlsx 1febf7741950a8f461c80f0975895d1e *inst/extdata/readTest.xlsx 87c13e763f8e6097bbdc81159798622f *inst/extdata/read_failure_test.xlsx -d54cbee2c4963f0de72fe9402c3cf330 *inst/extdata/stack_style_testing.R -18350dca6385752a9b2e36991d6ec56d *man/activeSheet.Rd -273b6e96b63df7312bb4151331604347 *man/addCreator.Rd -3550b86cd2f3df93556b5196f0727502 *man/addFilter.Rd -4340aed7ef2b81896b49787e12a742b3 *man/addStyle.Rd -3a7141a6296d504b7e48eb0deab206c2 *man/addWorksheet.Rd -9a966e34696cf5c4ff264921000eb6f7 *man/all.equal.Rd -f152ebddfcd17e674ca16fdab2ba4b4f *man/buildWorkbook.Rd -99fb306f47779db2fb1299b3220f690b *man/cloneWorksheet.Rd -21580969126e86ab026bfd4cb5f4f7f4 *man/conditionalFormat.Rd -139dc8d87a5606d0a8d41fbd23a86e7f *man/conditionalFormatting.Rd -be2f5a877330a76c56886030b21f71fa *man/convertFromExcelRef.Rd -dd06de8b697dcc3a0412d3d0919b51f4 *man/convertToDate.Rd -56eb70168427856194e638ea45cf00d1 *man/convertToDateTime.Rd -3afd6bee7500ceb56f47b04cd218d5ec *man/copyWorkbook.Rd -a01a8d03f207470b22fef3adef1f8f02 *man/createComment.Rd -998a70e4bb07c2a1e42dec92bd1aa7d6 *man/createNamedRegion.Rd -0b0bdf5805167da0d35b598394bebe8d *man/createStyle.Rd -b43417b20e0f2bad93085d544293e3d3 *man/createWorkbook.Rd -7cf9d8466f05ee64303056d3c50cfd41 *man/dataValidation.Rd -22842e0dc52b1bb9faaa01d32837cce8 *man/deleteData.Rd +49a26eeb294578053af80b4108d88223 *inst/extdata/stack_style_testing.R +601033236770879ad94046af9a917c66 *man/NamedRegion.Rd +201d75364bc6702f97a70e75430f0d5f *man/activeSheet.Rd +db31f0557788e83b463c44395100f10d *man/addCreator.Rd +ab9f8d7a4f1b8124935418d3c2e33a32 *man/addFilter.Rd +8fad49c0547c247ff51675f67a7c9bda *man/addStyle.Rd +b7ae906c2ac1d3a6e290846198b9918c *man/addWorksheet.Rd +8dc26272e0d412b671ba25d4aa83cfc5 *man/all.equal.Rd +3f45620674b5b0c9e807af0bad1db5b3 *man/buildWorkbook.Rd +cfda8912ba566dae1307e32bde30cc06 *man/cloneWorksheet.Rd +21196d093fd0b7829b539c43f7bff30c *man/col2int.Rd +3c2917f7e6bdb5b4c01043e26c4c1491 *man/conditionalFormat.Rd +8f62966b09aa1e565c7b181855d08392 *man/conditionalFormatting.Rd +a156966c76eba650cc45d0619bcc0b73 *man/convertFromExcelRef.Rd +8a15f9c8822626d078b36fa1639b201e *man/convertToDate.Rd +1e6a8f4d74954dee7301934b95b12edb *man/convertToDateTime.Rd +c3715eccf4cd9b7ad6b3a9db006bc2f3 *man/copyWorkbook.Rd +b644037d373c762ba5bd41eac5d988a3 *man/createComment.Rd +349ef65772bd5dd2af46787b0d0a8095 *man/createStyle.Rd +d878c5235941c0f7e8f5ec0a972c828f *man/createWorkbook.Rd +a8af92d66830f85c88278e1abc815e81 *man/dataValidation.Rd +ef1ef7b6bf313d47b94fb530346a4f31 *man/deleteData.Rd cb1e46f469cfbbbde29c8b5113e1d789 *man/figures/lifecycle-archived.svg c0d2e5a54f1fa4ff02bf9533079dd1f7 *man/figures/lifecycle-defunct.svg a1b8c987c676c16af790f563f96cbb1f *man/figures/lifecycle-deprecated.svg @@ -91,120 +94,126 @@ 53b3f893324260b737b3c46ed2a0e643 *man/figures/lifecycle-stable.svg 9935549e5ab436e1a14b39aa6eb5f586 *man/figures/tableoptions.pdf 57f30d30484a5402e9fce7539de1d3a6 *man/figures/tableoptions.png -0149d719fa10621d49bab2dab606fa78 *man/freezePane.Rd -3ef5e44807e4b1bcc6e11ed59cd7c88e *man/getBaseFont.Rd -859371762a43d28a8c7c432c87225414 *man/getCellRefs.Rd -faa9d68b191f0165911c3b584ed51936 *man/getCreators.Rd -0a8cbf4b5bd24db464bdd43bd4e1161f *man/getDateOrigin.Rd -23e4ea66ce8c7d1724a7ab3889d484c3 *man/getNamedRegions.Rd -51c06a3e6a3b48f803f31cfc5da77718 *man/getSheetNames.Rd -1fa8277f1849f01b8e7468e27bdc3578 *man/getStyles.Rd -93b0fefa86c1831dcc15d319dc96b3b6 *man/getTables.Rd -5b4713b680166e63b88a3c479c120894 *man/groupColumns.Rd -a32d45ecdc48e3b2236478b5a9698f33 *man/groupRows.Rd -6e28aa8bb05e1302ed6cf695ef963e37 *man/if_null_then.Rd -0fe511a3aa9138a0dae85718cbc544f3 *man/insertImage.Rd -baf57bc122cd6137a6c720956ecd905b *man/insertPlot.Rd -8ff8b8e6032d06730162721cb9a73551 *man/int2col.Rd -9f56c8a85fc73d3429c270ea390c170b *man/loadWorkbook.Rd -7a92bc5ea25ecb2cdc7284d470a98a6e *man/makeHyperlinkString.Rd -3646b3fd416b17ce67ad1126bbf2a9bf *man/mergeCells.Rd -33949f2f7996248691f1e24d3c34f42e *man/modifyBaseFont.Rd -7e325d8306c2cd6d7cbbb596d2a22100 *man/names.Rd -ac4dc6218aafac571db14324923e828b *man/openXL.Rd -a37a1e11e05deec93e0b81dea51ec1c0 *man/openxlsx.Rd -f7cfa55dc93036a318f4e6f1473bf18f *man/openxlsxFontSizeLookupTable.Rd -b77941fadd35402b331fc250ee02be3f *man/openxlsx_options.Rd -1c0a7289953420a7904066677e3bd3ba *man/pageBreak.Rd -7deb9eedd2fefb7c25e0026206c40dd9 *man/pageSetup.Rd -8d71ec91793ac620f33c8906e80eb91b *man/protectWorkbook.Rd -31ebda5026cbb39bd0473f51bb1cc767 *man/protectWorksheet.Rd -d98b7afa4e93f5d9d3db232407d7f5d5 *man/read.xlsx.Rd -ac30f6afbb971a0fbb584fb5d7ebdbd3 *man/readWorkbook.Rd -9613ad4116dd742ab09a460dec152578 *man/removeCellMerge.Rd -6d7a23fac51df3c03c855a0f84099bb5 *man/removeColWidths.Rd -3d2ebb73e98722cdb5ee1ef8775deae1 *man/removeComment.Rd -8a4be0dc4493756345236301731f6cb1 *man/removeFilter.Rd -5c66b78e9e6d9b4401a553d42dc77ddf *man/removeRowHeights.Rd -27e8c76fb7d63be007b38479e4a062b4 *man/removeTable.Rd -0501e2933272896dc38181f252821d9e *man/removeWorksheet.Rd -f7ff2d424e210c57b8c81f38710a8587 *man/renameWorksheet.Rd -df469472fee5e498f4367ff341f6ec78 *man/replaceStyle.Rd -3b07db87674c5e3701fd32fa5f1375e6 *man/saveWorkbook.Rd -27612b55f416fc166305d6f51b11fb77 *man/setColWidths.Rd -5272e5d31ce61886e297552fe804db83 *man/setFooter.Rd -4ed2e0674e259bc5762024a399058d3a *man/setHeader.Rd -bc281b409a8c9e8d276b3be9154e440c *man/setHeaderFooter.Rd -c7a278b77aae95eb3af4bda7da118399 *man/setLastModifiedBy.Rd -c4f1f578d4d131fc9f5a9994916f7a37 *man/setRowHeights.Rd -b58e3015272c2e9f26a6403d8571c336 *man/sheetVisibility.Rd -38a4899f27620d73520a573591471556 *man/sheetVisible.Rd -ab267b129229824690d9104a6c776423 *man/sheets.Rd -c298e8123d3dbe3109affcd97ecc4ba3 *man/showGridLines.Rd -120eed54ae35268208304aab852e9c94 *man/ungroupColumns.Rd -0881baf38f663c9ff59527f91320e086 *man/ungroupRows.Rd -661899c8e1ee9da19b220b762d609926 *man/worksheetOrder.Rd -9f9ec76cb0796934c5f4765dedad5a80 *man/write.xlsx.Rd -e2da0e1a31e2728a4d0a713442ed1e32 *man/writeComment.Rd -3ec65cb7593d549f7a05bf5278cc974a *man/writeData.Rd -15fcd00ec80b08dd597c17192744874d *man/writeDataTable.Rd -0afb353ae0f81675e25068e785ebb8f9 *man/writeFormula.Rd -987ee2594b817eabfc21b5782d7f7581 *src/RcppExports.cpp +cf725539a0af56f8bc8a369a427d6baf *man/freezePane.Rd +67735a734cb5c0c128e8fec4a756d68a *man/getBaseFont.Rd +b310cd3548869e1339d753b67b09ad9a *man/getCellRefs.Rd +6cb16b0bc210abd402778981e7f172cc *man/getCreators.Rd +f49d5a7c434c95d540722178465ca667 *man/getDateOrigin.Rd +a9ccd1c9ca1e9a9736e480ec5eadb956 *man/getNamedRegions.Rd +2bbe613bd2499b19f57f3af23b8551a5 *man/getSheetNames.Rd +cbb19a2f8637b078396fff57869f1e3a *man/getStyles.Rd +6df5ff236ad412d5c08786a0dc9ed570 *man/getTables.Rd +66068cbe15a1171e134fa845fe9aad50 *man/groupColumns.Rd +de41af2bae48efc4e279de49372d4c2d *man/groupRows.Rd +5a9c0e0d2b902e22c6e2636e0fbfb469 *man/if_null_then.Rd +5f63b3e5a1cb5de5812462596634e26e *man/insertImage.Rd +272092de7c811c474ea8c8a03e30930b *man/insertPlot.Rd +b90ce05bbbc26cfeb2e2a3a12af2a0f4 *man/int2col.Rd +bedc98880c781aeede2fef0d137d9d5a *man/loadWorkbook.Rd +b4a84457c38a921a957c9f366f7a5e99 *man/makeHyperlinkString.Rd +b265302ac812bf3c97028aced1270672 *man/mergeCells.Rd +7559c893eb5dcc65fcb92d167a530ef1 *man/modifyBaseFont.Rd +ba6ec5f20adc33de28a0b129ab57413d *man/names.Rd +981ff02212d4411b668dba1bf4c23da1 *man/openXL.Rd +bd9922d48bd0718fb624db4ea10f5892 *man/openxlsx.Rd +eec24e942c67ca1a5e6fa14ed1dad963 *man/openxlsxFontSizeLookupTable.Rd +373a091615fcd179eae12841c9c2f95a *man/openxlsx_options.Rd +aaba9eaa1b5e8168ee80baacf5283688 *man/pageBreak.Rd +d859f1f0d965eb91ce5222a2ef82fbae *man/pageSetup.Rd +9ef1e7585598f3294679bdbf9ac1aad1 *man/protectWorkbook.Rd +9dce795724ca32d33ad602b2673529f3 *man/protectWorksheet.Rd +f88559e262101108a6073239f20bd30e *man/read.xlsx.Rd +f56372d5b220b4c7d444e9f42e1d5c76 *man/readWorkbook.Rd +8203b44baacc245cf5d7e553a3fbc456 *man/removeCellMerge.Rd +6edc9c6d0a1ca90f88ef45d382987bc7 *man/removeColWidths.Rd +3711c4fa3337fad7f8742ff5b53c4eb8 *man/removeComment.Rd +7e0d1b7fa9f21e44cb73401d97dab329 *man/removeFilter.Rd +4bbd5ff732df302077aa6d492be4ac92 *man/removeRowHeights.Rd +b7188f23e0e0005906ee6fc9b01c5992 *man/removeTable.Rd +9a84fe734b6890b50e862774d05c7360 *man/removeWorksheet.Rd +aa612794bdaf9598886a43d783211bb2 *man/renameWorksheet.Rd +d64d9803f64d9349f5e508e8ad69ae44 *man/replaceStyle.Rd +aca546aa250ae4ced4a5e3c23bb2daba *man/saveWorkbook.Rd +49004cedce652b5da38d07e6a44be06b *man/setColWidths.Rd +bcb40bbc971d2a7e378cd42f54af4d3c *man/setFooter.Rd +b9d60468d109790a3948635b549c4ee6 *man/setHeader.Rd +2d7ed92dd56f9825aa2c556584242fe0 *man/setHeaderFooter.Rd +da9ab876544aa914fb7862150a1fc9de *man/setLastModifiedBy.Rd +edad5e0cdc25d0eb517c5f26856b1b78 *man/setRowHeights.Rd +72f77db7f39906a610094601e964a845 *man/sheetVisibility.Rd +631c2cce5a711681e5c0478b93fc33ce *man/sheetVisible.Rd +33f085772350659ac5624c630772ddd4 *man/sheets.Rd +e2ea549ccb5bcf2d47a8590c74bd94c7 *man/showGridLines.Rd +5961a3c08016954dd0fcc8d9af167d91 *man/temp_xlsx.Rd +1ca0c630b199daf2ee4d0a6f406b75fc *man/ungroupColumns.Rd +19e75905f7c9ed4a5ba17b0807a55e85 *man/ungroupRows.Rd +a1c65d7381d181ab2c2ebf8cdca45c1b *man/worksheetOrder.Rd +478e471f082b8ba3b084df9e1a2a0aa1 *man/write.xlsx.Rd +4e1756633e50241f104e0e4eb9d22ba2 *man/writeComment.Rd +a36c701ba39ae3d8114d7477074f3877 *man/writeData.Rd +24b7b5b73623aa115df349f73d99fdfd *man/writeDataTable.Rd +1515052e58b0af77686ed23acec527db *man/writeFormula.Rd +458ccf3508f0ddf06fb3ccb5651823ce *src/RcppExports.cpp 71289967be1025e3cff58b2edbe0fc77 *src/helper_functions.cpp -37cf0a665e9abb28caf6c77eef709671 *src/load_workbook.cpp +08842fbf636f2398a534d98f615436de *src/load_workbook.cpp 1385cba6d8f3abe5f80618b30fcd938b *src/openxlsx.h -372c841b5a98aebb1fcf50b7ced6bc40 *src/read_workbook.cpp -c0c6145239614a8169a12e1e27e5673b *src/write_data.cpp -523dc96e9e03ee3a259de02f0b3209b4 *src/write_file.cpp -ab121498ed743ee7f74c898d27f4a491 *src/write_file_2.cpp -0f4ef4791fd7c7c057019a8ea9be4189 *tests/testthat.R -185afb805f2368bcfe9d106942578060 *tests/testthat/test-Workbook_properties.R -7bd0057d0a4b315701510d8f156e001c *tests/testthat/test-Worksheet_naming.R -f1037393961c7deb9b2afaf4f83979ca *tests/testthat/test-activeSheet.R -513547f7f067dbd76fd1d00b90881e13 *tests/testthat/test-border_parsing.R -22f6b897df2ec3ec24a88b29a55a41e5 *tests/testthat/test-build_workbook.R -aef5cc8a6e9dfd355eb5181fa1ff7762 *tests/testthat/test-cloneWorksheet.R -29aa91e464941b0801761ed75c510a8f *tests/testthat/test-conditionalFormatting.R -663a3b6a4812bf76f03f79b990860440 *tests/testthat/test-date_time_conversion.R -00c7e6604ed5414b946cc008e9ea0f7e *tests/testthat/test-deleting_tables.R -cd0de0c7634650444d5e666e4ffb1821 *tests/testthat/test-encoding.R -b45dfc802717dc0712c2652a1f2e46d0 *tests/testthat/test-fill_merged_cells.R -b32dd54c884ff5b2c1c14175bb8eca37 *tests/testthat/test-fontSizeLookupTables.R -f18592bcae7665f118ad956f8945b69f *tests/testthat/test-freeze_pane.R -c35aa4ff942b23ebca3f574c4572aecb *tests/testthat/test-getBaseFont.R -ef82ea6139b9810fec76cec79ed3f1ef *tests/testthat/test-getCellRefs.R -f1eda7c4cd9a9641b4c910693833682f *tests/testthat/test-load_read_file_read_equality.R -e00423845c633a5a1e9dd7f85430c981 *tests/testthat/test-loading_workbook.R -638c53b84f39ead1ed3a74830574a302 *tests/testthat/test-loading_workbook_tables.R -1dfb48fd6cb85655b177382a089253c7 *tests/testthat/test-loading_workbook_unzipped.R -6f61189e72d6e5c51a23b830dcb6f350 *tests/testthat/test-named_regions.R -8ffbb4ec0ba7ee3e31898c2ac281254f *tests/testthat/test-options.R -0493f1e621dadd91d69b5d4530336847 *tests/testthat/test-outlines.R -d4c11d48bcba235b2875b6668124bca6 *tests/testthat/test-page_setup.R -3bd5a06152c7b417853bce65d95d1a23 *tests/testthat/test-protect-workbook.R -afa7a2b159c05bc03bf9464964c723e3 *tests/testthat/test-protect-worksheet.R -db0a7f925cea27925f76cbcf4b190bb1 *tests/testthat/test-read_from_created_wb.R -d694023e037c359b7739f32de6419801 *tests/testthat/test-read_from_loaded_workbook.R -de0fec39ac729a44357c9448ac985765 *tests/testthat/test-read_sources.R -44dab24011f5e3fb3423f72acba56a73 *tests/testthat/test-read_write_logicals.R -970a6f91a0154683f4eadeddf711d26b *tests/testthat/test-read_xlsx_correct_sheet.R -df54be3f12d660c574b32227c4cceee7 *tests/testthat/test-remove_worksheets.R -df9de061eae9af33ffc0e166a39588b8 *tests/testthat/test-saveWorkbook.R -625439523957f8b6e588060b2dabf378 *tests/testthat/test-skip_empty_cols.R -9111b653923fb206174fea7e08b10d1e *tests/testthat/test-skip_empty_rows.R -03e2e9ca52193186f740c047bcf23023 *tests/testthat/test-style_replacing.R -7b4de205c3f151929e45e591ffbf6169 *tests/testthat/test-table_overlaps.R -ba69b538bfb64fb4750c5516f71ad5d1 *tests/testthat/test-trying_to_break_openxlsx.R -f9360d4b16fe2d81181b6a96d520033c *tests/testthat/test-v3_0_0_bugs.R -16ae9afdd27f64d245772cdd8d63b473 *tests/testthat/test-validate_table_name.R -6f819a56ef06b1c5626072591dd12903 *tests/testthat/test-worksheet_ordering.R -59ef59664451c2679e13b11ada83e10f *tests/testthat/test-worksheet_renaming.R -358b0abf6ae32a7cb1a4a86b51bb0471 *tests/testthat/test-write_data_to_sheetData.R -fa9e13ce4b7350b26acd70f3f4372425 *tests/testthat/test-write_data_to_sheetData_NAs.R -9495e999cc2864b1b39112e45e790bfa *tests/testthat/test-write_read_equality.R -f86edbcc24a88eca41225d27f319d6bf *tests/testthat/test-write_xlsx_vector_args.R -5b7ee465d9df599c9c3d5b3f659a8df1 *tests/testthat/test-writing_posixct.R -fa20be960d52aee79fe4d47f3dcb4c03 *tests/testthat/test-writing_sheet_data.R -cff1495404efb362e482e0e417b6c8be *vignettes/Formatting.Rmd -7bd2b0ca10f205f9524eb1cd88690c7d *vignettes/Introduction.Rmd +0873c1a2b23aab7079327c020b886ce3 *src/read_workbook.cpp +c2ca7900d8ce0d25dfa73382dc8bd2af *src/write_data.cpp +afb6d0ce468e4b16135d8bd4bee5e0d8 *src/write_file.cpp +484d69b3a6c975fdc692e9eb3015afe9 *src/write_file_2.cpp +1491151710e8a3fec494f98ba7e0676f *tests/testthat.R +0969e0aa603aa0583491c7f3bcb64088 *tests/testthat/test-CommentClass.R +9bd237c329f1505c9aa5b98b8d06b10f *tests/testthat/test-Workbook_properties.R +c7b68c2fad641fb94acdeeb30dfef307 *tests/testthat/test-Worksheet_naming.R +a670de0581cb1c63244228e569165312 *tests/testthat/test-activeSheet.R +ac77ac309103fda2d377f4296e626fa4 *tests/testthat/test-border_parsing.R +b9988de26cddcc866264aaeb45b73ac1 *tests/testthat/test-build_workbook.R +1a70132af6cd1aab8a6555cd7ab1f005 *tests/testthat/test-cloneWorksheet.R +ec606a79126ff7d8e470623f9f206481 *tests/testthat/test-conditionalFormatting.R +51043229822f11cf0422e370771b9a5e *tests/testthat/test-date_time_conversion.R +77b3a586f551a1c14b416a62fc2cdbb8 *tests/testthat/test-deleting_tables.R +24ef609bad59fa48e121c4c05a1cfa3e *tests/testthat/test-encoding.R +c938f37ea8f4db1080a6b0057c4c0fc1 *tests/testthat/test-fill_merged_cells.R +b27eced92ee53b5af4fd588e386f9e4d *tests/testthat/test-fontSizeLookupTables.R +dabb92e75814130a91a7b3f2abb63465 *tests/testthat/test-freeze_pane.R +93cabb37e8784313b0d2c25b35801787 *tests/testthat/test-getBaseFont.R +a878e98afb87801091507be0ed7e8166 *tests/testthat/test-getCellRefs.R +823519e66b4b358fc5d5a60e2b74c617 *tests/testthat/test-load_read_file_read_equality.R +11e9ed4b84093d02ff158f4a7bd148fa *tests/testthat/test-loading_workbook.R +8c1ecfd6d2d4a5bc93b4da82ab8c84ae *tests/testthat/test-loading_workbook_tables.R +82e0d3ed6c305eed1e99baae96efdc58 *tests/testthat/test-loading_workbook_unzipped.R +7986491afe5e6d1e936b8c0091bcd052 *tests/testthat/test-named_regions.R +64fff1439a519d971e67960bdc01fb89 *tests/testthat/test-options.R +66ba479cd36c2a6fdeadb0b526f69af2 *tests/testthat/test-outlines.R +a11acbf3cfd1b047156ecfef15e696bd *tests/testthat/test-page_setup.R +8009d31ef34c1fe500f810f00a9aada3 *tests/testthat/test-protect-workbook.R +338598a46888c8a3e64fc9ed42e053ce *tests/testthat/test-protect-worksheet.R +21f5694833298eac112c21d0d0fd7361 *tests/testthat/test-read_from_created_wb.R +8ef5acf08323d812f27aedde83394a9e *tests/testthat/test-read_from_loaded_workbook.R +cc167dce938b0f1afe9205503e8dc6d7 *tests/testthat/test-read_sources.R +6751e19b2982fbbeba85ccd8a3f172d2 *tests/testthat/test-read_write_logicals.R +a18369b0ad2df625c983b1d1f55bc99a *tests/testthat/test-read_xlsx_correct_sheet.R +1fbe6ba77f4727b1f310b10794bb9575 *tests/testthat/test-read_xlsx_random_seed.R +0a296bbfe3198fd5948f769650333098 *tests/testthat/test-remove_worksheets.R +e21571984e2ae29b02beb23b14b8b16c *tests/testthat/test-saveWorkbook.R +54bebd50ca1d668af69cc0d458743ea1 *tests/testthat/test-skip_empty_cols.R +179a3782f7a1e55d7d4c24ec83df3bbb *tests/testthat/test-skip_empty_rows.R +9f3b6630177ce77ac5755d4144d28cb4 *tests/testthat/test-styles.R +06e0d2a8da3c7647c19bdafdc63f6e17 *tests/testthat/test-table_overlaps.R +7685508da3dd7844060f87c79e6c0764 *tests/testthat/test-trying_to_break_openxlsx.R +f400fa5db71c9ab82875f2821f29a94f *tests/testthat/test-v3_0_0_bugs.R +d937626a3feced240f4a67d71e6e47fa *tests/testthat/test-validate_table_name.R +fde352f1312b4b66fafe569e318abe44 *tests/testthat/test-worksheet_ordering.R +8de4228f95a3af0a4b91f4e11cab9ef7 *tests/testthat/test-worksheet_renaming.R +9e8b382c6803a05cd800dd5639c874bf *tests/testthat/test-wrappers.R +b1f494ece93839f4c3660fa3b19f0815 *tests/testthat/test-write-permissions.R +9fe1311efe2df719ddea19d307d0702c *tests/testthat/test-writeData.R +30e75874906d40b5568209abd1ecbdf5 *tests/testthat/test-write_data_to_sheetData.R +149627a0393b95d927e2ba2b01abf2fe *tests/testthat/test-write_data_to_sheetData_NAs.R +869e72a4da891348f2d600d420da57aa *tests/testthat/test-write_read_equality.R +600c9e014924e16107ca3f176a76db62 *tests/testthat/test-write_xlsx_vector_args.R +34be2e6e1b5b86ba7a012c3698c7ce6b *tests/testthat/test-writing_posixct.R +2cf18ac5314d141ab2932a007a19650c *tests/testthat/test-writing_sheet_data.R +1981b3039d3a126b8bbe2a592140dc54 *vignettes/Formatting.Rmd +70e145f1e10533307946e36d66a4c1a5 *vignettes/Introduction.Rmd e37f875bb932ea389ed1a8abe3405ccf *vignettes/tableStyles.PNG diff -Nru r-cran-openxlsx-4.2.4/NAMESPACE r-cran-openxlsx-4.2.5/NAMESPACE --- r-cran-openxlsx-4.2.4/NAMESPACE 2021-06-09 10:55:01.000000000 +0000 +++ r-cran-openxlsx-4.2.5/NAMESPACE 2021-12-13 11:50:06.000000000 +0000 @@ -1,108 +1,110 @@ -# Generated by roxygen2: do not edit by hand - -S3method("names<-",Workbook) -S3method(getNamedRegions,Workbook) -S3method(getNamedRegions,default) -S3method(names,Workbook) -S3method(read.xlsx,Workbook) -S3method(read.xlsx,default) -export("activeSheet<-") -export("sheetVisibility<-") -export("sheetVisible<-") -export("worksheetOrder<-") -export(activeSheet) -export(addCreator) -export(addFilter) -export(addStyle) -export(addWorksheet) -export(buildWorkbook) -export(cloneWorksheet) -export(conditionalFormat) -export(conditionalFormatting) -export(convertFromExcelRef) -export(convertToDate) -export(convertToDateTime) -export(copyWorkbook) -export(createComment) -export(createNamedRegion) -export(createStyle) -export(createWorkbook) -export(dataValidation) -export(deleteData) -export(freezePane) -export(getBaseFont) -export(getCellRefs) -export(getCreators) -export(getDateOrigin) -export(getNamedRegions) -export(getSheetNames) -export(getStyles) -export(getTables) -export(groupColumns) -export(groupRows) -export(insertImage) -export(insertPlot) -export(int2col) -export(loadWorkbook) -export(makeHyperlinkString) -export(mergeCells) -export(modifyBaseFont) -export(op.openxlsx) -export(openXL) -export(openxlsx_getOp) -export(openxlsx_setOp) -export(pageBreak) -export(pageSetup) -export(protectWorkbook) -export(protectWorksheet) -export(read.xlsx) -export(readWorkbook) -export(removeCellMerge) -export(removeColWidths) -export(removeComment) -export(removeFilter) -export(removeRowHeights) -export(removeTable) -export(removeWorksheet) -export(renameWorksheet) -export(replaceStyle) -export(saveWorkbook) -export(setColWidths) -export(setFooter) -export(setHeader) -export(setHeaderFooter) -export(setLastModifiedBy) -export(setRowHeights) -export(sheetVisibility) -export(sheetVisible) -export(sheets) -export(showGridLines) -export(ungroupColumns) -export(ungroupRows) -export(worksheetOrder) -export(write.xlsx) -export(writeComment) -export(writeData) -export(writeDataTable) -export(writeFormula) -import(Rcpp) -import(methods) -import(stringi) -importFrom(grDevices,bmp) -importFrom(grDevices,col2rgb) -importFrom(grDevices,colours) -importFrom(grDevices,dev.copy) -importFrom(grDevices,dev.list) -importFrom(grDevices,dev.off) -importFrom(grDevices,jpeg) -importFrom(grDevices,png) -importFrom(grDevices,rgb) -importFrom(grDevices,tiff) -importFrom(stats,na.omit) -importFrom(stats,pchisq) -importFrom(utils,download.file) -importFrom(utils,head) -importFrom(utils,menu) -importFrom(utils,unzip) -importFrom(zip,zipr) -useDynLib(openxlsx, .registration=TRUE) +# Generated by roxygen2: do not edit by hand + +S3method("names<-",Workbook) +S3method(getNamedRegions,Workbook) +S3method(getNamedRegions,default) +S3method(names,Workbook) +S3method(read.xlsx,Workbook) +S3method(read.xlsx,default) +export("activeSheet<-") +export("sheetVisibility<-") +export("sheetVisible<-") +export("worksheetOrder<-") +export(activeSheet) +export(addCreator) +export(addFilter) +export(addStyle) +export(addWorksheet) +export(buildWorkbook) +export(cloneWorksheet) +export(col2int) +export(conditionalFormat) +export(conditionalFormatting) +export(convertFromExcelRef) +export(convertToDate) +export(convertToDateTime) +export(copyWorkbook) +export(createComment) +export(createNamedRegion) +export(createStyle) +export(createWorkbook) +export(dataValidation) +export(deleteData) +export(deleteNamedRegion) +export(freezePane) +export(getBaseFont) +export(getCellRefs) +export(getCreators) +export(getDateOrigin) +export(getNamedRegions) +export(getSheetNames) +export(getStyles) +export(getTables) +export(groupColumns) +export(groupRows) +export(insertImage) +export(insertPlot) +export(int2col) +export(loadWorkbook) +export(makeHyperlinkString) +export(mergeCells) +export(modifyBaseFont) +export(op.openxlsx) +export(openXL) +export(openxlsx_getOp) +export(openxlsx_setOp) +export(pageBreak) +export(pageSetup) +export(protectWorkbook) +export(protectWorksheet) +export(read.xlsx) +export(readWorkbook) +export(removeCellMerge) +export(removeColWidths) +export(removeComment) +export(removeFilter) +export(removeRowHeights) +export(removeTable) +export(removeWorksheet) +export(renameWorksheet) +export(replaceStyle) +export(saveWorkbook) +export(setColWidths) +export(setFooter) +export(setHeader) +export(setHeaderFooter) +export(setLastModifiedBy) +export(setRowHeights) +export(sheetVisibility) +export(sheetVisible) +export(sheets) +export(showGridLines) +export(temp_xlsx) +export(ungroupColumns) +export(ungroupRows) +export(worksheetOrder) +export(write.xlsx) +export(writeComment) +export(writeData) +export(writeDataTable) +export(writeFormula) +import(Rcpp) +import(methods) +import(stringi) +importFrom(grDevices,bmp) +importFrom(grDevices,col2rgb) +importFrom(grDevices,colours) +importFrom(grDevices,dev.copy) +importFrom(grDevices,dev.list) +importFrom(grDevices,dev.off) +importFrom(grDevices,jpeg) +importFrom(grDevices,png) +importFrom(grDevices,rgb) +importFrom(grDevices,tiff) +importFrom(stats,pchisq) +importFrom(utils,download.file) +importFrom(utils,head) +importFrom(utils,menu) +importFrom(utils,unzip) +importFrom(zip,zipr) +useDynLib(openxlsx, .registration=TRUE) diff -Nru r-cran-openxlsx-4.2.4/NEWS.md r-cran-openxlsx-4.2.5/NEWS.md --- r-cran-openxlsx-4.2.4/NEWS.md 2021-06-08 08:11:46.000000000 +0000 +++ r-cran-openxlsx-4.2.5/NEWS.md 2021-12-13 21:58:58.000000000 +0000 @@ -1,469 +1,494 @@ -# development - -## Fixes - -* `write.xlsx()` now successfully passes `withFilter` ([#151](https://github.com/ycphs/openxlsx/issues/151)) -* code clean up PR [#168](https://github.com/ycphs/openxlsx/pull/168) -* removal of unused variables PR [#168](https://github.com/ycphs/openxlsx/pull/168) - -## New features - -* adds `buildWorkbook()` to generate a `Workbook` object from a (named) list or a data.frame ([#192](https://github.com/ycphs/openxlsx/issues/192), [#187](https://github.com/ycphs/openxlsx/issues/187)) - * this is now recommended rather than the `write.xlsx(x, file) ; wb <- read.xlsx(file)` functionality before - * `write.xlsx()` is now a wrapper for `wb <- buildWorkbook(x); saveWorkbook(x, file)` - * parameter checking from `write.xlsx()` >> `buildWorkbook()` are now held off until passed to `writeData()`, `writeDataTable()`, etc - * `row.names` is now deprecated for `writeData()` and `writeDataTable()`; please use `rowNames` instead -* `read.xlsx()` now checks for the file extension `.xlsx`; previously it would throw an error when the file was `.xls` or `.xlm` files -* memory allocation improvements -* global options added for `minWidth` and `maxWidth` -* `write.xlsx()` >> `buildWorkbook()` can now handle `colWidths` passed as either a single element or a `list()` -* Added ability to change positioning of summary columns and rows. - * These can be set with the `summaryCol` and `summaryRow` arguments in `pageSetup()`. -* `activeSheet` allows to set and get the active (displayed) sheet of a worbook. -* Adds new global options for workbook formatting ([#165](https://github.com/ycphs/openxlsx/issues/165); see `?op.openxlsx`) - - - - -# openxlsx 4.2.3 - -## New Features - -* Most of functions in openxlsx now support non-ASCII arguments better. More specifically, we can use non-ASCII strings as names or contents for `createNamedRegion()` ([#103](https://github.com/ycphs/openxlsx/issues/103)), `writeComment()`, `writeData()`, `writeDataTable()` and `writeFormula()`. In addition, openxlsx now reads comments and region names that contain non-ASCII strings correctly on Windows. Thanks to @shrektan for the PR [#118](https://github.com/ycphs/openxlsx/pull/118). - -* `setColWidths()` now supports zero-length `cols`, which is convinient when `cols` is dynamically provided [#128](https://github.com/ycphs/openxlsx/issues/128). Thanks to @shrektan for the feature request and the PR. - -## Fixes for Check issues - -* Fix to pass the tests for link-time optimization type mismatches - -* Fix to pass the checks of native code (C/C++) based on static code analysis - -## Bug Fixes - -* Grouping columns after setting widths no longer throws an error ([#100](https://github.com/ycphs/openxlsx/issues/100)) - -* Fix inability to save workbook more than once ([#106](https://github.com/ycphs/openxlsx/issues/106)) - -* Fix `loadWorkbook()` sometimes importing incorrect column attributes - -# openxlsx 4.2.2 - -## New Features - -* Added features for `conditionalFormatting` to support also 'contains not', 'begins with' and 'ends with' - -* Added return value for `saveWorkbook()` the default value for `returnValue` is `FALSE` ([#71](https://github.com/ycphs/openxlsx/issues/71)) - -* Added Tests for new parameter of `saveWorkbook()` - -## Bug Fixes - -* Solved CRAN check errors based on the change disussed in [PR#17277](https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=17277) - -# openxlsx 4.2.0 - -## New Features - -* Added `groupColumns()`, `groupRows()`, `ungroupColumns()`, and `ungroupRows()` to group/ugroup columns/rows ([#32](https://github.com/ycphs/openxlsx/issues/32)) - -## Bug Fixes - -* Allow xml-sensitve characters in sheetnames ([#78](https://github.com/ycphs/openxlsx/issues/78)) - -## Internal - -* Updated roxygen2 to 7.1.1 - -# openxlsx 4.1.5.1 - -## Bug Fixes - -* fixed issue [#68](https://github.com/ycphs/openxlsx/issues/68]) - -# openxlsx 4.1.5 - -## New Features - -* Add functions to get and set the creator of the xlsx file - -* add function to set the name of the user who last modified the xlsx file - -## Bug Fixes - -* Fixed NEWS hyperlink - -* Fixed writing of mixed EST/EDT datetimes - -* Added description for `writeFormula()` to use only english function names - -* Fixed validateSheet for special characters - -## Internal - -* applied the tidyverse-style to the package `styler::style_pkg()` - -* include tests for `cloneWorksheet` - -# openxlsx 4.1.4 - -## New Features - -* Added `getCellRefs()` as function. [#7](https://github.com/ycphs/openxlsx/issues/7) - -* Added parameter for customizing na.strings - -## Bug Fixes - -* Use `zip::zipr()` instead of `zip::zip()`. - -* Keep correct visibility option for loadWorkbook. [#12](https://github.com/ycphs/openxlsx/issues/12]) - -* Add space surrounding "wrapText" [#17](https://github.com/ycphs/openxlsx/issues/17) - -* Corrected Percentage, Accounting, Comma, Currency class on column level - -## Internal - -* update to rogygen2 7.0.0 - -# openxlsx 4.1.3 - -## New Features - -* Added a `NEWS.md` file to track changes to the package. -* Added `pkgdown` to create site. - -## Bug Fixes - -* Return values for cpp changed to R_NilValue for r-devel tests - -* Added empty lines at the end of files - -# openxlsx 4.1.2 - -* Changed maintainer - -# openxlsx 4.1.1 - -## New Features - -* `sep.names` allows choose other separator than '.' for variable names with a blank inside - -* Improve handling of non-region names in `getNamedRegions` and add related test - -# openxlsx 4.1.0 - -## New Features - -* `deleteNamedRegions` to delete named region and optionally the worksheet data - -* set Workbook properties 'title', 'subject', 'category' - -## Bug Fixes - -* `pageSetup` fails when passing in sheet by name - -* matching sheet names with special characters now works - -* `skipEmptyCols` being ignored by `read.xlsx.Workbook` - -* zero column data.frames would throw an error. - -* `read.xlsx` on files created using apache poi failed to match sheet name to xml file. - -* deleted table re-appearing after save & load. - -* newline characters in table names would corrupt file - -* datetime precision - -# openxlsx 4.0.17 - -## New Features - -* `getNamedRegions` returns sheet name and cell references along with the named regions. - -* `borderStyle` and `borderColour` can be vector to specify different values for each side - -* `dataValidation` type "list" - -* `dataBar showValue`, gradient and border can now be set through conditionalFormatting() - -* options("openxlsx.zipflags") to pass additional flags to zip application e.g. compression level - -* `getTables()` and `removeTable()` to show and remove Excel table objects - -* set column to 'hidden' with `setColWidths()` - -## Bug Fixes - -* `skipEmptyRows` & `skipEmptyCols` was being ignored by `read.xlsx` - -* date detection basic_string error - -* multiple spaces in table column names were not being maintained thus corrupting the xlsx file. - -* openXL fail silently on relative paths - -* `headerStyle` failed when writing a list of length 1 using `write.xlsx` - -* `detectDate` for `read.xlsx` issues - -* some Excel column types causing existing styling to be removed - -* `na.strings` no longer ignored for `read.xlsx.Workbook` - -* partial dollar matches on 'font' and 'fill' fixed - -* maintain hidden columns and their custom widths in `loadWorkbook()` - -* overwriting cells with borders sometimes removed the border styling - -# openxlsx 4.0.0 - -## New Features - -* Reduced RAM usage and improved performance - -* maintain vbaProject, slicers, pivotTables on load - -* Read and load from URL - -## Bug Fixes - -* Fix date time conversion accuracy issues. - -* Allow multibyte characters in names and comments. - -* Remove `tolower()` over style number formats to allow uppercase cell formatting - -* Stacking styles fixed. - -# openxlsx 3.0.2 - -## New Features - -* "between" type for conditional formatting values in some interval. - -* `colWidths` parameter added to `write.xlsx` for auto column widths. - -* `freezePane` parameter handling added to `write.xlsx`. - -* `visible` parameter to `addWorksheet` to hide worksheets. - -* `sheetVisible` function to get and assign worksheet visibility state "hidden"/"visible" - -* `pageBreak` function to add page breaks to worksheets. - -## Bug Fixes - -* `keepNA` parameter added to `write.xlsx`. Passed to `writeData`/`writeDataTable` - -# openxlsx 3.0.1 - -## New Features - -* improved performance of `read.xlsx` and `loadWorkbook` - -* `writeFormula` funciton added to write cell formulas. Also columns - with class "formula" are written as cell formulas similar how column - classes determine cell styling - -* Functionality to write comments and maintain comments with `loadWorkbook` - -* `check.names` argument added `read.xlsx` to make syntactically valid variable names - -* `loadWorkbook` maintains cell indents - -* `namedRegion` parameter added to `read.xlsx` to read a named region. - -* `getNamed` regions to return names of named regions in a workbook - -* `getSheetNames` to get worksheet names within an xlsx file. - -## Bug Fixes - -* `convertToDateTime` now handles NA values - -* `read.xlsx` rows bug fixed where non-consecutive cells were skipped. - -* `convertToDate` & `convertToDateTime` now handle NA values. - -* out of bounds worksheet fixed for libre office xlsx files. - -* `loadWorkbook` now maintains `chartSheets ` - -# openxlsx 2.4.0 - -## New Features - -* stackable cell styling - -* `getDateOrigin` function to return the date origin used internally by the xlsx file to pass to - `convertToDate` - -* Auto-detection of date cells. Cells that "look" like dates will be converted to dates when reading from file. - -* `read.xlsx.Workbook` to read from workbook objects - -* `colIndex`, `rowIndex` added to `read.xlsx` to only read specified rows and columns - -* Excel slicers now maintained by `loadWorkbook` - -* fill styles extended to support `gradientFill` - -## Bug Fixes - -* Encoding fixed and multi-byte characters now supported. - -* `read.xlsx` now maintains multiple consecutive spaces and newline characters. - -* `convertToDate` & `convertToDateTime` now handle NA values. - -* multiple selected worksheet issue whioch preventing adding of new worksheets in Excel. - -* `zoom` parameter now limited to [10, 400] and documentation updated. - -* `write.xlsx` colnames parameter being assigned to rownames - -* Handling of NaN and Inf values in `writeData` - -# openxlsx 2.1.3 - -## New Features - -* `conditionalFormatting` type "databar" - -* `asTable` parameter to `write.xlsx` to writing using `writeDataTable`. - -* extended `numFmt` formatting to numeric rounding also added option("openxlsx.numFmt" = ...) - for default number formatting of numeric columns - -* additional `numFmt` "comma" to format numerics with "," thousands separator - -* `tableName` parameter to `writeDataTable` to assign the table a name - -* `headerStyle` parameter to `writeDataTable` for additional column names styling - -* `textRotation` parameter to `createStyle` to rotate cell text - -* functions `addFilter` & `removeFilter` to add filters to columns - -* Headers & footers extended, can now be set with `addWorksheet` and `setHeaderFooter`. - `setHeader` & `setFooter` deprecated. - -* "fitToWidth" and "fitToHeight" logicals in `pageSetup`. - -* "zoom" parameter in addWorksheet to set worksheet zoom level. - -* "withFilter"" parameter to writeDataTable and writeData to remove table filters - -* `keepNa` parameter to `writeDataTable` and `writeData` to write NA values as #N/A - -* auto column widths can now be set with width = "auto" - -## VIGNETTE - -* section on `write.xlsx` in Introductory vignette - -## Bug Fixes - -* Fix reading in of apostrophes - -* Styling blank cells no longer corrupts workbooks - -* `read.xlsx` now correctly reads `sharedStrings` with inline styling - -* `sharedStrings` now exact matches true/false to determine logical values from workbooks. - -* fomulas in column caused openxlsx to crash. This has been fixed. - -# openxlsx 2.0.15 - -## New Features - -* `writeData` now style based on column class the same as `writeDataTable` - -* Vignette "Formatting" for examples focussed on formatting - -* Customizable date formatting with `createStyle` and also through option("openxlsx.dateFormat" = ...) - -* Customizable POSIX formatting with `createStyle` and also through option("openxlsx.datetimeFormat" = ...) - -* Generalised `conditionalFormat` function to complex expressions and color scales. - -* `writeData` border type "all" to draw all borders and maintain column styling. - -* Deprecated "sheets" and replaced with "names" function - -* column class "scientific" to automatically style as scientific numbers - -* `writeData` now handles additional object classes: coxph, cox.zph, summary.coxph1 from Survival package - -## Bug Fixes - -* Invalid XML characters in hyperlinks now replaced. - -* Encoding issues when writing data read in with `read.xlsx` - -* scientific notation resulting in corrupt workbooks fix - -* Multiple saves of Workbooks containing conditional formatting were corrupt. - -* Latin1 characters now write correctly. - -* logicals written as 0/1 instead of TRUE/FALSE - -# openxlsx 2.0.1 - -## New Features - -* `write.xlsx` function to write data directly to file via the `writeData` function - with basic cell styling. - -* `writeDataTable` now styles columns of class 'Date', 'POSIXct', 'POSIXt', 'currency', 'accounting', 'percentage' - as Excel formats Date, Date, Date, Currency, Accounting, Percentage respectively. - -* Data of class 'Date', 'POSIXct', 'POSIXt', 'currency', 'accounting' are converted to integers - upon writing (as opposed to characters). - -* `writeDataTable` converts columns of class 'hyperlink' to hyperlinks. - -* logicals are converted to Excel booleans - -* hyperlinks in loaded workbooks are now maintained - -* `borderStyle` argument to `createStyle` to modify border line type. - -* `borderStyle` argument to `writeData` to modify border line type. - -* "worksheetOrder" function to shuffle order of worksheets when writing to file - -* `openXL` function to open an excel file or Workbook object - -## Bug Fixes - -* conversion of numeric data to integer in `read.xlsx` fixed. - -* `readWorkbook`/`read.xlsx` should work now. Empty values are - now padded with NA. Many other bugs fixed. - -* borders on single row and/or column data.frames now work. - -* `readWorkbook`/`read.xlsx` check for TRUE/FALSE values is now case-insensitive. - -* sheet names containing invalid xml charcters (&, <, >, ', ") now work when referencing - by name and will not result in a corrupt workbook. - -* sheet names containing non-local characters can now be referenced by name. - -* Invalid factor level when missing values in `writeData` - -* `saveWorkbook` now accepts relative paths. - -* Non-local character encoding issues. - -* errors in vignette examples. - -* numbers with > 8 digits were rounded in `writeData` +# openxlsx 4.2.5 + +## Fixes + +* `openxlsx_setOp()` now works with named list ([#215](https://github.com/ycphs/openxlsx/issues/215)) +* `loadWorkbook()` imports `inlineStr`. Values remain `inlineStr` when writing the workbook with `saveWorkbook()`. Similar `read.xlsx` and `readWorkbook` import `inlineStr`. +* `read.xlsx()` no longer changes random seed ([#183](https://github.com/ycphs/openxlsx/issues/183)) +* fixed a regression that caused fonts to be read in incorrectly ([#207](https://github.com/ycphs/openxlsx/issues/207)) +* add option to save as read only recommended ([#201](https://github.com/ycphs/openxlsx/issues/201)) +* fixed writing hyperlink formulas ([#200](https://github.com/ycphs/openxlsx/issues/200)) +* `write.xlsx()` now throws an error if it doesn't have write permissions ([#190](https://github.com/ycphs/openxlsx/issues/190)) +* `write.xlsx()` now again uses the default of `overwrite = TRUE` for saving files ([#249](https://github.com/ycphs/openxlsx/issues/249)) + +## Improvements + +* `options()` are more consistently set in functions (see: [#289](https://github.com/ycphs/openxlsx/issues/262)) +* `Workbook$show()` no longer fails when called in a 0 sheet workbook([#240](https://github.com/ycphs/openxlsx/issues/240)) +* `read.xlsx()` again accepts `.xlsm` files ([#205](https://github.com/ycphs/openxlsx/issues/205), +[#209](https://github.com/ycphs/openxlsx/issues/209)) +* `makeHyperlinkString()` does no longer require a sheet argument ([#57](https://github.com/ycphs/openxlsx/issues/57), [#58](https://github.com/ycphs/openxlsx/issues/58)) +* improvements in how `openxlsx` creates temporary directories (see [#262](https://github.com/ycphs/openxlsx/issues/262)) +* `writeData()` calls `force(x)` to evaluate the object before options are set ([#264](https://github.com/ycphs/openxlsx/issues/264)) +* `createComment()` now correctly handles `integers` in `width` and `height` ([#275](https://github.com/ycphs/openxlsx/issues/275)) +* `setStyles()` accepts `halign="justify"` ([#305](https://github.com/ycphs/openxlsx/issues/305)) + +# openxlsx 4.2.4 + +## Fixes + +* `write.xlsx()` now successfully passes `withFilter` ([#151](https://github.com/ycphs/openxlsx/issues/151)) +* code clean up PR [#168](https://github.com/ycphs/openxlsx/pull/168) +* removal of unused variables PR [#168](https://github.com/ycphs/openxlsx/pull/168) + +## New features + +* adds `buildWorkbook()` to generate a `Workbook` object from a (named) list or a data.frame ([#192](https://github.com/ycphs/openxlsx/issues/192), [#187](https://github.com/ycphs/openxlsx/issues/187)) + * this is now recommended rather than the `write.xlsx(x, file) ; wb <- read.xlsx(file)` functionality before + * `write.xlsx()` is now a wrapper for `wb <- buildWorkbook(x); saveWorkbook(x, file)` + * parameter checking from `write.xlsx()` >> `buildWorkbook()` are now held off until passed to `writeData()`, `writeDataTable()`, etc + * `row.names` is now deprecated for `writeData()` and `writeDataTable()`; please use `rowNames` instead +* `read.xlsx()` now checks for the file extension `.xlsx`; previously it would throw an error when the file was `.xls` or `.xlm` files +* memory allocation improvements +* global options added for `minWidth` and `maxWidth` +* `write.xlsx()` >> `buildWorkbook()` can now handle `colWidths` passed as either a single element or a `list()` +* Added ability to change positioning of summary columns and rows. + * These can be set with the `summaryCol` and `summaryRow` arguments in `pageSetup()`. +* `activeSheet` allows to set and get the active (displayed) sheet of a workbook. +* Adds new global options for workbook formatting ([#165](https://github.com/ycphs/openxlsx/issues/165); see `?op.openxlsx`) + + + + +# openxlsx 4.2.3 + +## New Features + +* Most of functions in openxlsx now support non-ASCII arguments better. More specifically, we can use non-ASCII strings as names or contents for `createNamedRegion()` ([#103](https://github.com/ycphs/openxlsx/issues/103)), `writeComment()`, `writeData()`, `writeDataTable()` and `writeFormula()`. In addition, openxlsx now reads comments and region names that contain non-ASCII strings correctly on Windows. Thanks to @shrektan for the PR [#118](https://github.com/ycphs/openxlsx/pull/118). + +* `setColWidths()` now supports zero-length `cols`, which is convenient when `cols` is dynamically provided [#128](https://github.com/ycphs/openxlsx/issues/128). Thanks to @shrektan for the feature request and the PR. + +## Fixes for Check issues + +* Fix to pass the tests for link-time optimization type mismatches + +* Fix to pass the checks of native code (C/C++) based on static code analysis + +## Bug Fixes + +* Grouping columns after setting widths no longer throws an error ([#100](https://github.com/ycphs/openxlsx/issues/100)) + +* Fix inability to save workbook more than once ([#106](https://github.com/ycphs/openxlsx/issues/106)) + +* Fix `loadWorkbook()` sometimes importing incorrect column attributes + +# openxlsx 4.2.2 + +## New Features + +* Added features for `conditionalFormatting` to support also 'contains not', 'begins with' and 'ends with' + +* Added return value for `saveWorkbook()` the default value for `returnValue` is `FALSE` ([#71](https://github.com/ycphs/openxlsx/issues/71)) + +* Added Tests for new parameter of `saveWorkbook()` + +## Bug Fixes + +* Solved CRAN check errors based on the change discussed in [PR#17277](https://bugs.r-project.org/show_bug.cgi?id=17277) + +# openxlsx 4.2.0 + +## New Features + +* Added `groupColumns()`, `groupRows()`, `ungroupColumns()`, and `ungroupRows()` to group/ugroup columns/rows ([#32](https://github.com/ycphs/openxlsx/issues/32)) + +## Bug Fixes + +* Allow xml-sensitive characters in sheetnames ([#78](https://github.com/ycphs/openxlsx/issues/78)) + +## Internal + +* Updated roxygen2 to 7.1.1 + +# openxlsx 4.1.5.1 + +## Bug Fixes + +* fixed issue [#68](https://github.com/ycphs/openxlsx/issues/68]) + +# openxlsx 4.1.5 + +## New Features + +* Add functions to get and set the creator of the xlsx file + +* add function to set the name of the user who last modified the xlsx file + +## Bug Fixes + +* Fixed NEWS hyperlink + +* Fixed writing of mixed EST/EDT datetimes + +* Added description for `writeFormula()` to use only English function names + +* Fixed validateSheet for special characters + +## Internal + +* applied the tidyverse-style to the package `styler::style_pkg()` + +* include tests for `cloneWorksheet` + +# openxlsx 4.1.4 + +## New Features + +* Added `getCellRefs()` as function. [#7](https://github.com/ycphs/openxlsx/issues/7) + +* Added parameter for customizing na.strings + +## Bug Fixes + +* Use `zip::zipr()` instead of `zip::zip()`. + +* Keep correct visibility option for loadWorkbook. [#12](https://github.com/ycphs/openxlsx/issues/12]) + +* Add space surrounding "wrapText" [#17](https://github.com/ycphs/openxlsx/issues/17) + +* Corrected Percentage, Accounting, Comma, Currency class on column level + +## Internal + +* update to roxygen2 7.0.0 + +# openxlsx 4.1.3 + +## New Features + +* Added a `NEWS.md` file to track changes to the package. +* Added `pkgdown` to create site. + +## Bug Fixes + +* Return values for cpp changed to R_NilValue for r-devel tests + +* Added empty lines at the end of files + +# openxlsx 4.1.2 + +* Changed maintainer + +# openxlsx 4.1.1 + +## New Features + +* `sep.names` allows choose other separator than '.' for variable names with a blank inside + +* Improve handling of non-region names in `getNamedRegions` and add related test + +# openxlsx 4.1.0 + +## New Features + +* `deleteNamedRegions` to delete named region and optionally the worksheet data + +* set Workbook properties 'title', 'subject', 'category' + +## Bug Fixes + +* `pageSetup` fails when passing in sheet by name + +* matching sheet names with special characters now works + +* `skipEmptyCols` being ignored by `read.xlsx.Workbook` + +* zero column data.frames would throw an error. + +* `read.xlsx` on files created using apache poi failed to match sheet name to xml file. + +* deleted table re-appearing after save & load. + +* newline characters in table names would corrupt file + +* datetime precision + +# openxlsx 4.0.17 + +## New Features + +* `getNamedRegions` returns sheet name and cell references along with the named regions. + +* `borderStyle` and `borderColour` can be vector to specify different values for each side + +* `dataValidation` type "list" + +* `dataBar showValue`, gradient and border can now be set through conditionalFormatting() + +* options("openxlsx.zipflags") to pass additional flags to zip application e.g. compression level + +* `getTables()` and `removeTable()` to show and remove Excel table objects + +* set column to 'hidden' with `setColWidths()` + +## Bug Fixes + +* `skipEmptyRows` & `skipEmptyCols` was being ignored by `read.xlsx` + +* date detection basic_string error + +* multiple spaces in table column names were not being maintained thus corrupting the xlsx file. + +* openXL fail silently on relative paths + +* `headerStyle` failed when writing a list of length 1 using `write.xlsx` + +* `detectDate` for `read.xlsx` issues + +* some Excel column types causing existing styling to be removed + +* `na.strings` no longer ignored for `read.xlsx.Workbook` + +* partial dollar matches on 'font' and 'fill' fixed + +* maintain hidden columns and their custom widths in `loadWorkbook()` + +* overwriting cells with borders sometimes removed the border styling + +# openxlsx 4.0.0 + +## New Features + +* Reduced RAM usage and improved performance + +* maintain vbaProject, slicers, pivotTables on load + +* Read and load from URL + +## Bug Fixes + +* Fix date time conversion accuracy issues. + +* Allow multibyte characters in names and comments. + +* Remove `tolower()` over style number formats to allow uppercase cell formatting + +* Stacking styles fixed. + +# openxlsx 3.0.2 + +## New Features + +* "between" type for conditional formatting values in some interval. + +* `colWidths` parameter added to `write.xlsx` for auto column widths. + +* `freezePane` parameter handling added to `write.xlsx`. + +* `visible` parameter to `addWorksheet` to hide worksheets. + +* `sheetVisible` function to get and assign worksheet visibility state "hidden"/"visible" + +* `pageBreak` function to add page breaks to worksheets. + +## Bug Fixes + +* `keepNA` parameter added to `write.xlsx`. Passed to `writeData`/`writeDataTable` + +# openxlsx 3.0.1 + +## New Features + +* improved performance of `read.xlsx` and `loadWorkbook` + +* `writeFormula` function added to write cell formulas. Also columns + with class "formula" are written as cell formulas similar how column + classes determine cell styling + +* Functionality to write comments and maintain comments with `loadWorkbook` + +* `check.names` argument added `read.xlsx` to make syntactically valid variable names + +* `loadWorkbook` maintains cell indents + +* `namedRegion` parameter added to `read.xlsx` to read a named region. + +* `getNamed` regions to return names of named regions in a workbook + +* `getSheetNames` to get worksheet names within an xlsx file. + +## Bug Fixes + +* `convertToDateTime` now handles NA values + +* `read.xlsx` rows bug fixed where non-consecutive cells were skipped. + +* `convertToDate` & `convertToDateTime` now handle NA values. + +* out of bounds worksheet fixed for libre office xlsx files. + +* `loadWorkbook` now maintains `chartSheets ` + +# openxlsx 2.4.0 + +## New Features + +* stackable cell styling + +* `getDateOrigin` function to return the date origin used internally by the xlsx file to pass to + `convertToDate` + +* Auto-detection of date cells. Cells that "look" like dates will be converted to dates when reading from file. + +* `read.xlsx.Workbook` to read from workbook objects + +* `colIndex`, `rowIndex` added to `read.xlsx` to only read specified rows and columns + +* Excel slicers now maintained by `loadWorkbook` + +* fill styles extended to support `gradientFill` + +## Bug Fixes + +* Encoding fixed and multi-byte characters now supported. + +* `read.xlsx` now maintains multiple consecutive spaces and newline characters. + +* `convertToDate` & `convertToDateTime` now handle NA values. + +* multiple selected worksheet issue which preventing adding of new worksheets in Excel. + +* `zoom` parameter now limited to [10, 400] and documentation updated. + +* `write.xlsx` colnames parameter being assigned to rownames + +* Handling of NaN and Inf values in `writeData` + +# openxlsx 2.1.3 + +## New Features + +* `conditionalFormatting` type "databar" + +* `asTable` parameter to `write.xlsx` to writing using `writeDataTable`. + +* extended `numFmt` formatting to numeric rounding also added option("openxlsx.numFmt" = ...) + for default number formatting of numeric columns + +* additional `numFmt` "comma" to format numerics with "," thousands separator + +* `tableName` parameter to `writeDataTable` to assign the table a name + +* `headerStyle` parameter to `writeDataTable` for additional column names styling + +* `textRotation` parameter to `createStyle` to rotate cell text + +* functions `addFilter` & `removeFilter` to add filters to columns + +* Headers & footers extended, can now be set with `addWorksheet` and `setHeaderFooter`. + `setHeader` & `setFooter` deprecated. + +* "fitToWidth" and "fitToHeight" logicals in `pageSetup`. + +* "zoom" parameter in addWorksheet to set worksheet zoom level. + +* "withFilter"" parameter to writeDataTable and writeData to remove table filters + +* `keepNa` parameter to `writeDataTable` and `writeData` to write NA values as #N/A + +* auto column widths can now be set with width = "auto" + +## VIGNETTE + +* section on `write.xlsx` in Introductory vignette + +## Bug Fixes + +* Fix reading in of apostrophes + +* Styling blank cells no longer corrupts workbooks + +* `read.xlsx` now correctly reads `sharedStrings` with inline styling + +* `sharedStrings` now exact matches true/false to determine logical values from workbooks. + +* fomulas in column caused openxlsx to crash. This has been fixed. + +# openxlsx 2.0.15 + +## New Features + +* `writeData` now style based on column class the same as `writeDataTable` + +* Vignette "Formatting" for examples focused on formatting + +* Customizable date formatting with `createStyle` and also through option("openxlsx.dateFormat" = ...) + +* Customizable POSIX formatting with `createStyle` and also through option("openxlsx.datetimeFormat" = ...) + +* Generalised `conditionalFormat` function to complex expressions and color scales. + +* `writeData` border type "all" to draw all borders and maintain column styling. + +* Deprecated "sheets" and replaced with "names" function + +* column class "scientific" to automatically style as scientific numbers + +* `writeData` now handles additional object classes: coxph, cox.zph, summary.coxph1 from Survival package + +## Bug Fixes + +* Invalid XML characters in hyperlinks now replaced. + +* Encoding issues when writing data read in with `read.xlsx` + +* scientific notation resulting in corrupt workbooks fix + +* Multiple saves of Workbooks containing conditional formatting were corrupt. + +* Latin1 characters now write correctly. + +* logicals written as 0/1 instead of TRUE/FALSE + +# openxlsx 2.0.1 + +## New Features + +* `write.xlsx` function to write data directly to file via the `writeData` function + with basic cell styling. + +* `writeDataTable` now styles columns of class 'Date', 'POSIXct', 'POSIXt', 'currency', 'accounting', 'percentage' + as Excel formats Date, Date, Date, Currency, Accounting, Percentage respectively. + +* Data of class 'Date', 'POSIXct', 'POSIXt', 'currency', 'accounting' are converted to integers + upon writing (as opposed to characters). + +* `writeDataTable` converts columns of class 'hyperlink' to hyperlinks. + +* logicals are converted to Excel booleans + +* hyperlinks in loaded workbooks are now maintained + +* `borderStyle` argument to `createStyle` to modify border line type. + +* `borderStyle` argument to `writeData` to modify border line type. + +* "worksheetOrder" function to shuffle order of worksheets when writing to file + +* `openXL` function to open an excel file or Workbook object + +## Bug Fixes + +* conversion of numeric data to integer in `read.xlsx` fixed. + +* `readWorkbook`/`read.xlsx` should work now. Empty values are + now padded with NA. Many other bugs fixed. + +* borders on single row and/or column data.frames now work. + +* `readWorkbook`/`read.xlsx` check for TRUE/FALSE values is now case-insensitive. + +* sheet names containing invalid xml characters (&, <, >, ', ") now work when referencing + by name and will not result in a corrupt workbook. + +* sheet names containing non-local characters can now be referenced by name. + +* Invalid factor level when missing values in `writeData` + +* `saveWorkbook` now accepts relative paths. + +* Non-local character encoding issues. + +* errors in vignette examples. + +* numbers with > 8 digits were rounded in `writeData` diff -Nru r-cran-openxlsx-4.2.4/R/asserts.R r-cran-openxlsx-4.2.5/R/asserts.R --- r-cran-openxlsx-4.2.4/R/asserts.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/asserts.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,80 +1,96 @@ -# Assertions for parameter validates -# These should be used at the beginning of functions to stop execution early - -assert_class <- function(x, class, or_null = FALSE) { - sx <- as.character(substitute(x)) - ok <- inherits(x, class) - - if (or_null) { - ok <- ok | is.null(x) - class <- c(class, "null") - } - - if (!ok) { - msg <- sprintf("%s must be of class %s", sx, paste(class, collapse = " or ")) - stop(msg, call. = FALSE) - } -} - -assert_length <- function(x, n) { - stopifnot(is.integer(n)) - if (length(x) != n) { - msg <- sprintf("%s must be of length %iL", substitute(x), n) - stop(msg, call. = FALSE) - } -} - -assert_true_false1 <- function(x) { - if (!is_true_false(x)) { - stop(substitute(x), " must be TRUE or FALSE", call. = FALSE) - } -} - -assert_true_false <- function(x) { - ok <- is.logical(x) & !is.na(x) - if (!ok) { - stop(substitute(x), " must be a logical vector with NAs", call. = FALSE) - } -} - -assert_character1 <- function(x, scalar = FALSE) { - ok <- is.character(x) && length(x) == 1L - - if (scalar) { - ok <- ok & nchar(x) == 1L - } - - if (!ok) { - stop(substitute(x), " must be a character vector of length 1L", call. = FALSE) - } -} - -assert_unique <- function(x, case_sensitive = TRUE) { - msg <- paste0(substitute(x), " must be a unique vector") - - if (!case_sensitive) { - x <- tolower(x) - msg <- paste0(msg, " (case sensitive)") - } - - if (anyDuplicated(x) != 0L) { - stop(msg, call. = FALSE) - } -} - -# validates --------------------------------------------------------------- - -validate_StyleName <- function(x) { - m <- valid_StyleNames[match(tolower(x), valid_StyleNames_low)] - if (anyNA(m)) { - stop( - "Invalid table style: ", - paste0(sprintf("'%s'", x[is.na(m)]), collapse = ", "), - call. = FALSE - ) - } - m -} - -valid_StyleNames <- c("none", paste0("TableStyleLight", 1:21), paste0("TableStyleMedium", 1:28), paste0("TableStyleDark", 1:11)) -valid_StyleNames_low <- tolower(valid_StyleNames) +# Assertions for parameter validates +# These should be used at the beginning of functions to stop execution early + +assert_class <- function(x, class, or_null = FALSE) { + sx <- as.character(substitute(x)) + ok <- inherits(x, class) + + if (or_null) { + ok <- ok | is.null(x) + class <- c(class, "null") + } + + if (!ok) { + msg <- sprintf("%s must be of class %s", sx, paste(class, collapse = " or ")) + stop(msg, call. = FALSE) + } +} + +assert_length <- function(x, n) { + stopifnot(is.integer(n)) + if (length(x) != n) { + msg <- sprintf("%s must be of length %iL", substitute(x), n) + stop(msg, call. = FALSE) + } +} + +assert_true_false1 <- function(x) { + if (!is_true_false(x)) { + stop(substitute(x), " must be TRUE or FALSE", call. = FALSE) + } +} + +assert_true_false <- function(x) { + ok <- is.logical(x) & !is.na(x) + if (!ok) { + stop(substitute(x), " must be a logical vector with NAs", call. = FALSE) + } +} + +assert_character1 <- function(x, scalar = FALSE) { + ok <- is.character(x) && length(x) == 1L + + if (scalar) { + ok <- ok & nchar(x) == 1L + } + + if (!ok) { + stop(substitute(x), " must be a character vector of length 1L", call. = FALSE) + } +} + +assert_unique <- function(x, case_sensitive = TRUE) { + msg <- paste0(substitute(x), " must be a unique vector") + + if (!case_sensitive) { + x <- tolower(x) + msg <- paste0(msg, " (case sensitive)") + } + + if (anyDuplicated(x) != 0L) { + stop(msg, call. = FALSE) + } +} + +assert_numeric1 <- function(x, scalar = FALSE) { + msg <- paste0(substitute(x), " must be a ") + ok <- is.numeric(x) & length(x) == 1L + + if (scalar) { + ok <- ok && nchar(x) == 1L + msg <- paste0(msg, "single number") + } else { + msg <- paste0(msg, "numeric vector of length 1L") + } + + if (!ok) { + stop(msg, call. = FALSE) + } +} + +# validates --------------------------------------------------------------- + +validate_StyleName <- function(x) { + m <- valid_StyleNames[match(tolower(x), valid_StyleNames_low)] + if (anyNA(m)) { + stop( + "Invalid table style: ", + paste0(sprintf("'%s'", x[is.na(m)]), collapse = ", "), + call. = FALSE + ) + } + m +} + +valid_StyleNames <- c("none", paste0("TableStyleLight", 1:21), paste0("TableStyleMedium", 1:28), paste0("TableStyleDark", 1:11)) +valid_StyleNames_low <- tolower(valid_StyleNames) diff -Nru r-cran-openxlsx-4.2.4/R/baseXML.R r-cran-openxlsx-4.2.5/R/baseXML.R --- r-cran-openxlsx-4.2.4/R/baseXML.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/baseXML.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,485 +1,485 @@ - - -genBaseContent_Type <- function() { - c( - '', - '', - '', - '', - '', - '', - '', - '', - '' - ) -} - - -genBaseShapeVML <- function(clientData, id) { - if (grepl("visible", clientData, ignore.case = TRUE)) { - visible <- "visible" - } else { - visible <- "hidden" - } - - paste0( - sprintf('', visible), - ' - - - -
- ', clientData, "" - ) -} - - - - - -genClientData <- function(col, row, visible, height, width) { - txt <- sprintf( - '%s, 15, %s, 10, %s, 147, %s, 18False%s%s', - col, row - 2L, col + width - 1L, row + height - 1L, row - 1L, col - 1L - ) - - if (visible) { - txt <- paste0(txt, "") - } - - txt <- paste0(txt, "") - - return(txt) -} - - -# genBaseRels <- function(){ -# -# ' -# -# ' -# -# } -# -# -# genBaseApp <- function(){ -# list('Microsoft Excel') -# } - - -genBaseCore <- function(creator = "", title = NULL, subject = NULL, category = NULL) { - core <- '' - - core <- stri_c(core, sprintf("%s", creator)) - core <- stri_c(core, sprintf("%s", creator)) - core <- stri_c(core, sprintf('%s', format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ"))) - - if (!is.null(title)) { - core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(title))) - } - - if (!is.null(subject)) { - core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(subject))) - } - - if (!is.null(category)) { - core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(category))) - } - - core <- stri_c(core, "") - - return(core) -} - -# -# addAuthor <- function(wb,Author = NULL){ -# -# if (!is.null(Author)) { -# current_creator <- -# stri_match(wb$core, regex = "(.*?)")[1, 2] -# wb$core <- -# stri_replace_all_fixed( -# wb$core, -# pattern = current_creator, -# replacement = stri_c(current_creator, Author, sep = ";") -# ) -# } -# -# -# } -# -# -# setAuthor <- function(wb,Author = NULL){ -# -# if (!is.null(Author)) { -# current_creator <- -# stri_match(wb$core, regex = "(.*?)")[1, 2] -# wb$core <- -# stri_replace_all_fixed( -# wb$core, -# pattern = current_creator, -# replacement = Author -# ) -# } -# -# -# } -# -# setLastModifiedBy <- function(wb,ModifiedBy=NULL){ -# -# if (!is.null(addmodifier)) { -# current_lastmodifier <- -# stri_match(wb$core, regex = "(.*?)")[1, 2] -# wb$core <- -# stri_replace_all_fixed( -# wb$core, -# pattern = current_lastmodifier, -# replacement = ModifiedBy -# ) -# } -# -# -# } -# -# - -# -# -# setBaseCore <- function(core,setcreator="",setmodifier="", -# title = NULL, subject = NULL, category = NULL){ -# -# -# core <- c(core, sprintf('%s', setcreator)) -# core <- c(core, sprintf('%s', format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ"))) -# -# if(!is.null(title)) -# core <- c(core, sprintf('%s', replaceIllegalCharacters(title))) -# -# if(!is.null(subject)) -# core <- c(core, sprintf('%s', replaceIllegalCharacters(subject))) -# -# if(!is.null(category)) -# core <- c(core, sprintf('%s', replaceIllegalCharacters(category))) -# -# core <- c(core, '') -# -# return(core) -# -# } - - - - -genBaseWorkbook.xml.rels <- function() { - c( - '', - '', - '' - ) -} - - -genBaseWorkbook <- function() { - list( - workbookPr = '', - workbookProtection = NULL, - bookViews = '', - sheets = NULL, - externalReferences = NULL, - definedNames = NULL, - calcPr = NULL, - pivotCaches = NULL, - extLst = NULL - ) -} - - - - -genBaseSheetRels <- function(sheetInd) { - c( - sprintf('', sheetInd), - sprintf('', sheetInd), - sprintf('', sheetInd) - ) -} - -genBaseStyleSheet <- function(dxfs = NULL, tableStyles = NULL, extLst = NULL) { - list( - numFmts = NULL, - - fonts = c(''), - - fills = c( - '', - '' - ), - - borders = c(""), - - cellStyleXfs = c(''), - - cellXfs = c(''), - - cellStyles = c(''), - - dxfs = dxfs, - - tableStyles = tableStyles, - - indexedColors = NULL, - - extLst = extLst - ) -} - - -genBasePic <- function(imageNo) { - sprintf(' - - - - - - - - - - - - - - - - - - - ', imageNo, imageNo, imageNo) -} - - - - - - - - - - -genBaseTheme <- function() { - ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' -} - - - - -genPrinterSettings <- function() { - "5c 00 5c 00 41 00 55 00 43 00 41 00 4c 00 50 00 52 00 4f 00 44 00 46 00 50 00 5c 00 4c 00 31 00 34 00 78 00 65 00 72 00 6f 00 78 00 31 00 20 00 2d 00 20 00 58 00 65 00 72 00 6f 00 00 00 00 00 01 04 00 52 dc 00 5c 05 13 ff 81 07 02 00 09 00 9a 0b 34 08 64 00 01 00 0f 00 2c 01 02 00 02 00 2c 01 03 00 01 00 41 00 34 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 01 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 52 c0 21 46 00 58 00 20 00 41 00 70 00 65 00 6f 00 73 00 50 00 6f 00 72 00 74 00 2d 00 49 00 49 00 49 00 20 00 43 00 34 00 34 00 30 00 30 00 20 00 50 00 43 00 4c 00 20 00 36 00 00 00 00 00 00 00 00 00 4e 08 a0 13 40 09 08 00 0b 01 64 00 01 00 07 00 01 00 00 00 00 00 00 00 00 00 07 00 01 00 08 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 08 08 08 00 08 08 08 00 08 08 08 00 08 08 08 00 00 01 03 00 02 02 00 01 02 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 00 00 00 02 02 48 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 bc 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 05 00 00 00 00 00 00 08 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 0b 96 00 00 00 c8 00 01 01 01 01 01 01 01 01 01 01 01 01 09 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 bc 02 00 00 00 00 00 00 00 00 02 00 41 00 72 00 69 00 61 00 6c 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 01 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 12 70 5f 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00" -} - - -gen_databar_extlst <- function(guid, sqref, posColour, negColour, values, border, gradient) { - xml <- sprintf('', guid, border, gradient) - - if (is.null(values)) { - xml <- sprintf(' - %s - - %s', xml, posColour, negColour, negColour, sqref) - } else { - xml <- sprintf(' - %s - %s%s - - %s', xml, values[[1]], values[[2]], posColour, negColour, negColour, sqref) - } - - return(xml) -} - - - -contentTypePivotXML <- function(i) { - c( - sprintf('', i), - sprintf('', i), - sprintf('', i) - ) -} - -contentTypeSlicerCacheXML <- function(i) { - c( - sprintf('', i), - sprintf('', i) - ) -} - - -genBaseSlicerXML <- function() { - ' - - - - ' -} - - -genSlicerCachesExtLst <- function(i) { - paste0( - ' - - ', - - paste(sprintf('', i), collapse = ""), - - "" - ) -} + + +genBaseContent_Type <- function() { + c( + '', + '', + '', + '', + '', + '', + '', + '', + '' + ) +} + + +genBaseShapeVML <- function(clientData, id) { + if (grepl("visible", clientData, ignore.case = TRUE)) { + visible <- "visible" + } else { + visible <- "hidden" + } + + paste0( + sprintf('', visible), + ' + + + +
+ ', clientData, "" + ) +} + + + + + +genClientData <- function(col, row, visible, height, width) { + txt <- sprintf( + '%s, 15, %s, 10, %s, 147, %s, 18False%s%s', + col, row - 2L, col + width - 1L, row + height - 1L, row - 1L, col - 1L + ) + + if (visible) { + txt <- paste0(txt, "") + } + + txt <- paste0(txt, "") + + return(txt) +} + + +# genBaseRels <- function(){ +# +# ' +# +# ' +# +# } +# +# +# genBaseApp <- function(){ +# list('Microsoft Excel') +# } + + +genBaseCore <- function(creator = "", title = NULL, subject = NULL, category = NULL) { + core <- '' + + core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(creator))) + core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(creator))) + core <- stri_c(core, sprintf('%s', format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ"))) + + if (!is.null(title)) { + core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(title))) + } + + if (!is.null(subject)) { + core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(subject))) + } + + if (!is.null(category)) { + core <- stri_c(core, sprintf("%s", replaceIllegalCharacters(category))) + } + + core <- stri_c(core, "") + + return(core) +} + +# +# addAuthor <- function(wb,Author = NULL){ +# +# if (!is.null(Author)) { +# current_creator <- +# stri_match(wb$core, regex = "(.*?)")[1, 2] +# wb$core <- +# stri_replace_all_fixed( +# wb$core, +# pattern = current_creator, +# replacement = stri_c(current_creator, Author, sep = ";") +# ) +# } +# +# +# } +# +# +# setAuthor <- function(wb,Author = NULL){ +# +# if (!is.null(Author)) { +# current_creator <- +# stri_match(wb$core, regex = "(.*?)")[1, 2] +# wb$core <- +# stri_replace_all_fixed( +# wb$core, +# pattern = current_creator, +# replacement = Author +# ) +# } +# +# +# } +# +# setLastModifiedBy <- function(wb,ModifiedBy=NULL){ +# +# if (!is.null(addmodifier)) { +# current_lastmodifier <- +# stri_match(wb$core, regex = "(.*?)")[1, 2] +# wb$core <- +# stri_replace_all_fixed( +# wb$core, +# pattern = current_lastmodifier, +# replacement = ModifiedBy +# ) +# } +# +# +# } +# +# + +# +# +# setBaseCore <- function(core,setcreator="",setmodifier="", +# title = NULL, subject = NULL, category = NULL){ +# +# +# core <- c(core, sprintf('%s', setcreator)) +# core <- c(core, sprintf('%s', format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ"))) +# +# if(!is.null(title)) +# core <- c(core, sprintf('%s', replaceIllegalCharacters(title))) +# +# if(!is.null(subject)) +# core <- c(core, sprintf('%s', replaceIllegalCharacters(subject))) +# +# if(!is.null(category)) +# core <- c(core, sprintf('%s', replaceIllegalCharacters(category))) +# +# core <- c(core, '') +# +# return(core) +# +# } + + + + +genBaseWorkbook.xml.rels <- function() { + c( + '', + '', + '' + ) +} + + +genBaseWorkbook <- function() { + list( + workbookPr = '', + workbookProtection = NULL, + bookViews = '', + sheets = NULL, + externalReferences = NULL, + definedNames = NULL, + calcPr = NULL, + pivotCaches = NULL, + extLst = NULL + ) +} + + + + +genBaseSheetRels <- function(sheetInd) { + c( + sprintf('', sheetInd), + sprintf('', sheetInd), + sprintf('', sheetInd) + ) +} + +genBaseStyleSheet <- function(dxfs = NULL, tableStyles = NULL, extLst = NULL) { + list( + numFmts = NULL, + + fonts = c(''), + + fills = c( + '', + '' + ), + + borders = c(""), + + cellStyleXfs = c(''), + + cellXfs = c(''), + + cellStyles = c(''), + + dxfs = dxfs, + + tableStyles = tableStyles, + + indexedColors = NULL, + + extLst = extLst + ) +} + + +genBasePic <- function(imageNo) { + sprintf(' + + + + + + + + + + + + + + + + + + + ', imageNo, imageNo, imageNo) +} + + + + + + + + + + +genBaseTheme <- function() { + ' + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ' +} + + + + +genPrinterSettings <- function() { + "5c 00 5c 00 41 00 55 00 43 00 41 00 4c 00 50 00 52 00 4f 00 44 00 46 00 50 00 5c 00 4c 00 31 00 34 00 78 00 65 00 72 00 6f 00 78 00 31 00 20 00 2d 00 20 00 58 00 65 00 72 00 6f 00 00 00 00 00 01 04 00 52 dc 00 5c 05 13 ff 81 07 02 00 09 00 9a 0b 34 08 64 00 01 00 0f 00 2c 01 02 00 02 00 2c 01 03 00 01 00 41 00 34 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 01 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 52 c0 21 46 00 58 00 20 00 41 00 70 00 65 00 6f 00 73 00 50 00 6f 00 72 00 74 00 2d 00 49 00 49 00 49 00 20 00 43 00 34 00 34 00 30 00 30 00 20 00 50 00 43 00 4c 00 20 00 36 00 00 00 00 00 00 00 00 00 4e 08 a0 13 40 09 08 00 0b 01 64 00 01 00 07 00 01 00 00 00 00 00 00 00 00 00 07 00 01 00 08 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 08 08 08 00 08 08 08 00 08 08 08 00 08 08 08 00 00 01 03 00 02 02 00 01 02 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 00 00 00 02 02 48 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 bc 02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 05 00 00 00 00 00 00 08 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 0b 96 00 00 00 c8 00 01 01 01 01 01 01 01 01 01 01 01 01 09 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 bc 02 00 00 00 00 00 00 00 00 02 00 41 00 72 00 69 00 61 00 6c 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 01 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 12 70 5f 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00" +} + + +gen_databar_extlst <- function(guid, sqref, posColour, negColour, values, border, gradient) { + xml <- sprintf('', guid, border, gradient) + + if (is.null(values)) { + xml <- sprintf(' + %s + + %s', xml, posColour, negColour, negColour, sqref) + } else { + xml <- sprintf(' + %s + %s%s + + %s', xml, values[[1]], values[[2]], posColour, negColour, negColour, sqref) + } + + return(xml) +} + + + +contentTypePivotXML <- function(i) { + c( + sprintf('', i), + sprintf('', i), + sprintf('', i) + ) +} + +contentTypeSlicerCacheXML <- function(i) { + c( + sprintf('', i), + sprintf('', i) + ) +} + + +genBaseSlicerXML <- function() { + ' + + + + ' +} + + +genSlicerCachesExtLst <- function(i) { + paste0( + ' + + ', + + paste(sprintf('', i), collapse = ""), + + "" + ) +} diff -Nru r-cran-openxlsx-4.2.4/R/borderFunctions.R r-cran-openxlsx-4.2.5/R/borderFunctions.R --- r-cran-openxlsx-4.2.4/R/borderFunctions.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/borderFunctions.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,596 +1,596 @@ - -genBaseColStyle <- function(cc) { - colStyle <- createStyle() - specialFormat <- TRUE - - if ("date" %in% cc) { - colStyle <- createStyle(numFmt = "date") - } else if (any(c("posixlt", "posixct", "posixt") %in% cc)) { - colStyle <- createStyle(numFmt = "longdate") - } else if ("currency" %in% cc) { - colStyle$numFmt <- list(numFmtId = "164", "formatCode" = ""$"#,##0.00") - } else if ("accounting" %in% cc) { - colStyle$numFmt <- list(numFmtIs = "44") - } else if ("hyperlink" %in% cc) { - colStyle$fontColour <- list(theme = "10") - } else if ("percentage" %in% cc) { - colStyle$numFmt <- list(numFmtIs = "10") - } else if ("scientific" %in% cc) { - colStyle$numFmt <- list(numFmtId = "11") - } else if (any(c("3", "comma") %in% cc)) { - colStyle$numFmt <- list(numFmtId = "3") - } else if ("numeric" %in% cc & !grepl("[^0\\.,#\\$\\* %]", openxlsx_getOp("numFmt"))) { - colStyle$numFmt <- list(numFmtId = 9999, formatCode = openxlsx_getOp("numFmt")) - } else { - colStyle$numFmt <- list(numFmtId = "0") - specialFormat <- FALSE - } - - list( - style = colStyle, - specialFormat = specialFormat - ) -} - - - -Workbook$methods(surroundingBorders = function( - colClasses, - sheet, - startRow, - startCol, - nRow, - nCol, - borderColour, - borderStyle, - borderType -) { - sheet <- sheet_names[[validateSheet(sheet)]] - ## steps - # get column class - # get corresponding base style - - for (i in 1:nCol) { - tmp <- genBaseColStyle(colClasses[[i]]) - - colStyle <- tmp$style - specialFormat <- tmp$specialFormat - - ## create style objects - sTop <- colStyle$copy() - sMid <- colStyle$copy() - sBot <- colStyle$copy() - - ## First column - if (i == 1) { - if (nRow == 1 & nCol == 1) { - - ## All - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol - ) - )) - } else if (nCol == 1) { - - ## Top - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - - ## Middle - sMid$borderLeft <- borderStyle - sMid$borderLeftColour <- borderColour - - sMid$borderRight <- borderStyle - sMid$borderRightColour <- borderColour - - ## Bottom - sBot$borderBottom <- borderStyle - sBot$borderBottomColour <- borderColour - - sBot$borderLeft <- borderStyle - sBot$borderLeftColour <- borderColour - - sBot$borderRight <- borderStyle - sBot$borderRightColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol - ) - )) - - styleObjects <<- append(styleObjects, list( - list( - "style" = sMid, - "sheet" = sheet, - "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last - "cols" = rep.int(startCol, nRow - 2L) - ) - )) - - styleObjects <<- append(styleObjects, list( - list( - "style" = sBot, - "sheet" = sheet, - "rows" = startRow + nRow - 1L, - "cols" = startCol - ) - )) - } else if (nRow == 1) { - - ## All - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol - ) - )) - } else { - - ## Top - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - ## Middle - sMid$borderLeft <- borderStyle - sMid$borderLeftColour <- borderColour - - ## Bottom - sBot$borderLeft <- borderStyle - sBot$borderLeftColour <- borderColour - - sBot$borderBottom <- borderStyle - sBot$borderBottomColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol - ) - )) - - if (nRow > 2) { - styleObjects <<- append(styleObjects, list( - list( - "style" = sMid, - "sheet" = sheet, - "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last - "cols" = rep.int(startCol, nRow - 2L) - ) - )) - } - - styleObjects <<- append(styleObjects, list( - list( - "style" = sBot, - "sheet" = sheet, - "rows" = startRow + nRow - 1L, - "cols" = startCol - ) - )) - } - } else if (i == nCol) { - if (nRow == 1) { - - ## All - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol + nCol - 1L - ) - )) - } else { - - ## Top - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - ## Middle - sMid$borderRight <- borderStyle - sMid$borderRightColour <- borderColour - - ## Bottom - sBot$borderRight <- borderStyle - sBot$borderRightColour <- borderColour - - sBot$borderBottom <- borderStyle - sBot$borderBottomColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol + nCol - 1L - ) - )) - - if (nRow > 2) { - styleObjects <<- append(styleObjects, list( - list( - "style" = sMid, - "sheet" = sheet, - "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last - "cols" = rep.int(startCol + nCol - 1L, nRow - 2L) - ) - )) - } - - - styleObjects <<- append(styleObjects, list( - list( - "style" = sBot, - "sheet" = sheet, - "rows" = startRow + nRow - 1L, - "cols" = startCol + nCol - 1L - ) - )) - } - } else { ## inside columns - - if (nRow == 1) { - - ## Top - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - ## Bottom - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol + i - 1L - ) - )) - } else { - - ## Top - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - ## Bottom - sBot$borderBottom <- borderStyle - sBot$borderBottomColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol + i - 1L - ) - )) - - ## Middle - if (specialFormat) { - styleObjects <<- append(styleObjects, list( - list( - "style" = sMid, - "sheet" = sheet, - "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last - "cols" = rep.int(startCol + i - 1L, nRow - 2L) - ) - )) - } - - styleObjects <<- append(styleObjects, list( - list( - "style" = sBot, - "sheet" = sheet, - "rows" = startRow + nRow - 1L, - "cols" = startCol + i - 1L - ) - )) - } - } ## End of if(i == 1), i == NCol, else inside columns - } ## End of loop through columns - - - invisible(0) -}) - -Workbook$methods(rowBorders = function( - colClasses, - sheet, - startRow, - startCol, - nRow, - nCol, - borderColour, - borderStyle, - borderType -) { - sheet <- sheet_names[[validateSheet(sheet)]] - ## steps - # get column class - # get corresponding base style - - for (i in 1:nCol) { - tmp <- genBaseColStyle(colClasses[[i]]) - sTop <- tmp$style - - ## First column - if (i == 1) { - if (nCol == 1) { - - ## All borders (rows and surrounding) - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - } else { - - ## Top, Left, Bottom - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - } - } else if (i == nCol) { - - ## Top, Right, Bottom - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - } else { ## inside columns - - ## Top, Middle, Bottom - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - } ## End of if(i == 1), i == NCol, else inside columns - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = (startRow):(startRow + nRow - 1L), - "cols" = rep(startCol + i - 1L, nRow) - ) - )) - } ## End of loop through columns - - - invisible(0) -}) - - -Workbook$methods(columnBorders = function( - colClasses, - sheet, - startRow, - startCol, - nRow, - nCol, - borderColour, - borderStyle, - borderType -) { - sheet <- sheet_names[[validateSheet(sheet)]] - ## steps - # get column class - # get corresponding base style - - for (i in 1:nCol) { - tmp <- genBaseColStyle(colClasses[[i]]) - colStyle <- tmp$style - specialFormat <- tmp$specialFormat - - ## create style objects - sTop <- colStyle$copy() - sMid <- colStyle$copy() - sBot <- colStyle$copy() - - if (nRow == 1) { - - ## Top - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = startCol + i - 1L - ) - )) - } else { - - ## Top - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - - ## Middle - sMid$borderLeft <- borderStyle - sMid$borderLeftColour <- borderColour - - sMid$borderRight <- borderStyle - sMid$borderRightColour <- borderColour - - ## Bottom - sBot$borderBottom <- borderStyle - sBot$borderBottomColour <- borderColour - - sBot$borderLeft <- borderStyle - sBot$borderLeftColour <- borderColour - - sBot$borderRight <- borderStyle - sBot$borderRightColour <- borderColour - - colInd <- startCol + i - 1L - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = startRow, - "cols" = colInd - ) - )) - - if (nRow > 2) { - styleObjects <<- append(styleObjects, list( - list( - "style" = sMid, - "sheet" = sheet, - "rows" = (startRow + 1L):(startRow + nRow - 2L), - "cols" = rep(colInd, nRow - 2L) - ) - )) - } - - styleObjects <<- append(styleObjects, list( - list( - "style" = sBot, - "sheet" = sheet, - "rows" = startRow + nRow - 1L, - "cols" = colInd - ) - )) - } - } ## End of loop through columns - - - invisible(0) -}) - - -Workbook$methods(allBorders = function( - colClasses, - sheet, - startRow, - startCol, - nRow, - nCol, - borderColour, - borderStyle, - borderType -) { - sheet <- sheet_names[[validateSheet(sheet)]] - ## steps - # get column class - # get corresponding base style - - for (i in 1:nCol) { - tmp <- genBaseColStyle(colClasses[[i]]) - sTop <- tmp$style - - ## All borders - sTop$borderTop <- borderStyle - sTop$borderTopColour <- borderColour - - sTop$borderBottom <- borderStyle - sTop$borderBottomColour <- borderColour - - sTop$borderLeft <- borderStyle - sTop$borderLeftColour <- borderColour - - sTop$borderRight <- borderStyle - sTop$borderRightColour <- borderColour - - styleObjects <<- append(styleObjects, list( - list( - "style" = sTop, - "sheet" = sheet, - "rows" = (startRow):(startRow + nRow - 1L), - "cols" = rep(startCol + i - 1L, nRow) - ) - )) - } ## End of loop through columns - - - invisible(0) -}) + +genBaseColStyle <- function(cc) { + colStyle <- createStyle() + specialFormat <- TRUE + + if ("date" %in% cc) { + colStyle <- createStyle(numFmt = "date") + } else if (any(c("posixlt", "posixct", "posixt") %in% cc)) { + colStyle <- createStyle(numFmt = "longdate") + } else if ("currency" %in% cc) { + colStyle$numFmt <- list(numFmtId = "164", "formatCode" = ""$"#,##0.00") + } else if ("accounting" %in% cc) { + colStyle$numFmt <- list(numFmtId = "44") + } else if ("hyperlink" %in% cc) { + colStyle$fontColour <- list(theme = "10") + } else if ("percentage" %in% cc) { + colStyle$numFmt <- list(numFmtId = "10") + } else if ("scientific" %in% cc) { + colStyle$numFmt <- list(numFmtId = "11") + } else if (any(c("3", "comma") %in% cc)) { + colStyle$numFmt <- list(numFmtId = "3") + } else if ("numeric" %in% cc & !grepl("[^0\\.,#\\$\\* %]", openxlsx_getOp("numFmt"))) { + colStyle$numFmt <- list(numFmtId = 9999, formatCode = openxlsx_getOp("numFmt")) + } else { + colStyle$numFmt <- list(numFmtId = "0") + specialFormat <- FALSE + } + + list( + style = colStyle, + specialFormat = specialFormat + ) +} + + + +Workbook$methods(surroundingBorders = function( + colClasses, + sheet, + startRow, + startCol, + nRow, + nCol, + borderColour, + borderStyle, + borderType +) { + sheet <- sheet_names[[validateSheet(sheet)]] + ## steps + # get column class + # get corresponding base style + + for (i in 1:nCol) { + tmp <- genBaseColStyle(colClasses[[i]]) + + colStyle <- tmp$style + specialFormat <- tmp$specialFormat + + ## create style objects + sTop <- colStyle$copy() + sMid <- colStyle$copy() + sBot <- colStyle$copy() + + ## First column + if (i == 1) { + if (nRow == 1 & nCol == 1) { + + ## All + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + ) + )) + } else if (nCol == 1) { + + ## Top + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + + ## Middle + sMid$borderLeft <- borderStyle + sMid$borderLeftColour <- borderColour + + sMid$borderRight <- borderStyle + sMid$borderRightColour <- borderColour + + ## Bottom + sBot$borderBottom <- borderStyle + sBot$borderBottomColour <- borderColour + + sBot$borderLeft <- borderStyle + sBot$borderLeftColour <- borderColour + + sBot$borderRight <- borderStyle + sBot$borderRightColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + ) + )) + + styleObjects <<- append(styleObjects, list( + list( + "style" = sMid, + "sheet" = sheet, + "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last + "cols" = rep.int(startCol, nRow - 2L) + ) + )) + + styleObjects <<- append(styleObjects, list( + list( + "style" = sBot, + "sheet" = sheet, + "rows" = startRow + nRow - 1L, + "cols" = startCol + ) + )) + } else if (nRow == 1) { + + ## All + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + ) + )) + } else { + + ## Top + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + ## Middle + sMid$borderLeft <- borderStyle + sMid$borderLeftColour <- borderColour + + ## Bottom + sBot$borderLeft <- borderStyle + sBot$borderLeftColour <- borderColour + + sBot$borderBottom <- borderStyle + sBot$borderBottomColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + ) + )) + + if (nRow > 2) { + styleObjects <<- append(styleObjects, list( + list( + "style" = sMid, + "sheet" = sheet, + "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last + "cols" = rep.int(startCol, nRow - 2L) + ) + )) + } + + styleObjects <<- append(styleObjects, list( + list( + "style" = sBot, + "sheet" = sheet, + "rows" = startRow + nRow - 1L, + "cols" = startCol + ) + )) + } + } else if (i == nCol) { + if (nRow == 1) { + + ## All + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + nCol - 1L + ) + )) + } else { + + ## Top + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + ## Middle + sMid$borderRight <- borderStyle + sMid$borderRightColour <- borderColour + + ## Bottom + sBot$borderRight <- borderStyle + sBot$borderRightColour <- borderColour + + sBot$borderBottom <- borderStyle + sBot$borderBottomColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + nCol - 1L + ) + )) + + if (nRow > 2) { + styleObjects <<- append(styleObjects, list( + list( + "style" = sMid, + "sheet" = sheet, + "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last + "cols" = rep.int(startCol + nCol - 1L, nRow - 2L) + ) + )) + } + + + styleObjects <<- append(styleObjects, list( + list( + "style" = sBot, + "sheet" = sheet, + "rows" = startRow + nRow - 1L, + "cols" = startCol + nCol - 1L + ) + )) + } + } else { ## inside columns + + if (nRow == 1) { + + ## Top + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + ## Bottom + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + i - 1L + ) + )) + } else { + + ## Top + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + ## Bottom + sBot$borderBottom <- borderStyle + sBot$borderBottomColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + i - 1L + ) + )) + + ## Middle + if (specialFormat) { + styleObjects <<- append(styleObjects, list( + list( + "style" = sMid, + "sheet" = sheet, + "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last + "cols" = rep.int(startCol + i - 1L, nRow - 2L) + ) + )) + } + + styleObjects <<- append(styleObjects, list( + list( + "style" = sBot, + "sheet" = sheet, + "rows" = startRow + nRow - 1L, + "cols" = startCol + i - 1L + ) + )) + } + } ## End of if(i == 1), i == NCol, else inside columns + } ## End of loop through columns + + + invisible(0) +}) + +Workbook$methods(rowBorders = function( + colClasses, + sheet, + startRow, + startCol, + nRow, + nCol, + borderColour, + borderStyle, + borderType +) { + sheet <- sheet_names[[validateSheet(sheet)]] + ## steps + # get column class + # get corresponding base style + + for (i in 1:nCol) { + tmp <- genBaseColStyle(colClasses[[i]]) + sTop <- tmp$style + + ## First column + if (i == 1) { + if (nCol == 1) { + + ## All borders (rows and surrounding) + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + } else { + + ## Top, Left, Bottom + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + } + } else if (i == nCol) { + + ## Top, Right, Bottom + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + } else { ## inside columns + + ## Top, Middle, Bottom + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + } ## End of if(i == 1), i == NCol, else inside columns + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = (startRow):(startRow + nRow - 1L), + "cols" = rep(startCol + i - 1L, nRow) + ) + )) + } ## End of loop through columns + + + invisible(0) +}) + + +Workbook$methods(columnBorders = function( + colClasses, + sheet, + startRow, + startCol, + nRow, + nCol, + borderColour, + borderStyle, + borderType +) { + sheet <- sheet_names[[validateSheet(sheet)]] + ## steps + # get column class + # get corresponding base style + + for (i in 1:nCol) { + tmp <- genBaseColStyle(colClasses[[i]]) + colStyle <- tmp$style + specialFormat <- tmp$specialFormat + + ## create style objects + sTop <- colStyle$copy() + sMid <- colStyle$copy() + sBot <- colStyle$copy() + + if (nRow == 1) { + + ## Top + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = startCol + i - 1L + ) + )) + } else { + + ## Top + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + + ## Middle + sMid$borderLeft <- borderStyle + sMid$borderLeftColour <- borderColour + + sMid$borderRight <- borderStyle + sMid$borderRightColour <- borderColour + + ## Bottom + sBot$borderBottom <- borderStyle + sBot$borderBottomColour <- borderColour + + sBot$borderLeft <- borderStyle + sBot$borderLeftColour <- borderColour + + sBot$borderRight <- borderStyle + sBot$borderRightColour <- borderColour + + colInd <- startCol + i - 1L + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = startRow, + "cols" = colInd + ) + )) + + if (nRow > 2) { + styleObjects <<- append(styleObjects, list( + list( + "style" = sMid, + "sheet" = sheet, + "rows" = (startRow + 1L):(startRow + nRow - 2L), + "cols" = rep(colInd, nRow - 2L) + ) + )) + } + + styleObjects <<- append(styleObjects, list( + list( + "style" = sBot, + "sheet" = sheet, + "rows" = startRow + nRow - 1L, + "cols" = colInd + ) + )) + } + } ## End of loop through columns + + + invisible(0) +}) + + +Workbook$methods(allBorders = function( + colClasses, + sheet, + startRow, + startCol, + nRow, + nCol, + borderColour, + borderStyle, + borderType +) { + sheet <- sheet_names[[validateSheet(sheet)]] + ## steps + # get column class + # get corresponding base style + + for (i in 1:nCol) { + tmp <- genBaseColStyle(colClasses[[i]]) + sTop <- tmp$style + + ## All borders + sTop$borderTop <- borderStyle + sTop$borderTopColour <- borderColour + + sTop$borderBottom <- borderStyle + sTop$borderBottomColour <- borderColour + + sTop$borderLeft <- borderStyle + sTop$borderLeftColour <- borderColour + + sTop$borderRight <- borderStyle + sTop$borderRightColour <- borderColour + + styleObjects <<- append(styleObjects, list( + list( + "style" = sTop, + "sheet" = sheet, + "rows" = (startRow):(startRow + nRow - 1L), + "cols" = rep(startCol + i - 1L, nRow) + ) + )) + } ## End of loop through columns + + + invisible(0) +}) diff -Nru r-cran-openxlsx-4.2.4/R/build_workbook.R r-cran-openxlsx-4.2.5/R/build_workbook.R --- r-cran-openxlsx-4.2.4/R/build_workbook.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/build_workbook.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,101 +1,153 @@ -#' Build Workbook -#' -#' Build a workbook from a data.frame or named list -#' -#' @details -#' This function can be used as shortcut to create a workbook object from a -#' data.frame or named list. If names are available in the list they will be -#' used as the worksheet names. The parameters in \code{...} are collected -#' and passed to \code{\link{writeData}} or \code{\link{writeDataTable}} to -#' initially create the Workbook objects then appropriate parameters are -#' passed to \code{\link{setColWidths}}. -#' -#' @param x A data.frame or a (named) list of objects that can be handled by -#' \code{\link{writeData}} or \code{\link{writeDataTable}} to write to file -#' @param asTable If \code{TRUE} will use \code{\link{writeDataTable}} rather -#' than \code{\link{writeData}} to write \code{x} to the file (default: -#' \code{FALSE}) -#' @param ... Additional arguments passed to \code{\link{writeData}}, -#' \code{\link{writeDataTable}}, \code{\link{setColWidths}} -#' @author Jordan Mark Barbone -#' @returns A Workbook object -#' -#' @examples -#' x <- data.frame(a = 1, b = 2) -#' wb <- buildWorkbook(x) -#' -#' y <- list(a = x, b = x, c = x) -#' buildWorkbook(y, asTable = TRUE) -#' buildWorkbook(y, asTable = TRUE, tableStyle = "TableStyleLight8") -#' -#' @seealso \code{\link{write.xlsx}} -#' -#' @export - -buildWorkbook <- function(x, asTable = FALSE, ...) { - if (!is.logical(asTable)) { - stop("asTable must be a logical.") - } - - params <- list(...) - isList <- inherits(x, "list") - - if (isList) { - params$sheetName <- params$sheetName %||% names(x) %||% paste0("Sheet ", seq_along(x)) - } - - ## create new Workbook object - wb <- do_call_params(createWorkbook, params) - - ## If a list is supplied write to individual worksheets using names if available - if (isList) { - do_call_params(addWorksheet, params, wb = list(wb), .map = TRUE) - } else { - params$sheetName <- params$sheetName %||% "Sheet 1" - do_call_params(addWorksheet, params, wb = wb) - } - - params$sheet <- params$sheet %||% params$sheetName - - # write Data - if (asTable) { - do_call_params(writeDataTable, params, x = x, wb = list(wb), .map = TRUE) - } else { - do_call_params(writeData, params, x = x, wb = wb, .map = TRUE) - } - - do_setColWidths(wb, x, params, isList) - do_call_params(freezePane, params, wb = list(wb), .map = TRUE) - wb -} - - -do_setColWidths <- function(wb, x, params, isList) { - if (!isList) { - x <- list(x) - } - - params$startCol <- params$startCol %||% 1 - params$startCol <- rep_len(list(params$startCol), length.out = length(x)) - params$colWidths <- params$colWidths %||% "" - params$colWidths <- rep_len(as.list(params$colWidths), length.out = length(x)) - - for (i in seq_along(wb$worksheets)) { - if (identical(params$colWidths[[i]], "auto")) { - setColWidths( - wb, - sheet = i, - cols = seq_along(x[[i]]) + params$startCol[[i]] - 1L, - widths = "auto" - ) - } else if (!identical(params$colWidths[[i]], "")) { - setColWidths( - wb, - sheet = i, - cols = seq_along(x[[i]]) + params$startCol[[i]] - 1L, - widths = params$colWidths[[i]] - ) - } - } - wb -} +#' Build Workbook +#' +#' Build a workbook from a data.frame or named list +#' +#' @details +#' This function can be used as shortcut to create a workbook object from a +#' data.frame or named list. If names are available in the list they will be +#' used as the worksheet names. The parameters in `...` are collected +#' and passed to [writeData()] or [writeDataTable()] to +#' initially create the Workbook objects then appropriate parameters are +#' passed to [setColWidths()]. +#' +#' @param x A data.frame or a (named) list of objects that can be handled by +#' [writeData()] or [writeDataTable()] to write to file +#' @param asTable If `TRUE` will use [writeDataTable()] rather +#' than [writeData()] to write `x` to the file (default: +#' `FALSE`) +#' @param ... Additional arguments passed to [writeData()], +#' [writeDataTable()], [setColWidths()] (see Optional +#' Parameters) +#' @author Jordan Mark Barbone +#' @returns A Workbook object +#' +#' @details +#' columns of x with class Date or POSIXt are automatically +#' styled as dates and datetimes respectively. +#' +#' @section Optional Parameters: +#' +#' **createWorkbook Parameters** +#' \itemize{ +#' \item{**creator**}{ A string specifying the workbook author} +#' } +#' +#' **addWorksheet Parameters** +#' \itemize{ +#' \item{**sheetName**}{ Name of the worksheet} +#' \item{**gridLines**}{ A logical. If `FALSE`, the worksheet grid lines will be hidden.} +#' \item{**tabColour**}{ Colour of the worksheet tab. A valid colour (belonging to colours()) +#' or a valid hex colour beginning with "#".} +#' \item{**zoom**}{ A numeric between 10 and 400. Worksheet zoom level as a percentage.} +#' } +#' +#' **writeData/writeDataTable Parameters** +#' \itemize{ +#' \item{**startCol**}{ A vector specifying the starting column(s) to write df} +#' \item{**startRow**}{ A vector specifying the starting row(s) to write df} +#' \item{**xy**}{ An alternative to specifying startCol and startRow individually. +#' A vector of the form c(startCol, startRow)} +#' \item{**colNames or col.names**}{ If `TRUE`, column names of x are written.} +#' \item{**rowNames or row.names**}{ If `TRUE`, row names of x are written.} +#' \item{**headerStyle**}{ Custom style to apply to column names.} +#' \item{**borders**}{ Either "surrounding", "columns" or "rows" or NULL. If "surrounding", a border is drawn around the +#' data. If "rows", a surrounding border is drawn a border around each row. If "columns", a surrounding border is drawn with a border +#' between each column. If "`all`" all cell borders are drawn.} +#' \item{**borderColour**}{ Colour of cell border} +#' \item{**borderStyle**}{ Border line style.} +#' \item{**keepNA**} {If `TRUE`, NA values are converted to #N/A (or `na.string`, if not NULL) in Excel, else NA cells will be empty. Defaults to FALSE.} +#' \item{**na.string**} {If not NULL, and if `keepNA` is `TRUE`, NA values are converted to this string in Excel. Defaults to NULL.} +#' } +#' +#' **freezePane Parameters** +#' \itemize{ +#' \item{**firstActiveRow**} {Top row of active region to freeze pane.} +#' \item{**firstActiveCol**} {Furthest left column of active region to freeze pane.} +#' \item{**firstRow**} {If `TRUE`, freezes the first row (equivalent to firstActiveRow = 2)} +#' \item{**firstCol**} {If `TRUE`, freezes the first column (equivalent to firstActiveCol = 2)} +#' } +#' +#' **colWidths Parameters** +#' \itemize{ +#' \item{**colWidths**} {May be a single value for all columns (or "auto"), or a list of vectors that will be recycled for each sheet (see examples)} +#' } +#' +#' @examples +#' x <- data.frame(a = 1, b = 2) +#' wb <- buildWorkbook(x) +#' +#' y <- list(a = x, b = x, c = x) +#' buildWorkbook(y, asTable = TRUE) +#' buildWorkbook(y, asTable = TRUE, tableStyle = "TableStyleLight8") +#' +#' @seealso [write.xlsx()] +#' +#' @export + +buildWorkbook <- function(x, asTable = FALSE, ...) { + if (!is.logical(asTable)) { + stop("asTable must be a logical.") + } + + params <- list(...) + isList <- inherits(x, "list") + + if (isList) { + params[["sheetName"]] <- params[["sheetName"]] %||% names(x) %||% paste0("Sheet ", seq_along(x)) + } + + ## create new Workbook object + wb <- do_call_params(createWorkbook, params) + + ## If a list is supplied write to individual worksheets using names if available + if (isList) { + do_call_params(addWorksheet, params, wb = list(wb), .map = TRUE) + } else { + params[["sheetName"]] <- params[["sheetName"]] %||% "Sheet 1" + do_call_params(addWorksheet, params, wb = wb) + } + + params[["sheet"]] <- params[["sheet"]] %||% params[["sheetName"]] + + # write Data + if (asTable) { + do_call_params(writeDataTable, params, x = x, wb = list(wb), .map = TRUE) + } else { + do_call_params(writeData, params, x = x, wb = wb, .map = TRUE) + } + + do_setColWidths(wb, x, params, isList) + do_call_params(freezePane, params, wb = list(wb), .map = TRUE) + wb +} + + +do_setColWidths <- function(wb, x, params, isList) { + if (!isList) { + x <- list(x) + } + + params[["startCol"]] <- params[["startCol"]] %||% 1 + params[["startCol"]] <- rep_len(list(params[["startCol"]]), length.out = length(x)) + params[["colWidths"]] <- params[["colWidths"]] %||% "" + params[["colWidths"]] <- rep_len(as.list(params[["colWidths"]]), length.out = length(x)) + + for (i in seq_along(wb[["worksheets"]])) { + if (identical(params[["colWidths"]][[i]], "auto")) { + setColWidths( + wb, + sheet = i, + cols = seq_along(x[[i]]) + params[["startCol"]][[i]] - 1L, + widths = "auto" + ) + } else if (!identical(params[["colWidths"]][[i]], "")) { + setColWidths( + wb, + sheet = i, + cols = seq_along(x[[i]]) + params[["startCol"]][[i]] - 1L, + widths = params[["colWidths"]][[i]] + ) + } + } + wb +} diff -Nru r-cran-openxlsx-4.2.4/R/chartsheet_class.R r-cran-openxlsx-4.2.5/R/chartsheet_class.R --- r-cran-openxlsx-4.2.4/R/chartsheet_class.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/chartsheet_class.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,55 +1,55 @@ - - -#' @include class_definitions.R - - -ChartSheet$methods(initialize = function(tabSelected = FALSE, - tabColour = character(0), - zoom = 100) { - if (length(tabColour) > 0) { - tabColour <- sprintf("%s", tabColour) - } else { - tabColour <- character(0) - } - if (zoom < 10) { - zoom <- 10 - } else if (zoom > 400) { - zoom <- 400 - } - - sheetPr <<- tabColour - sheetViews <<- sprintf('', as.integer(zoom), as.integer(tabSelected)) - pageMargins <<- '' - drawing <<- '' - hyperlinks <<- character(0) - - return(invisible(0)) -}) - - - - - -ChartSheet$methods(get_prior_sheet_data = function() { - xml <- '>' - - if (length(sheetPr) > 0) { - xml <- paste(xml, sheetPr, collapse = "") - } - - if (length(sheetViews) > 0) { - xml <- paste(xml, sheetViews, collapse = "") - } - - if (length(pageMargins) > 0) { - xml <- paste(xml, pageMargins, collapse = "") - } - - if (length(drawing) > 0) { - xml <- paste(xml, drawing, collapse = "") - } - - xml <- paste(xml, "") - - return(xml) -}) + + +#' @include class_definitions.R + + +ChartSheet$methods(initialize = function(tabSelected = FALSE, + tabColour = character(0), + zoom = 100) { + if (length(tabColour) > 0) { + tabColour <- sprintf("%s", tabColour) + } else { + tabColour <- character(0) + } + if (zoom < 10) { + zoom <- 10 + } else if (zoom > 400) { + zoom <- 400 + } + + sheetPr <<- tabColour + sheetViews <<- sprintf('', as.integer(zoom), as.integer(tabSelected)) + pageMargins <<- '' + drawing <<- '' + hyperlinks <<- character(0) + + return(invisible(0)) +}) + + + + + +ChartSheet$methods(get_prior_sheet_data = function() { + xml <- '>' + + if (length(sheetPr) > 0) { + xml <- paste(xml, sheetPr, collapse = "") + } + + if (length(sheetViews) > 0) { + xml <- paste(xml, sheetViews, collapse = "") + } + + if (length(pageMargins) > 0) { + xml <- paste(xml, pageMargins, collapse = "") + } + + if (length(drawing) > 0) { + xml <- paste(xml, drawing, collapse = "") + } + + xml <- paste(xml, "") + + return(xml) +}) diff -Nru r-cran-openxlsx-4.2.4/R/class_definitions.R r-cran-openxlsx-4.2.5/R/class_definitions.R --- r-cran-openxlsx-4.2.4/R/class_definitions.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/class_definitions.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,161 +1,161 @@ - -# Workbook ---------------------------------------------------------------- - -Workbook <- setRefClass("Workbook", - fields = c( - "sheet_names" = "character", - - "charts" = "ANY", - "isChartSheet" = "logical", - - "colOutlineLevels" = "ANY", - "colWidths" = "ANY", - "connections" = "ANY", - "Content_Types" = "character", - "core" = "character", - "drawings" = "ANY", - "drawings_rels" = "ANY", - "embeddings" = "ANY", - "externalLinks" = "ANY", - "externalLinksRels" = "ANY", - - "headFoot" = "ANY", - "media" = "ANY", - "outlineLevels" = "ANY", - - "persons" = "ANY", - - "pivotTables" = "ANY", - "pivotTables.xml.rels" = "ANY", - "pivotDefinitions" = "ANY", - "pivotRecords" = "ANY", - "pivotDefinitionsRels" = "ANY", - - "queryTables" = "ANY", - "rowHeights" = "ANY", - - "slicers" = "ANY", - "slicerCaches" = "ANY", - - "sharedStrings" = "ANY", - "styleObjects" = "ANY", - - "styles" = "ANY", - "tables" = "ANY", - "tables.xml.rels" = "ANY", - "theme" = "ANY", - - "vbaProject" = "ANY", - "vml" = "ANY", - "vml_rels" = "ANY", - "comments" = "ANY", - "threadComments" = "ANY", - - "workbook" = "ANY", - "workbook.xml.rels" = "ANY", - "worksheets" = "ANY", - "worksheets_rels" = "ANY", - "sheetOrder" = "integer", - "ActiveSheet" = "integer" - ) -) - -# Style ------------------------------------------------------------------- - -Style <- setRefClass("Style", - fields = c( - "fontName", - "fontColour", - "fontSize", - "fontFamily", - "fontScheme", - "fontDecoration", - "borderTop", - "borderLeft", - "borderRight", - "borderBottom", - "borderTopColour", - "borderLeftColour", - "borderRightColour", - "borderBottomColour", - "borderDiagonal", - "borderDiagonalColour", - "borderDiagonalUp", - "borderDiagonalDown", - "halign", - "valign", - "indent", - "textRotation", - "numFmt", - "fill", - "wrapText", - "locked", - "hidden", - "xfId" - ), - methods = list() -) - -# Sheet_Data -------------------------------------------------------------- - -Sheet_Data <- setRefClass("Sheet_Data", - fields = c( - "rows" = "integer", - "cols" = "integer", - "t" = "integer", - "v" = "character", - "f" = "character", - "style_id" = "ANY", - "data_count" = "integer", - "n_elements" = "integer" - ) -) - - -# Worksheet --------------------------------------------------------------- - -WorkSheet <- setRefClass("WorkSheet", - fields = c( - "sheetPr" = "character", - "dimension" = "character", - "sheetViews" = "character", - "sheetFormatPr" = "character", - "cols" = "character", - - "sheet_data" = "Sheet_Data", - - "autoFilter" = "character", - "mergeCells" = "ANY", - "conditionalFormatting" = "character", - "dataValidations" = "ANY", - "dataValidationsLst" = "character", - - "freezePane" = "character", - "hyperlinks" = "ANY", - - "sheetProtection" = "character", - "pageMargins" = "character", - "pageSetup" = "character", - "headerFooter" = "ANY", - "rowBreaks" = "character", - "colBreaks" = "character", - "drawing" = "character", - "legacyDrawing" = "character", - "legacyDrawingHF" = "character", - "oleObjects" = "character", - "tableParts" = "character", - "extLst" = "character" - ) -) - -# ChartSheet -------------------------------------------------------------- - -ChartSheet <- setRefClass("ChartSheet", - fields = c( - "sheetPr" = "character", - "sheetViews" = "character", - "pageMargins" = "character", - "drawing" = "character", - "hyperlinks" = "ANY" - ) -) + +# Workbook ---------------------------------------------------------------- + +Workbook <- setRefClass("Workbook", + fields = c( + "sheet_names" = "character", + + "charts" = "ANY", + "isChartSheet" = "logical", + + "colOutlineLevels" = "ANY", + "colWidths" = "ANY", + "connections" = "ANY", + "Content_Types" = "character", + "core" = "character", + "drawings" = "ANY", + "drawings_rels" = "ANY", + "embeddings" = "ANY", + "externalLinks" = "ANY", + "externalLinksRels" = "ANY", + + "headFoot" = "ANY", + "media" = "ANY", + "outlineLevels" = "ANY", + + "persons" = "ANY", + + "pivotTables" = "ANY", + "pivotTables.xml.rels" = "ANY", + "pivotDefinitions" = "ANY", + "pivotRecords" = "ANY", + "pivotDefinitionsRels" = "ANY", + + "queryTables" = "ANY", + "rowHeights" = "ANY", + + "slicers" = "ANY", + "slicerCaches" = "ANY", + + "sharedStrings" = "ANY", + "styleObjects" = "ANY", + + "styles" = "ANY", + "tables" = "ANY", + "tables.xml.rels" = "ANY", + "theme" = "ANY", + + "vbaProject" = "ANY", + "vml" = "ANY", + "vml_rels" = "ANY", + "comments" = "ANY", + "threadComments" = "ANY", + + "workbook" = "ANY", + "workbook.xml.rels" = "ANY", + "worksheets" = "ANY", + "worksheets_rels" = "ANY", + "sheetOrder" = "integer", + "ActiveSheet" = "integer" + ) +) + +# Style ------------------------------------------------------------------- + +Style <- setRefClass("Style", + fields = c( + "fontName", + "fontColour", + "fontSize", + "fontFamily", + "fontScheme", + "fontDecoration", + "borderTop", + "borderLeft", + "borderRight", + "borderBottom", + "borderTopColour", + "borderLeftColour", + "borderRightColour", + "borderBottomColour", + "borderDiagonal", + "borderDiagonalColour", + "borderDiagonalUp", + "borderDiagonalDown", + "halign", + "valign", + "indent", + "textRotation", + "numFmt", + "fill", + "wrapText", + "locked", + "hidden", + "xfId" + ), + methods = list() +) + +# Sheet_Data -------------------------------------------------------------- + +Sheet_Data <- setRefClass("Sheet_Data", + fields = c( + "rows" = "integer", + "cols" = "integer", + "t" = "integer", + "v" = "character", + "f" = "character", + "style_id" = "ANY", + "data_count" = "integer", + "n_elements" = "integer" + ) +) + + +# Worksheet --------------------------------------------------------------- + +WorkSheet <- setRefClass("WorkSheet", + fields = c( + "sheetPr" = "character", + "dimension" = "character", + "sheetViews" = "character", + "sheetFormatPr" = "character", + "cols" = "character", + + "sheet_data" = "Sheet_Data", + + "autoFilter" = "character", + "mergeCells" = "ANY", + "conditionalFormatting" = "character", + "dataValidations" = "ANY", + "dataValidationsLst" = "character", + + "freezePane" = "character", + "hyperlinks" = "ANY", + + "sheetProtection" = "character", + "pageMargins" = "character", + "pageSetup" = "character", + "headerFooter" = "ANY", + "rowBreaks" = "character", + "colBreaks" = "character", + "drawing" = "character", + "legacyDrawing" = "character", + "legacyDrawingHF" = "character", + "oleObjects" = "character", + "tableParts" = "character", + "extLst" = "character" + ) +) + +# ChartSheet -------------------------------------------------------------- + +ChartSheet <- setRefClass("ChartSheet", + fields = c( + "sheetPr" = "character", + "sheetViews" = "character", + "pageMargins" = "character", + "drawing" = "character", + "hyperlinks" = "ANY" + ) +) diff -Nru r-cran-openxlsx-4.2.4/R/CommentClass.R r-cran-openxlsx-4.2.5/R/CommentClass.R --- r-cran-openxlsx-4.2.4/R/CommentClass.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/CommentClass.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,261 +1,234 @@ - - - -Comment <- setRefClass("Comment", - fields = c( - "text", - "author", - "style", - "visible", - "width", - "height" - ), - - methods = list() -) - - -Comment$methods(initialize = function(text, author, style, visible = TRUE, width = 2, height = 4) { - text <<- text - author <<- author - style <<- style - visible <<- visible - width <<- width - height <<- height -}) - - -Comment$methods(show = function() { - showText <- sprintf("Author: %s\n", author) - showText <- c(showText, sprintf("Text:\n %s\n\n", paste(text, collapse = ""))) - styleShow <- "Style:\n" - - if ("list" %in% class(style)) { - for (i in seq_along(style)) { - styleShow <- append(styleShow, sprintf("Font name: %s\n", style[[i]]$fontName[[1]])) ## Font name - styleShow <- append(styleShow, sprintf("Font size: %s\n", style[[i]]$fontSize[[1]])) ## Font size - styleShow <- append(styleShow, sprintf("Font colour: %s\n", gsub("^FF", "#", style[[i]]$fontColour[[1]]))) ## Font colour - - ## Font decoration - if (length(style[[i]]$fontDecoration) > 0) { - styleShow <- append(styleShow, sprintf("Font decoration: %s\n", paste(style[[i]]$fontDecoration, collapse = ", "))) - } - - styleShow <- append(styleShow, "\n\n") - } - } else { - styleShow <- append(styleShow, sprintf("Font name: %s \n", style$fontName[[1]])) ## Font name - styleShow <- append(styleShow, sprintf("Font size: %s \n", style$fontSize[[1]])) ## Font size - styleShow <- append(styleShow, sprintf("Font colour: %s \n", gsub("^FF", "#", style$fontColour[[1]]))) ## Font colour - - ## Font decoration - if (length(style$fontDecoration) > 0) { - styleShow <- append(styleShow, sprintf("Font decoration: %s \n", paste(style$fontDecoration, collapse = ", "))) - } - - styleShow <- append(styleShow, "\n\n") - } - - showText <- paste0(paste(showText, collapse = ""), paste(styleShow, collapse = ""), collapse = "") - cat(showText) -}) - - - -#' @name createComment -#' @title create a Comment object -#' @description Create a cell Comment object to pass to writeComment() -#' @param comment Comment text. Character vector. -#' @param author Author of comment. Character vector of length 1 -#' @param style A Style object or list of style objects the same length as comment vector. See \code{\link{createStyle}}. -#' @param visible TRUE or FALSE. Is comment visible. -#' @param width Textbox integer width in number of cells -#' @param height Textbox integer height in number of cells -#' @export -#' @seealso \code{\link{writeComment}} -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' -#' c1 <- createComment(comment = "this is comment") -#' writeComment(wb, 1, col = "B", row = 10, comment = c1) -#' -#' s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) -#' s2 <- createStyle(fontSize = 9, fontColour = "black") -#' -#' c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) -#' c2 -#' -#' writeComment(wb, 1, col = 6, row = 3, comment = c2) -#' \dontrun{ -#' saveWorkbook(wb, file = "createCommentExample.xlsx", overwrite = TRUE) -#' } -createComment <- function(comment, - author = Sys.getenv("USERNAME"), - style = NULL, - visible = TRUE, - width = 2, - height = 4) { - if (!"character" %in% class(author)) { - stop("author argument must be a character vector") - } - - if (!"character" %in% class(comment)) { - stop("comment argument must be a character vector") - } - - if (!"numeric" %in% class(width)) { - stop("width argument must be a numeric vector") - } - - if (!"numeric" %in% class(height)) { - stop("height argument must be a numeric vector") - } - - if (!"logical" %in% class(visible)) { - stop("visible argument must be a logical vector") - } - - - - width <- round(width) - height <- round(height) - - # n <- length(comment) variable not used - author <- author[1] - visible <- visible[1] - - if (is.null(style)) { - style <- createStyle(fontName = "Tahoma", fontSize = 9, fontColour = "black") - } - - author <- replaceIllegalCharacters(author) - comment <- replaceIllegalCharacters(comment) - - - invisible(Comment$new(text = comment, author = author, style = style, visible = visible, width = width[1], height = height[1])) -} - - - - - -#' @name writeComment -#' @title write a cell comment -#' @description Write a Comment object to a worksheet -#' @param wb A workbook object -#' @param sheet A vector of names or indices of worksheets -#' @param col Column a column number of letter -#' @param row A row number. -#' @param comment A Comment object. See \code{\link{createComment}}. -#' @param xy An alternative to specifying \code{col} and -#' \code{row} individually. A vector of the form -#' \code{c(col, row)}. -#' @export -#' @seealso \code{\link{createComment}} -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' -#' c1 <- createComment(comment = "this is comment") -#' writeComment(wb, 1, col = "B", row = 10, comment = c1) -#' -#' s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) -#' s2 <- createStyle(fontSize = 9, fontColour = "black") -#' -#' c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) -#' c2 -#' -#' writeComment(wb, 1, col = 6, row = 3, comment = c2) -#' \dontrun{ -#' saveWorkbook(wb, file = "writeCommentExample.xlsx", overwrite = TRUE) -#' } -writeComment <- function(wb, sheet, col, row, comment, xy = NULL) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (!"Comment" %in% class(comment)) { - stop("comment argument must be a Comment object") - } - - - if (length(comment$style) == 1) { - rPr <- wb$createFontNode(comment$style) - } else { - rPr <- sapply(comment$style, function(x) wb$createFontNode(x)) - } - - rPr <- gsub("font>", "rPr>", rPr) - sheet <- wb$validateSheet(sheet) - - ## All input conversions/validations - if (!is.null(xy)) { - if (length(xy) != 2) { - stop("xy parameter must have length 2") - } - col <- xy[[1]] - row <- xy[[2]] - } - - if (!is.numeric(col)) { - col <- convertFromExcelRef(col) - } - - ref <- paste0(convert_to_excel_ref(cols = col, LETTERS = LETTERS), row) - - comment_list <- list( - "ref" = ref, - "author" = comment$author, - "comment" = comment$text, - "style" = rPr, - "clientData" = genClientData(col, row, visible = comment$visible, height = comment$height, width = comment$width) - ) - - wb$comments[[sheet]] <- append(wb$comments[[sheet]], list(comment_list)) - - invisible(wb) -} - - - - - -#' @name removeComment -#' @title Remove a comment from a cell -#' @description Remove a cell comment from a worksheet -#' @param wb A workbook object -#' @param sheet A vector of names or indices of worksheets -#' @param cols Columns to delete comments from -#' @param rows Rows to delete comments from -#' @param gridExpand If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) -#' will be removed. -#' @export -#' @seealso \code{\link{createComment}} -#' @seealso \code{\link{writeComment}} -removeComment <- function(wb, sheet, cols, rows, gridExpand = TRUE) { - sheet <- wb$validateSheet(sheet) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - cols <- convertFromExcelRef(cols) - rows <- as.integer(rows) - - ## rows and cols need to be the same length - if (gridExpand) { - combs <- expand.grid(rows, cols) - rows <- combs[, 1] - cols <- combs[, 2] - } - - if (length(rows) != length(cols)) { - stop("Length of rows and cols must be equal.") - } - - comb <- paste0(convert_to_excel_ref(cols = cols, LETTERS = LETTERS), rows) - toKeep <- !sapply(wb$comments[[sheet]], "[[", "ref") %in% comb - - wb$comments[[sheet]] <- wb$comments[[sheet]][toKeep] -} + + +Comment <- setRefClass("Comment", + fields = c( + "text", + "author", + "style", + "visible", + "width", + "height" + ), + + methods = list() +) + + +Comment$methods(initialize = function(text, author, style, visible = TRUE, width = 2, height = 4) { + text <<- text + author <<- author + style <<- style + visible <<- visible + width <<- width + height <<- height +}) + + +Comment$methods(show = function() { + showText <- sprintf("Author: %s\n", author) + showText <- c(showText, sprintf("Text:\n %s\n\n", paste(text, collapse = ""))) + styleShow <- "Style:\n" + + if ("list" %in% class(style)) { + for (i in seq_along(style)) { + styleShow <- append(styleShow, sprintf("Font name: %s\n", style[[i]]$fontName[[1]])) ## Font name + styleShow <- append(styleShow, sprintf("Font size: %s\n", style[[i]]$fontSize[[1]])) ## Font size + styleShow <- append(styleShow, sprintf("Font colour: %s\n", gsub("^FF", "#", style[[i]]$fontColour[[1]]))) ## Font colour + + ## Font decoration + if (length(style[[i]]$fontDecoration) > 0) { + styleShow <- append(styleShow, sprintf("Font decoration: %s\n", paste(style[[i]]$fontDecoration, collapse = ", "))) + } + + styleShow <- append(styleShow, "\n\n") + } + } else { + styleShow <- append(styleShow, sprintf("Font name: %s \n", style$fontName[[1]])) ## Font name + styleShow <- append(styleShow, sprintf("Font size: %s \n", style$fontSize[[1]])) ## Font size + styleShow <- append(styleShow, sprintf("Font colour: %s \n", gsub("^FF", "#", style$fontColour[[1]]))) ## Font colour + + ## Font decoration + if (length(style$fontDecoration) > 0) { + styleShow <- append(styleShow, sprintf("Font decoration: %s \n", paste(style$fontDecoration, collapse = ", "))) + } + + styleShow <- append(styleShow, "\n\n") + } + + showText <- paste0(paste(showText, collapse = ""), paste(styleShow, collapse = ""), collapse = "") + cat(showText) +}) + + + +#' @name createComment +#' @title create a Comment object +#' @description Create a cell Comment object to pass to writeComment() +#' @param comment Comment text. Character vector. +#' @param author Author of comment. Character vector of length 1 +#' @param style A Style object or list of style objects the same length as comment vector. See [createStyle()]. +#' @param visible TRUE or FALSE. Is comment visible. +#' @param width,height Width and height of textbook (in number of cells); +#' doubles are rounded with \code{base::round()} +#' @export +#' @seealso [writeComment()] +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' +#' c1 <- createComment(comment = "this is comment") +#' writeComment(wb, 1, col = "B", row = 10, comment = c1) +#' +#' s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) +#' s2 <- createStyle(fontSize = 9, fontColour = "black") +#' +#' c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) +#' c2 +#' +#' writeComment(wb, 1, col = 6, row = 3, comment = c2) +#' \dontrun{ +#' saveWorkbook(wb, file = "createCommentExample.xlsx", overwrite = TRUE) +#' } +createComment <- function(comment, + author = Sys.getenv("USERNAME"), + style = NULL, + visible = TRUE, + width = 2, + height = 4) { + + if (!is.character(comment)) { + stop("comment argument must be a character vector") + } + + assert_character1(author) + assert_numeric1(width) + assert_numeric1(height) + assert_true_false1(visible) + + width <- round(width) + height <- round(height) + + if (is.null(style)) { + style <- createStyle(fontName = "Tahoma", fontSize = 9, fontColour = "black") + } + + author <- replaceIllegalCharacters(author) + comment <- replaceIllegalCharacters(comment) + + invisible(Comment$new(text = comment, author = author, style = style, visible = visible, width = width[1], height = height[1])) +} + + +#' @name writeComment +#' @title write a cell comment +#' @description Write a Comment object to a worksheet +#' @param wb A workbook object +#' @param sheet A vector of names or indices of worksheets +#' @param col Column a column number of letter +#' @param row A row number. +#' @param comment A Comment object. See [createComment()]. +#' @param xy An alternative to specifying `col` and +#' `row` individually. A vector of the form +#' `c(col, row)`. +#' @export +#' @seealso [createComment()] +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' +#' c1 <- createComment(comment = "this is comment") +#' writeComment(wb, 1, col = "B", row = 10, comment = c1) +#' +#' s1 <- createStyle(fontSize = 12, fontColour = "red", textDecoration = c("BOLD")) +#' s2 <- createStyle(fontSize = 9, fontColour = "black") +#' +#' c2 <- createComment(comment = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2)) +#' c2 +#' +#' writeComment(wb, 1, col = 6, row = 3, comment = c2) +#' \dontrun{ +#' saveWorkbook(wb, file = "writeCommentExample.xlsx", overwrite = TRUE) +#' } +writeComment <- function(wb, sheet, col, row, comment, xy = NULL) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (!"Comment" %in% class(comment)) { + stop("comment argument must be a Comment object") + } + + + if (length(comment$style) == 1) { + rPr <- wb$createFontNode(comment$style) + } else { + rPr <- sapply(comment$style, function(x) wb$createFontNode(x)) + } + + rPr <- gsub("font>", "rPr>", rPr) + sheet <- wb$validateSheet(sheet) + + ## All input conversions/validations + if (!is.null(xy)) { + if (length(xy) != 2) { + stop("xy parameter must have length 2") + } + col <- xy[[1]] + row <- xy[[2]] + } + + if (!is.numeric(col)) { + col <- convertFromExcelRef(col) + } + + ref <- paste0(convert_to_excel_ref(cols = col, LETTERS = LETTERS), row) + + comment_list <- list( + "ref" = ref, + "author" = comment$author, + "comment" = comment$text, + "style" = rPr, + "clientData" = genClientData(col, row, visible = comment$visible, height = comment$height, width = comment$width) + ) + + wb$comments[[sheet]] <- append(wb$comments[[sheet]], list(comment_list)) + + invisible(wb) +} + + +#' @name removeComment +#' @title Remove a comment from a cell +#' @description Remove a cell comment from a worksheet +#' @param wb A workbook object +#' @param sheet A vector of names or indices of worksheets +#' @param cols Columns to delete comments from +#' @param rows Rows to delete comments from +#' @param gridExpand If `TRUE`, all data in rectangle min(rows):max(rows) X min(cols):max(cols) +#' will be removed. +#' @export +#' @seealso [createComment()] +#' @seealso [writeComment()] +removeComment <- function(wb, sheet, cols, rows, gridExpand = TRUE) { + sheet <- wb$validateSheet(sheet) + + assert_class(wb, "Workbook") + cols <- convertFromExcelRef(cols) + rows <- as.integer(rows) + + ## rows and cols need to be the same length + if (gridExpand) { + combs <- expand.grid(rows, cols) + rows <- combs[, 1] + cols <- combs[, 2] + } + + if (length(rows) != length(cols)) { + stop("Length of rows and cols must be equal.") + } + + comb <- paste0(convert_to_excel_ref(cols = cols, LETTERS = LETTERS), rows) + toKeep <- !sapply(wb$comments[[sheet]], "[[", "ref") %in% comb + + wb$comments[[sheet]] <- wb$comments[[sheet]][toKeep] +} diff -Nru r-cran-openxlsx-4.2.4/R/conditional_formatting.R r-cran-openxlsx-4.2.5/R/conditional_formatting.R --- r-cran-openxlsx-4.2.4/R/conditional_formatting.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/conditional_formatting.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,653 +1,652 @@ - - - - - -#' @name conditionalFormatting -#' @aliases databar -#' @title Add conditional formatting to cells -#' @description Add conditional formatting to cells -#' @author Alexander Walker, Philipp Schauberger -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols Columns to apply conditional formatting to -#' @param rows Rows to apply conditional formatting to -#' @param rule The condition under which to apply the formatting. See examples. -#' @param style A style to apply to those cells that satisfy the rule. Default is createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -#' @param type Either 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', -#' 'endsWith', 'topN', 'bottomN', 'contains' or 'notContains' (case insensitive). -#' @param ... See below -#' @details See Examples. -#' -#' If type == "expression" -#' \itemize{ -#' \item{style is a Style object. See \code{\link{createStyle}}} -#' \item{rule is an expression. Valid operators are "<", "<=", ">", ">=", "==", "!=".} -#' } -#' -#' If type == "colourScale" -#' \itemize{ -#' \item{style is a vector of colours with length 2 or 3} -#' \item{rule can be NULL or a vector of colours of equal length to styles} -#' } -#' -#' If type == "databar" -#' \itemize{ -#' \item{style is a vector of colours with length 2 or 3} -#' \item{rule is a numeric vector specifying the range of the databar colours. Must be equal length to style} -#' \item{... -#' \itemize{ -#' \item{\bold{showvalue} If FALSE the cell value is hidden. Default TRUE.} -#' \item{\bold{gradient} If FALSE colour gradient is removed. Default TRUE.} -#' \item{\bold{border} If FALSE the border around the database is hidden. Default TRUE.} -#' } -#' } -#' } -#' -#' If type == "duplicates" -#' \itemize{ -#' \item{style is a Style object. See \code{\link{createStyle}}} -#' \item{rule is ignored.} -#' } -#' -#' If type == "contains" -#' \itemize{ -#' \item{style is a Style object. See \code{\link{createStyle}}} -#' \item{rule is the text to look for within cells} -#' } -#' -#' If type == "between" -#' \itemize{ -#' \item{style is a Style object. See \code{\link{createStyle}}} -#' \item{rule is a numeric vector of length 2 specifying lower and upper bound (Inclusive)} -#' } -#' -#' If type == "topN" -#' \itemize{ -#' \item{style is a Style object. See \code{\link{createStyle}}} -#' \item{rule is ignored} -#' \item{... -#' \itemize{ -#' \item{\bold{rank} numeric vector of length 1 indicating number of highest values.} -#' \item{\bold{percent} TRUE if you want top N percentage.} -#' } -#' } -#' } -#' -#' If type == "bottomN" -#' \itemize{ -#' \item{style is a Style object. See \code{\link{createStyle}}} -#' \item{rule is ignored} -#' \item{... -#' \itemize{ -#' \item{\bold{rank} numeric vector of length 1 indicating number of lowest values.} -#' \item{\bold{percent} TRUE if you want bottom N percentage.} -#' } -#' } -#' } -#' -#' @seealso \code{\link{createStyle}} -#' @export -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "cellIs") -#' addWorksheet(wb, "Moving Row") -#' addWorksheet(wb, "Moving Col") -#' addWorksheet(wb, "Dependent on") -#' addWorksheet(wb, "Duplicates") -#' addWorksheet(wb, "containsText") -#' addWorksheet(wb, "notcontainsText") -#' addWorksheet(wb, "beginsWith") -#' addWorksheet(wb, "endsWith") -#' addWorksheet(wb, "colourScale", zoom = 30) -#' addWorksheet(wb, "databar") -#' addWorksheet(wb, "between") -#' addWorksheet(wb, "topN") -#' addWorksheet(wb, "bottomN") -#' addWorksheet(wb, "logical operators") -#' -#' negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -#' posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") -#' -#' ## rule applies to all each cell in range -#' writeData(wb, "cellIs", -5:5) -#' writeData(wb, "cellIs", LETTERS[1:11], startCol = 2) -#' conditionalFormatting(wb, "cellIs", -#' cols = 1, -#' rows = 1:11, rule = "!=0", style = negStyle -#' ) -#' conditionalFormatting(wb, "cellIs", -#' cols = 1, -#' rows = 1:11, rule = "==0", style = posStyle -#' ) -#' -#' ## highlight row dependent on first cell in row -#' writeData(wb, "Moving Row", -5:5) -#' writeData(wb, "Moving Row", LETTERS[1:11], startCol = 2) -#' conditionalFormatting(wb, "Moving Row", -#' cols = 1:2, -#' rows = 1:11, rule = "$A1<0", style = negStyle -#' ) -#' conditionalFormatting(wb, "Moving Row", -#' cols = 1:2, -#' rows = 1:11, rule = "$A1>0", style = posStyle -#' ) -#' -#' ## highlight column dependent on first cell in column -#' writeData(wb, "Moving Col", -5:5) -#' writeData(wb, "Moving Col", LETTERS[1:11], startCol = 2) -#' conditionalFormatting(wb, "Moving Col", -#' cols = 1:2, -#' rows = 1:11, rule = "A$1<0", style = negStyle -#' ) -#' conditionalFormatting(wb, "Moving Col", -#' cols = 1:2, -#' rows = 1:11, rule = "A$1>0", style = posStyle -#' ) -#' -#' ## highlight entire range cols X rows dependent only on cell A1 -#' writeData(wb, "Dependent on", -5:5) -#' writeData(wb, "Dependent on", LETTERS[1:11], startCol = 2) -#' conditionalFormatting(wb, "Dependent on", -#' cols = 1:2, -#' rows = 1:11, rule = "$A$1<0", style = negStyle -#' ) -#' conditionalFormatting(wb, "Dependent on", -#' cols = 1:2, -#' rows = 1:11, rule = "$A$1>0", style = posStyle -#' ) -#' -#' ## highlight cells in column 1 based on value in column 2 -#' writeData(wb, "Dependent on", data.frame(x = 1:10, y = runif(10)), startRow = 15) -#' conditionalFormatting(wb, "Dependent on", -#' cols = 1, -#' rows = 16:25, rule = "B16<0.5", style = negStyle -#' ) -#' conditionalFormatting(wb, "Dependent on", -#' cols = 1, -#' rows = 16:25, rule = "B16>=0.5", style = posStyle -#' ) -#' -#' -#' ## highlight duplicates using default style -#' writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) -#' conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") -#' -#' ## cells containing text -#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -#' writeData(wb, "containsText", sapply(1:10, fn)) -#' conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") -#' -#' ## cells not containing text -#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -#' writeData(wb, "containsText", sapply(1:10, fn)) -#' conditionalFormatting(wb, "notcontainsText", cols = 1, -#' rows = 1:10, type = "notcontains", rule = "A") -#' -#' -#' ## cells begins with text -#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -#' writeData(wb, "beginsWith", sapply(1:100, fn)) -#' conditionalFormatting(wb, "beginsWith", cols = 1, rows = 1:100, type = "beginsWith", rule = "A") -#' -#' -#' ## cells ends with text -#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -#' writeData(wb, "endsWith", sapply(1:100, fn)) -#' conditionalFormatting(wb, "endsWith", cols = 1, rows = 1:100, type = "endsWith", rule = "A") -#' -#' ## colourscale colours cells based on cell value -#' df <- read.xlsx(system.file("extdata", "readTest.xlsx", package = "openxlsx"), sheet = 4) -#' writeData(wb, "colourScale", df, colNames = FALSE) ## write data.frame -#' -#' ## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) -#' ## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. -#' conditionalFormatting(wb, "colourScale", -#' cols = 1:ncol(df), rows = 1:nrow(df), -#' style = c("black", "white"), -#' rule = c(0, 255), -#' type = "colourScale" -#' ) -#' -#' setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) -#' setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) -#' -#' ## Databars -#' writeData(wb, "databar", -5:5) -#' conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Default colours -#' -#' ## Between -#' # Highlight cells in interval [-2, 2] -#' writeData(wb, "between", -5:5) -#' conditionalFormatting(wb, "between", cols = 1, rows = 1:11, type = "between", rule = c(-2, 2)) -#' -#' ## Top N -#' writeData(wb, "topN", data.frame(x = 1:10, y = rnorm(10))) -#' # Highlight top 5 values in column x -#' conditionalFormatting(wb, "topN", cols = 1, rows = 2:11, -#' style = posStyle, type = "topN", rank = 5)#' -#' # Highlight top 20 percentage in column y -#' conditionalFormatting(wb, "topN", cols = 2, rows = 2:11, -#' style = posStyle, type = "topN", rank = 20, percent = TRUE) -#' -#'## Bottom N -#' writeData(wb, "bottomN", data.frame(x = 1:10, y = rnorm(10))) -#' # Highlight bottom 5 values in column x -#' conditionalFormatting(wb, "bottomN", cols = 1, rows = 2:11, -#' style = negStyle, type = "topN", rank = 5) -#' # Highlight bottom 20 percentage in column y -#' conditionalFormatting(wb, "bottomN", cols = 2, rows = 2:11, -#' style = negStyle, type = "topN", rank = 20, percent = TRUE) -#' -#' ## Logical Operators -#' # You can use Excels logical Operators -#' writeData(wb, "logical operators", 1:10) -#' conditionalFormatting(wb, "logical operators", -#' cols = 1, rows = 1:10, -#' rule = "OR($A1=1,$A1=3,$A1=5,$A1=7)" -#' ) -#' \dontrun{ -#' saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) -#' } -#' -#' -#' ######################################################################### -#' ## Databar Example -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, "databar") -#' -#' ## Databars -#' writeData(wb, "databar", -5:5, startCol = 1) -#' conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Defaults -#' -#' writeData(wb, "databar", -5:5, startCol = 3) -#' conditionalFormatting(wb, "databar", cols = 3, rows = 1:11, type = "databar", border = FALSE) -#' -#' writeData(wb, "databar", -5:5, startCol = 5) -#' conditionalFormatting(wb, "databar", -#' cols = 5, rows = 1:11, -#' type = "databar", style = c("#a6a6a6"), showValue = FALSE -#' ) -#' -#' writeData(wb, "databar", -5:5, startCol = 7) -#' conditionalFormatting(wb, "databar", -#' cols = 7, rows = 1:11, -#' type = "databar", style = c("#a6a6a6"), showValue = FALSE, gradient = FALSE -#' ) -#' -#' writeData(wb, "databar", -5:5, startCol = 9) -#' conditionalFormatting(wb, "databar", -#' cols = 9, rows = 1:11, -#' type = "databar", style = c("#a6a6a6", "#a6a6a6"), showValue = FALSE, gradient = FALSE -#' ) -#' \dontrun{ -#' saveWorkbook(wb, file = "databarExample.xlsx", overwrite = TRUE) -#' } -#' -conditionalFormatting <- - function(wb, - sheet, - cols, - rows, - rule = NULL, - style = NULL, - type = "expression", - ...) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - type <- tolower(type) - params <- list(...) - - if (type %in% c("colorscale", "colourscale")) { - type <- "colorScale" - } else if (type == "databar") { - type <- "dataBar" - } else if (type == "duplicates") { - type <- "duplicatedValues" - } else if (type == "contains") { - type <- "containsText" - } else if (type == "notcontains") { - type <- "notContainsText" - } else if (type == "beginswith") { - type <- "beginsWith" - } else if (type == "endswith") { - type <- "endsWith" - } else if (type == "between") { - type <- "between" - } else if (type == "topn") { - type <- "topN" - } else if (type == "bottomn") { - type <- "bottomN" - } else if (type != "expression") { - stop( - "Invalid type argument. Type must be one of 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', 'endsWith', 'contains' or 'notContains'" - ) - } - - ## rows and cols - if (!is.numeric(cols)) { - cols <- convertFromExcelRef(cols) - } - rows <- as.integer(rows) - - - ## check valid rule - values <- NULL - dxfId <- NULL - - if (type == "colorScale") { - # type == "colourScale" - # - style is a vector of colours with length 2 or 3 - # - rule specifies the quantiles (numeric vector of length 2 or 3), if NULL min and max are used - - if (is.null(style)) { - stop("If type == 'colourScale', style must be a vector of colours of length 2 or 3.") - } - - if (class(style) != "character") { - stop("If type == 'colourScale', style must be a vector of colours of length 2 or 3.") - } - - if (!length(style) %in% 2:3) { - stop("If type == 'colourScale', style must be a vector of length 2 or 3.") - } - - if (!is.null(rule)) { - if (length(rule) != length(style)) { - stop("If type == 'colourScale', rule and style must have equal lengths.") - } - } - - style <- - validateColour(style, errorMsg = "Invalid colour specified in style.") - - values <- rule - rule <- style - } else if (type == "dataBar") { - # type == "databar" - # - style is a vector of colours of length 2 or 3 - # - rule specifies the quantiles (numeric vector of length 2 or 3), if NULL min and max are used - - if (is.null(style)) { - style <- "#638EC6" - } - - if (class(style) != "character") { - stop("If type == 'dataBar', style must be a vector of colours of length 1 or 2.") - } - - if (!length(style) %in% 1:2) { - stop("If type == 'dataBar', style must be a vector of length 1 or 2.") - } - - if (!is.null(rule)) { - if (length(rule) != length(style)) { - stop("If type == 'dataBar', rule and style must have equal lengths.") - } - } - - - ## Additional parameters passed by ... - if ("showValue" %in% names(params)) { - params$showValue <- as.integer(params$showValue) - if (is.na(params$showValue)) { - stop("showValue must be 0/1 or TRUE/FALSE") - } - } - - if ("gradient" %in% names(params)) { - params$gradient <- as.integer(params$gradient) - if (is.na(params$gradient)) { - stop("gradient must be 0/1 or TRUE/FALSE") - } - } - - if ("border" %in% names(params)) { - params$border <- as.integer(params$border) - if (is.na(params$border)) { - stop("border must be 0/1 or TRUE/FALSE") - } - } - - style <- - validateColour(style, errorMsg = "Invalid colour specified in style.") - - values <- rule - rule <- style - } else if (type == "expression") { - # type == "expression" - # - style = createStyle() - # - rule is an expression to evaluate - - # rule <- gsub(" ", "", rule) - rule <- replaceIllegalCharacters(rule) - rule <- gsub("!=", "<>", rule) - rule <- gsub("==", "=", rule) - - if (!grepl("[A-Z]", substr(rule, 1, 2))) { - ## formula looks like "operatorX" , attach top left cell to rule - rule <- - paste0(getCellRefs(data.frame( - "x" = min(rows), "y" = min(cols) - )), rule) - } ## else, there is a letter in the formula and apply as is - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'expression', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - } else if (type == "duplicatedValues") { - # type == "duplicatedValues" - # - style is a Style object - # - rule is ignored - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'duplicates', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - rule <- style - } else if (type == "containsText") { - # type == "contains" - # - style is Style object - # - rule is text to look for - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - - if (!"character" %in% class(rule)) { - stop("If type == 'contains', rule must be a character vector of length 1.") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'contains', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - values <- rule - rule <- style - } else if (type == "notContainsText") { - # type == "contains" - # - style is Style object - # - rule is text to look for - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - - if (!"character" %in% class(rule)) { - stop("If type == 'notContains', rule must be a character vector of length 1.") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'notContains', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - values <- rule - rule <- style - } else if (type == "beginsWith") { - # type == "contains" - # - style is Style object - # - rule is text to look for - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - - if (!"character" %in% class(rule)) { - stop("If type == 'beginsWith', rule must be a character vector of length 1.") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'beginsWith', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - values <- rule - rule <- style - } else if (type == "endsWith") { - # type == "contains" - # - style is Style object - # - rule is text to look for - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - - if (!"character" %in% class(rule)) { - stop("If type == 'endsWith', rule must be a character vector of length 1.") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'endsWith', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - values <- rule - rule <- style - } else if (type == "between") { - rule <- range(rule) - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'between', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - } else if (type == "topN") { - # type == "topN" - # - rule is ignored - # - 'rank' and 'percent' are named params - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'topN', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - - ## Additional parameters passed by ... - if ("percent" %in% names(params)) { - params$percent <- as.integer(params$percent) - if (is.na(params$percent)) { - stop("percent must be 0/1 or TRUE/FALSE") - } - } - - if ("rank" %in% names(params)) { - params$rank <- as.integer(params$rank) - if (is.na(params$rank)) { - stop("rank must be a number") - } - } - - invisible(dxfId <- wb$addDXFS(style)) - values <- params - rule <- style - } else if (type == "bottomN") { - # type == "bottomN" - # - rule is ignored - # - 'rank' and 'percent' are named params - - if (is.null(style)) { - style <- - createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - if (!"Style" %in% class(style)) { - stop("If type == 'bottomN', style must be a Style object.") - } - - invisible(dxfId <- wb$addDXFS(style)) - - ## Additional parameters passed by ... - if ("percent" %in% names(params)) { - params$percent <- as.integer(params$percent) - if (is.na(params$percent)) { - stop("percent must be 0/1 or TRUE/FALSE") - } - } - - if ("rank" %in% names(params)) { - params$rank <- as.integer(params$rank) - if (is.na(params$rank)) { - stop("rank must be a number") - } - } - - invisible(dxfId <- wb$addDXFS(style)) - values <- params - rule <- style - } - - - - invisible( - wb$conditionalFormatting( - sheet, - startRow = min(rows), - endRow = max(rows), - startCol = min(cols), - endCol = max(cols), - dxfId = dxfId, - formula = rule, - type = type, - values = values, - params = params - ) - ) - - invisible(0) - } + + + + + +#' @name conditionalFormatting +#' @aliases databar +#' @title Add conditional formatting to cells +#' @description Add conditional formatting to cells +#' @author Alexander Walker, Philipp Schauberger +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols Columns to apply conditional formatting to +#' @param rows Rows to apply conditional formatting to +#' @param rule The condition under which to apply the formatting. See examples. +#' @param style A style to apply to those cells that satisfy the rule. Default is createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +#' @param type Either 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', +#' 'endsWith', 'topN', 'bottomN', 'contains' or 'notContains' (case insensitive). +#' @param ... See below +#' @details See Examples. +#' +#' If type == "expression" +#' \itemize{ +#' \item{style is a Style object. See [createStyle()]} +#' \item{rule is an expression. Valid operators are "<", "<=", ">", ">=", "==", "!=".} +#' } +#' +#' If type == "colourScale" +#' \itemize{ +#' \item{style is a vector of colours with length 2 or 3} +#' \item{rule can be NULL or a vector of colours of equal length to styles} +#' } +#' +#' If type == "databar" +#' \itemize{ +#' \item{style is a vector of colours with length 2 or 3} +#' \item{rule is a numeric vector specifying the range of the databar colours. Must be equal length to style} +#' \item{... +#' \itemize{ +#' \item{**showvalue** If FALSE the cell value is hidden. Default TRUE.} +#' \item{**gradient** If FALSE colour gradient is removed. Default TRUE.} +#' \item{**border** If FALSE the border around the database is hidden. Default TRUE.} +#' } +#' } +#' } +#' +#' If type == "duplicates" +#' \itemize{ +#' \item{style is a Style object. See [createStyle()]} +#' \item{rule is ignored.} +#' } +#' +#' If type == "contains" +#' \itemize{ +#' \item{style is a Style object. See [createStyle()]} +#' \item{rule is the text to look for within cells} +#' } +#' +#' If type == "between" +#' \itemize{ +#' \item{style is a Style object. See [createStyle()]} +#' \item{rule is a numeric vector of length 2 specifying lower and upper bound (Inclusive)} +#' } +#' +#' If type == "topN" +#' \itemize{ +#' \item{style is a Style object. See [createStyle()]} +#' \item{rule is ignored} +#' \item{... +#' \itemize{ +#' \item{**rank** numeric vector of length 1 indicating number of highest values.} +#' \item{**percent** TRUE if you want top N percentage.} +#' } +#' } +#' } +#' +#' If type == "bottomN" +#' \itemize{ +#' \item{style is a Style object. See [createStyle()]} +#' \item{rule is ignored} +#' \item{... +#' \itemize{ +#' \item{**rank** numeric vector of length 1 indicating number of lowest values.} +#' \item{**percent** TRUE if you want bottom N percentage.} +#' } +#' } +#' } +#' +#' @seealso [createStyle()] +#' @export +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "cellIs") +#' addWorksheet(wb, "Moving Row") +#' addWorksheet(wb, "Moving Col") +#' addWorksheet(wb, "Dependent on") +#' addWorksheet(wb, "Duplicates") +#' addWorksheet(wb, "containsText") +#' addWorksheet(wb, "notcontainsText") +#' addWorksheet(wb, "beginsWith") +#' addWorksheet(wb, "endsWith") +#' addWorksheet(wb, "colourScale", zoom = 30) +#' addWorksheet(wb, "databar") +#' addWorksheet(wb, "between") +#' addWorksheet(wb, "topN") +#' addWorksheet(wb, "bottomN") +#' addWorksheet(wb, "logical operators") +#' +#' negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +#' posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") +#' +#' ## rule applies to all each cell in range +#' writeData(wb, "cellIs", -5:5) +#' writeData(wb, "cellIs", LETTERS[1:11], startCol = 2) +#' conditionalFormatting(wb, "cellIs", +#' cols = 1, +#' rows = 1:11, rule = "!=0", style = negStyle +#' ) +#' conditionalFormatting(wb, "cellIs", +#' cols = 1, +#' rows = 1:11, rule = "==0", style = posStyle +#' ) +#' +#' ## highlight row dependent on first cell in row +#' writeData(wb, "Moving Row", -5:5) +#' writeData(wb, "Moving Row", LETTERS[1:11], startCol = 2) +#' conditionalFormatting(wb, "Moving Row", +#' cols = 1:2, +#' rows = 1:11, rule = "$A1<0", style = negStyle +#' ) +#' conditionalFormatting(wb, "Moving Row", +#' cols = 1:2, +#' rows = 1:11, rule = "$A1>0", style = posStyle +#' ) +#' +#' ## highlight column dependent on first cell in column +#' writeData(wb, "Moving Col", -5:5) +#' writeData(wb, "Moving Col", LETTERS[1:11], startCol = 2) +#' conditionalFormatting(wb, "Moving Col", +#' cols = 1:2, +#' rows = 1:11, rule = "A$1<0", style = negStyle +#' ) +#' conditionalFormatting(wb, "Moving Col", +#' cols = 1:2, +#' rows = 1:11, rule = "A$1>0", style = posStyle +#' ) +#' +#' ## highlight entire range cols X rows dependent only on cell A1 +#' writeData(wb, "Dependent on", -5:5) +#' writeData(wb, "Dependent on", LETTERS[1:11], startCol = 2) +#' conditionalFormatting(wb, "Dependent on", +#' cols = 1:2, +#' rows = 1:11, rule = "$A$1<0", style = negStyle +#' ) +#' conditionalFormatting(wb, "Dependent on", +#' cols = 1:2, +#' rows = 1:11, rule = "$A$1>0", style = posStyle +#' ) +#' +#' ## highlight cells in column 1 based on value in column 2 +#' writeData(wb, "Dependent on", data.frame(x = 1:10, y = runif(10)), startRow = 15) +#' conditionalFormatting(wb, "Dependent on", +#' cols = 1, +#' rows = 16:25, rule = "B16<0.5", style = negStyle +#' ) +#' conditionalFormatting(wb, "Dependent on", +#' cols = 1, +#' rows = 16:25, rule = "B16>=0.5", style = posStyle +#' ) +#' +#' +#' ## highlight duplicates using default style +#' writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) +#' conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") +#' +#' ## cells containing text +#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +#' writeData(wb, "containsText", sapply(1:10, fn)) +#' conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") +#' +#' ## cells not containing text +#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +#' writeData(wb, "containsText", sapply(1:10, fn)) +#' conditionalFormatting(wb, "notcontainsText", cols = 1, +#' rows = 1:10, type = "notcontains", rule = "A") +#' +#' +#' ## cells begins with text +#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +#' writeData(wb, "beginsWith", sapply(1:100, fn)) +#' conditionalFormatting(wb, "beginsWith", cols = 1, rows = 1:100, type = "beginsWith", rule = "A") +#' +#' +#' ## cells ends with text +#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +#' writeData(wb, "endsWith", sapply(1:100, fn)) +#' conditionalFormatting(wb, "endsWith", cols = 1, rows = 1:100, type = "endsWith", rule = "A") +#' +#' ## colourscale colours cells based on cell value +#' df <- read.xlsx(system.file("extdata", "readTest.xlsx", package = "openxlsx"), sheet = 4) +#' writeData(wb, "colourScale", df, colNames = FALSE) ## write data.frame +#' +#' ## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) +#' ## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. +#' conditionalFormatting(wb, "colourScale", +#' cols = 1:ncol(df), rows = 1:nrow(df), +#' style = c("black", "white"), +#' rule = c(0, 255), +#' type = "colourScale" +#' ) +#' +#' setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) +#' setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) +#' +#' ## Databars +#' writeData(wb, "databar", -5:5) +#' conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Default colours +#' +#' ## Between +#' # Highlight cells in interval [-2, 2] +#' writeData(wb, "between", -5:5) +#' conditionalFormatting(wb, "between", cols = 1, rows = 1:11, type = "between", rule = c(-2, 2)) +#' +#' ## Top N +#' writeData(wb, "topN", data.frame(x = 1:10, y = rnorm(10))) +#' # Highlight top 5 values in column x +#' conditionalFormatting(wb, "topN", cols = 1, rows = 2:11, +#' style = posStyle, type = "topN", rank = 5)#' +#' # Highlight top 20 percentage in column y +#' conditionalFormatting(wb, "topN", cols = 2, rows = 2:11, +#' style = posStyle, type = "topN", rank = 20, percent = TRUE) +#' +#'## Bottom N +#' writeData(wb, "bottomN", data.frame(x = 1:10, y = rnorm(10))) +#' # Highlight bottom 5 values in column x +#' conditionalFormatting(wb, "bottomN", cols = 1, rows = 2:11, +#' style = negStyle, type = "topN", rank = 5) +#' # Highlight bottom 20 percentage in column y +#' conditionalFormatting(wb, "bottomN", cols = 2, rows = 2:11, +#' style = negStyle, type = "topN", rank = 20, percent = TRUE) +#' +#' ## Logical Operators +#' # You can use Excels logical Operators +#' writeData(wb, "logical operators", 1:10) +#' conditionalFormatting(wb, "logical operators", +#' cols = 1, rows = 1:10, +#' rule = "OR($A1=1,$A1=3,$A1=5,$A1=7)" +#' ) +#' \dontrun{ +#' saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) +#' } +#' +#' +#' ######################################################################### +#' ## Databar Example +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, "databar") +#' +#' ## Databars +#' writeData(wb, "databar", -5:5, startCol = 1) +#' conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Defaults +#' +#' writeData(wb, "databar", -5:5, startCol = 3) +#' conditionalFormatting(wb, "databar", cols = 3, rows = 1:11, type = "databar", border = FALSE) +#' +#' writeData(wb, "databar", -5:5, startCol = 5) +#' conditionalFormatting(wb, "databar", +#' cols = 5, rows = 1:11, +#' type = "databar", style = c("#a6a6a6"), showValue = FALSE +#' ) +#' +#' writeData(wb, "databar", -5:5, startCol = 7) +#' conditionalFormatting(wb, "databar", +#' cols = 7, rows = 1:11, +#' type = "databar", style = c("#a6a6a6"), showValue = FALSE, gradient = FALSE +#' ) +#' +#' writeData(wb, "databar", -5:5, startCol = 9) +#' conditionalFormatting(wb, "databar", +#' cols = 9, rows = 1:11, +#' type = "databar", style = c("#a6a6a6", "#a6a6a6"), showValue = FALSE, gradient = FALSE +#' ) +#' \dontrun{ +#' saveWorkbook(wb, file = "databarExample.xlsx", overwrite = TRUE) +#' } +#' +conditionalFormatting <- + function(wb, + sheet, + cols, + rows, + rule = NULL, + style = NULL, + type = "expression", + ...) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + type <- tolower(type) + params <- list(...) + + if (type %in% c("colorscale", "colourscale")) { + type <- "colorScale" + } else if (type == "databar") { + type <- "dataBar" + } else if (type == "duplicates") { + type <- "duplicatedValues" + } else if (type == "contains") { + type <- "containsText" + } else if (type == "notcontains") { + type <- "notContainsText" + } else if (type == "beginswith") { + type <- "beginsWith" + } else if (type == "endswith") { + type <- "endsWith" + } else if (type == "between") { + type <- "between" + } else if (type == "topn") { + type <- "topN" + } else if (type == "bottomn") { + type <- "bottomN" + } else if (type != "expression") { + stop( + "Invalid type argument. Type must be one of 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', 'endsWith', 'contains' or 'notContains'" + ) + } + + ## rows and cols + if (!is.numeric(cols)) { + cols <- convertFromExcelRef(cols) + } + rows <- as.integer(rows) + + + ## check valid rule + values <- NULL + dxfId <- NULL + + if (type == "colorScale") { + # type == "colourScale" + # - style is a vector of colours with length 2 or 3 + # - rule specifies the quantiles (numeric vector of length 2 or 3), if NULL min and max are used + + if (is.null(style)) { + stop("If type == 'colourScale', style must be a vector of colours of length 2 or 3.") + } + + if (class(style) != "character") { + stop("If type == 'colourScale', style must be a vector of colours of length 2 or 3.") + } + + if (!length(style) %in% 2:3) { + stop("If type == 'colourScale', style must be a vector of length 2 or 3.") + } + + if (!is.null(rule)) { + if (length(rule) != length(style)) { + stop("If type == 'colourScale', rule and style must have equal lengths.") + } + } + + style <- + validateColour(style, errorMsg = "Invalid colour specified in style.") + + values <- rule + rule <- style + } else if (type == "dataBar") { + # type == "databar" + # - style is a vector of colours of length 2 or 3 + # - rule specifies the quantiles (numeric vector of length 2 or 3), if NULL min and max are used + + if (is.null(style)) { + style <- "#638EC6" + } + + if (class(style) != "character") { + stop("If type == 'dataBar', style must be a vector of colours of length 1 or 2.") + } + + if (!length(style) %in% 1:2) { + stop("If type == 'dataBar', style must be a vector of length 1 or 2.") + } + + if (!is.null(rule)) { + if (length(rule) != length(style)) { + stop("If type == 'dataBar', rule and style must have equal lengths.") + } + } + + + ## Additional parameters passed by ... + if ("showValue" %in% names(params)) { + params$showValue <- as.integer(params$showValue) + if (is.na(params$showValue)) { + stop("showValue must be 0/1 or TRUE/FALSE") + } + } + + if ("gradient" %in% names(params)) { + params$gradient <- as.integer(params$gradient) + if (is.na(params$gradient)) { + stop("gradient must be 0/1 or TRUE/FALSE") + } + } + + if ("border" %in% names(params)) { + params$border <- as.integer(params$border) + if (is.na(params$border)) { + stop("border must be 0/1 or TRUE/FALSE") + } + } + + style <- + validateColour(style, errorMsg = "Invalid colour specified in style.") + + values <- rule + rule <- style + } else if (type == "expression") { + # type == "expression" + # - style = createStyle() + # - rule is an expression to evaluate + + # rule <- gsub(" ", "", rule) + rule <- replaceIllegalCharacters(rule) + rule <- gsub("!=", "<>", rule) + rule <- gsub("==", "=", rule) + + if (!grepl("[A-Z]", substr(rule, 1, 2))) { + ## formula looks like "operatorX" , attach top left cell to rule + rule <- + paste0(getCellRefs(data.frame( + "x" = min(rows), "y" = min(cols) + )), rule) + } ## else, there is a letter in the formula and apply as is + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'expression', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + } else if (type == "duplicatedValues") { + # type == "duplicatedValues" + # - style is a Style object + # - rule is ignored + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'duplicates', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + rule <- style + } else if (type == "containsText") { + # type == "contains" + # - style is Style object + # - rule is text to look for + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + + if (!"character" %in% class(rule)) { + stop("If type == 'contains', rule must be a character vector of length 1.") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'contains', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + values <- rule + rule <- style + } else if (type == "notContainsText") { + # type == "contains" + # - style is Style object + # - rule is text to look for + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + + if (!"character" %in% class(rule)) { + stop("If type == 'notContains', rule must be a character vector of length 1.") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'notContains', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + values <- rule + rule <- style + } else if (type == "beginsWith") { + # type == "contains" + # - style is Style object + # - rule is text to look for + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + + if (!"character" %in% class(rule)) { + stop("If type == 'beginsWith', rule must be a character vector of length 1.") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'beginsWith', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + values <- rule + rule <- style + } else if (type == "endsWith") { + # type == "contains" + # - style is Style object + # - rule is text to look for + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + + if (!"character" %in% class(rule)) { + stop("If type == 'endsWith', rule must be a character vector of length 1.") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'endsWith', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + values <- rule + rule <- style + } else if (type == "between") { + rule <- range(rule) + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'between', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + } else if (type == "topN") { + # type == "topN" + # - rule is ignored + # - 'rank' and 'percent' are named params + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'topN', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + + ## Additional parameters passed by ... + if ("percent" %in% names(params)) { + params$percent <- as.integer(params$percent) + if (is.na(params$percent)) { + stop("percent must be 0/1 or TRUE/FALSE") + } + } + + if ("rank" %in% names(params)) { + params$rank <- as.integer(params$rank) + if (is.na(params$rank)) { + stop("rank must be a number") + } + } + + invisible(dxfId <- wb$addDXFS(style)) + values <- params + rule <- style + } else if (type == "bottomN") { + # type == "bottomN" + # - rule is ignored + # - 'rank' and 'percent' are named params + + if (is.null(style)) { + style <- + createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + if (!"Style" %in% class(style)) { + stop("If type == 'bottomN', style must be a Style object.") + } + + invisible(dxfId <- wb$addDXFS(style)) + + ## Additional parameters passed by ... + if ("percent" %in% names(params)) { + params$percent <- as.integer(params$percent) + if (is.na(params$percent)) { + stop("percent must be 0/1 or TRUE/FALSE") + } + } + + if ("rank" %in% names(params)) { + params$rank <- as.integer(params$rank) + if (is.na(params$rank)) { + stop("rank must be a number") + } + } + + invisible(dxfId <- wb$addDXFS(style)) + values <- params + rule <- style + } + + + + invisible( + wb$conditionalFormatting( + sheet, + startRow = min(rows), + endRow = max(rows), + startCol = min(cols), + endCol = max(cols), + dxfId = dxfId, + formula = rule, + type = type, + values = values, + params = params + ) + ) + + invisible(0) + } diff -Nru r-cran-openxlsx-4.2.4/R/data-fontSizeLookupTables.R r-cran-openxlsx-4.2.5/R/data-fontSizeLookupTables.R --- r-cran-openxlsx-4.2.4/R/data-fontSizeLookupTables.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/data-fontSizeLookupTables.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,10 +1,10 @@ -#' Font Size Lookup tables -#' -#' Lookup tables for font size -#' -#' @format A data.frame with column names corresponding to font names -"openxlsxFontSizeLookupTable" - -#' @rdname openxlsxFontSizeLookupTable -#' @format NULL -"openxlsxFontSizeLookupTableBold" +#' Font Size Lookup tables +#' +#' Lookup tables for font size +#' +#' @format A data.frame with column names corresponding to font names +"openxlsxFontSizeLookupTable" + +#' @rdname openxlsxFontSizeLookupTable +#' @format NULL +"openxlsxFontSizeLookupTableBold" diff -Nru r-cran-openxlsx-4.2.4/R/helperFunctions.R r-cran-openxlsx-4.2.5/R/helperFunctions.R --- r-cran-openxlsx-4.2.4/R/helperFunctions.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/helperFunctions.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,965 +1,985 @@ - - - - -#' @name makeHyperlinkString -#' @title create Excel hyperlink string -#' @description Wrapper to create internal hyperlink string to pass to writeFormula() -#' @param sheet Name of a worksheet -#' @param row integer row number for hyperlink to link to -#' @param col column number of letter for hyperlink to link to -#' @param text display text -#' @param file Excel file name to point to. If NULL hyperlink is internal. -#' @seealso \code{\link{writeFormula}} -#' @export makeHyperlinkString -#' @examples -#' -#' ## Writing internal hyperlinks -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet1") -#' addWorksheet(wb, "Sheet2") -#' addWorksheet(wb, "Sheet 3") -#' writeData(wb, sheet = 3, x = iris) -#' -#' ## External Hyperlink -#' x <- c("https://www.google.com", "https://www.google.com.au") -#' names(x) <- c("google", "google Aus") -#' class(x) <- "hyperlink" -#' -#' writeData(wb, sheet = 1, x = x, startCol = 10) -#' -#' -#' ## Internal Hyperlink - create hyperlink formula manually -#' writeFormula(wb, "Sheet1", -#' x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")', -#' startCol = 3 -#' ) -#' -#' ## Internal - No text to display using makeHyperlinkString() function -#' writeFormula(wb, "Sheet1", -#' startRow = 1, -#' x = makeHyperlinkString(sheet = "Sheet 3", row = 1, col = 2) -#' ) -#' -#' ## Internal - Text to display -#' writeFormula(wb, "Sheet1", -#' startRow = 2, -#' x = makeHyperlinkString( -#' sheet = "Sheet 3", row = 1, col = 2, -#' text = "Link to Sheet 3" -#' ) -#' ) -#' -#' ## Link to file - No text to display -#' writeFormula(wb, "Sheet1", -#' startRow = 4, -#' x = makeHyperlinkString( -#' sheet = "testing", row = 3, col = 10, -#' file = system.file("extdata", "loadExample.xlsx", package = "openxlsx") -#' ) -#' ) -#' -#' ## Link to file - Text to display -#' writeFormula(wb, "Sheet1", -#' startRow = 3, -#' x = makeHyperlinkString( -#' sheet = "testing", row = 3, col = 10, -#' file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"), -#' text = "Link to File." -#' ) -#' ) -#' -#' ## Link to external file - Text to display -#' writeFormula(wb, "Sheet1", -#' startRow = 10, startCol = 1, -#' x = '=HYPERLINK(\\"[C:/Users]\\", \\"Link to an external file\\")' -#' ) -#' \dontrun{ -#' saveWorkbook(wb, "internalHyperlinks.xlsx", overwrite = TRUE) -#' } -#' -makeHyperlinkString <- function(sheet, row = 1, col = 1, text = NULL, file = NULL) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - - cell <- paste0(int2col(col), row) - if (!is.null(file)) { - dest <- sprintf("[%s]'%s'!%s", file, sheet, cell) - } else { - dest <- sprintf("#'%s'!%s", sheet, cell) - } - - if (is.null(text)) { - str <- sprintf("=HYPERLINK(\"%s\")", dest) - } else { - str <- sprintf("=HYPERLINK(\"%s\", \"%s\")", dest, text) - } - - return(str) -} - - -getRId <- function(x) { - regmatches(x, gregexpr('(?<= r:id=")[0-9A-Za-z]+', x, perl = TRUE)) -} - -getId <- function(x) { - regmatches(x, gregexpr('(?<= Id=")[0-9A-Za-z]+', x, perl = TRUE)) -} - - - -## creates style object based on column classes -## Used in writeData for styling when no borders and writeData table for all column-class based styling -classStyles <- function(wb, sheet, startRow, startCol, colNames, nRow, colClasses, stack = TRUE) { - sheet <- wb$validateSheet(sheet) - allColClasses <- unlist(colClasses, use.names = FALSE) - rowInds <- (1 + startRow + colNames - 1L):(nRow + startRow + colNames - 1L) - startCol <- startCol - 1L - - newStylesElements <- NULL - names(colClasses) <- NULL - - if ("hyperlink" %in% allColClasses) { - - ## style hyperlinks - inds <- which(sapply(colClasses, function(x) "hyperlink" %in% x)) - - hyperlinkstyle <- createStyle(textDecoration = "underline") - hyperlinkstyle$fontColour <- list("theme" = "10") - styleElements <- list( - "style" = hyperlinkstyle, - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - if ("date" %in% allColClasses) { - - ## style dates - inds <- which(sapply(colClasses, function(x) "date" %in% x)) - - styleElements <- list( - "style" = createStyle(numFmt = "date"), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - if (any(c("posixlt", "posixct", "posixt") %in% allColClasses)) { - - ## style POSIX - inds <- which(sapply(colClasses, function(x) any(c("posixct", "posixt", "posixlt") %in% x))) - - styleElements <- list( - "style" = createStyle(numFmt = "LONGDATE"), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - - ## style currency as CURRENCY - if ("currency" %in% allColClasses) { - inds <- which(sapply(colClasses, function(x) "currency" %in% x)) - - styleElements <- list( - "style" = createStyle(numFmt = "CURRENCY"), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - ## style accounting as ACCOUNTING - if ("accounting" %in% allColClasses) { - inds <- which(sapply(colClasses, function(x) "accounting" %in% x)) - - styleElements <- list( - "style" = createStyle(numFmt = "ACCOUNTING"), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - ## style percentages - if ("percentage" %in% allColClasses) { - inds <- which(sapply(colClasses, function(x) "percentage" %in% x)) - - styleElements <- list( - "style" = createStyle(numFmt = "percentage"), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - ## style big mark - if ("scientific" %in% allColClasses) { - inds <- which(sapply(colClasses, function(x) "scientific" %in% x)) - - styleElements <- list( - "style" = createStyle(numFmt = "scientific"), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - ## style big mark - if ("3" %in% allColClasses | "comma" %in% allColClasses) { - inds <- which(sapply(colClasses, function(x) "3" %in% tolower(x) | "comma" %in% tolower(x))) - - styleElements <- list( - "style" = createStyle(numFmt = "3"), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - ## numeric sigfigs (Col must be numeric and numFmt options must only have 0s and \\.) - if ("numeric" %in% allColClasses & !grepl("[^0\\.,#\\$\\* %]", getOption("openxlsx.numFmt", "GENERAL"))) { - inds <- which(sapply(colClasses, function(x) "numeric" %in% tolower(x))) - - styleElements <- list( - "style" = createStyle(numFmt = getOption("openxlsx.numFmt", "0")), - "sheet" = wb$sheet_names[sheet], - "rows" = rep.int(rowInds, times = length(inds)), - "cols" = rep(inds + startCol, each = length(rowInds)) - ) - - newStylesElements <- append(newStylesElements, list(styleElements)) - } - - - if (!is.null(newStylesElements)) { - if (stack) { - for (i in seq_along(newStylesElements)) { - wb$addStyle( - sheet = sheet, - style = newStylesElements[[i]]$style, - rows = newStylesElements[[i]]$rows, - cols = newStylesElements[[i]]$cols, stack = TRUE - ) - } - } else { - wb$styleObjects <- append(wb$styleObjects, newStylesElements) - } - } - - - - invisible(1) -} - - -#' @name validateColour -#' @description validate the colour input -#' @param colour colour -#' @param errorMsg Error message -#' @author Philipp Schauberger -#' @importFrom grDevices colours -#' @keywords internal -#' @noRd -validateColour <- function(colour, errorMsg = "Invalid colour!") { - - ## check if - if (is.null(colour)) { - colour <- "black" - } - - validColours <- colours() - - if (any(colour %in% validColours)) { - colour[colour %in% validColours] <- col2hex(colour[colour %in% validColours]) - } - - if (any(!grepl("^#[A-Fa-f0-9]{6}$", colour))) { - stop(errorMsg, call. = FALSE) - } - - colour <- gsub("^#", "FF", toupper(colour)) - - return(colour) -} - -#' @name col2hex -#' @description convert rgb to hex -#' @param creator my.col -#' @author Philipp Schauberger -#' @importFrom grDevices col2rgb rgb -#' @keywords internal -#' @noRd -col2hex <- function(my.col) { - rgb(t(col2rgb(my.col)), maxColorValue = 255) -} - - -## header and footer replacements -headerFooterSub <- function(x) { - if (!is.null(x)) { - x <- replaceIllegalCharacters(x) - x <- gsub("\\[Page\\]", "P", x) - x <- gsub("\\[Pages\\]", "N", x) - x <- gsub("\\[Date\\]", "D", x) - x <- gsub("\\[Time\\]", "T", x) - x <- gsub("\\[Path\\]", "Z", x) - x <- gsub("\\[File\\]", "F", x) - x <- gsub("\\[Tab\\]", "A", x) - } - - return(x) -} - - -writeCommentXML <- function(comment_list, file_name) { - authors <- unique(sapply(comment_list, "[[", "author")) - xml <- '' - xml <- c(xml, paste0("", paste(sprintf("%s", authors), collapse = ""), "")) - - for (i in seq_along(comment_list)) { - authorInd <- which(authors == comment_list[[i]]$author) - 1L - xml <- c(xml, sprintf('', comment_list[[i]]$ref, authorInd)) - - if (length(comment_list[[i]]$style) != 0) { - ## check that style information is present - for (j in seq_along(comment_list[[i]]$comment)) { - xml <- c(xml, sprintf('%s%s', - comment_list[[i]]$style[[j]], - comment_list[[i]]$comment[[j]])) - } - } else { - ## Case with no styling information. - for (j in seq_along(comment_list[[i]]$comment)) { - xml <- c(xml, sprintf('%s', - comment_list[[i]]$comment[[j]])) - } - } - - xml <- c(xml, "") - } - - write_file(body = paste(xml, collapse = ""), tail = "", fl = file_name) - - NULL -} - - -illegalchars <- c("&", '"', "'", "<", ">", "\a", "\b", "\v", "\f") -illegalcharsreplace <- c("&", """, "'", "<", ">", "", "", "", "") - -replaceIllegalCharacters <- function(v) { - vEnc <- Encoding(v) - v <- as.character(v) - - flg <- vEnc != "UTF-8" - if (any(flg)) { - v[flg] <- stri_conv(v[flg], from = "", to = "UTF-8") - } - - v <- stri_replace_all_fixed(v, illegalchars, illegalcharsreplace, vectorize_all = FALSE) - - return(v) -} - - -replaceXMLEntities <- function(v) { - v <- gsub("&", "&", v, fixed = TRUE) - v <- gsub(""", '"', v, fixed = TRUE) - v <- gsub("'", "'", v, fixed = TRUE) - v <- gsub("<", "<", v, fixed = TRUE) - v <- gsub(">", ">", v, fixed = TRUE) - - return(v) -} - - -pxml <- function(x) { - paste(unique(unlist(x)), collapse = "") -} - - -removeHeadTag <- function(x) { - x <- paste(x, collapse = "") - - if (any(grepl("<\\?", x))) { - x <- gsub("<\\?xml [^>]+", "", x) - } - - x <- gsub("^>", "", x) - x -} - -validateBorderStyle <- function(borderStyle) { - valid <- c( - "none", "thin", "medium", "dashed", "dotted", "thick", "double", "hair", "mediumDashed", - "dashDot", "mediumDashDot", "dashDotDot", "mediumDashDotDot", "slantDashDot" - ) - - ind <- match(tolower(borderStyle), tolower(valid)) - if (any(is.na(ind))) { - stop("Invalid borderStyle", call. = FALSE) - } - - return(valid[ind]) -} - -getAttrsFont <- function(xml, tag) { - x <- lapply(xml, getChildlessNode, tag = tag) - x[sapply(x, length) == 0] <- "" - x <- unlist(x) - a <- lapply(x, function(x) unlist(regmatches(x, gregexpr('[a-zA-Z]+=".*?"', x)))) - - nms <- lapply(a, function(xml) regmatches(xml, regexpr('[a-zA-Z]+(?=\\=".*?")', xml, perl = TRUE))) - vals <- lapply(a, function(xml) regmatches(xml, regexpr('(?<=").*?(?=")', xml, perl = TRUE))) - vals <- lapply(vals, function(x) { - Encoding(x) <- "UTF-8" - x - }) - vals <- lapply(seq_along(vals), function(i) { - names(vals[[i]]) <- nms[[i]] - vals[[i]] - }) - - return(vals) -} - -getAttrs <- function(xml, tag) { - x <- lapply(xml, getChildlessNode_ss, tag = tag) - x[sapply(x, length) == 0] <- "" - a <- lapply(x, function(x) regmatches(x, regexpr('[a-zA-Z]+=".*?"', x))) - - names <- lapply(a, function(xml) regmatches(xml, regexpr('[a-zA-Z]+(?=\\=".*?")', xml, perl = TRUE))) - vals <- lapply(a, function(xml) regmatches(xml, regexpr('(?<=").*?(?=")', xml, perl = TRUE))) - vals <- lapply(vals, function(x) { - Encoding(x) <- "UTF-8" - x - }) - - names(vals) <- names - return(vals) -} - - -buildFontList <- function(fonts) { - sz <- getAttrs(fonts, " 0) { - f <- c(f, sz[i]) - nms <- c(nms, "sz") - } - - if (length(unlist(colour[i])) > 0) { - f <- c(f, colour[i]) - nms <- c(nms, "color") - } - - if (length(unlist(name[i])) > 0) { - f <- c(f, name[i]) - nms <- c(nms, "name") - } - - if (length(unlist(family[i])) > 0) { - f <- c(f, family[i]) - nms <- c(nms, "family") - } - - if (length(unlist(scheme[i])) > 0) { - f <- c(f, scheme[i]) - nms <- c(nms, "scheme") - } - - if (length(italic[[i]]) > 0) { - f <- c(f, "italic") - nms <- c(nms, "italic") - } - - if (length(bold[[i]]) > 0) { - f <- c(f, "bold") - nms <- c(nms, "bold") - } - - if (length(underline[[i]]) > 0) { - f <- c(f, "underline") - nms <- c(nms, "underline") - } - - f <- lapply(seq_along(f), function(i) unlist(f[i])) - names(f) <- nms - - ft[[i]] <- f - } - - ft -} - - - -get_named_regions_from_string <- function(dn) { - dn <- gsub("", "", dn, fixed = TRUE) - dn <- gsub("", "", dn, fixed = TRUE) - - dn <- unique(unlist(strsplit(dn, split = "", fixed = TRUE))) - dn <- grep(").*", dn, perl = TRUE)) - dn_pos <- gsub("[$']", "", dn_pos) - - has_bang <- grepl("!", dn_pos, fixed = TRUE) - dn_sheets <- ifelse(has_bang, - gsub("^(.*)!.*$", "\\1", dn_pos), - "" - ) - dn_coords <- ifelse(has_bang, - gsub("^.*!(.*)$", "\\1", dn_pos), - "" - ) - - attr(dn_names, "sheet") <- dn_sheets - attr(dn_names, "position") <- dn_coords - - return(dn_names) -} - - - -nodeAttributes <- function(x) { - x <- paste0("<", unlist(strsplit(x, split = "<"))) - x <- grep(" 1) tmp <- tmp[[1]] - if (length(tmp) == 1) { - sideBorder[[i]] <- tmp - } - } - - sideBorder <- sideBorder[sideBorder != ""] - x <- x[sideBorder != ""] - if (length(sideBorder) == 0) { - return(NULL) - } - - - ## style - weight <- gsub('style=|"', "", regmatches(x, regexpr('style="[a-z]+"', x, perl = TRUE, ignore.case = TRUE))) - - - ## Colours - cols <- replicate(n = length(sideBorder), list(rgb = "FF000000")) - colNodes <- unlist(sapply(x, getChildlessNode, tag = "color", USE.NAMES = FALSE)) - - if (length(colNodes) > 0) { - attrs <- regmatches(colNodes, regexpr('(theme|indexed|rgb|auto)=".+"', colNodes)) - } else { - attrs <- NULL - } - - if (length(attrs) != length(x)) { - return( - list( - "borders" = paste(sideBorder, collapse = ""), - "colour" = cols - ) - ) - } - - attrs <- strsplit(attrs, split = "=") - cols <- sapply(attrs, function(attr) { - if (length(attr) == 2) { - y <- list(gsub('"', "", attr[2])) - names(y) <- gsub(" ", "", attr[[1]]) - } else { - tmp <- paste(attr[-1], collapse = "=") - y <- gsub('^"|"$', "", tmp) - names(y) <- gsub(" ", "", attr[[1]]) - } - return(y) - }) - - ## sideBorder & cols - if ("LEFT" %in% sideBorder) { - style$borderLeft <- weight[which(sideBorder == "LEFT")] - style$borderLeftColour <- cols[which(sideBorder == "LEFT")] - } - - if ("RIGHT" %in% sideBorder) { - style$borderRight <- weight[which(sideBorder == "RIGHT")] - style$borderRightColour <- cols[which(sideBorder == "RIGHT")] - } - - if ("TOP" %in% sideBorder) { - style$borderTop <- weight[which(sideBorder == "TOP")] - style$borderTopColour <- cols[which(sideBorder == "TOP")] - } - - if ("BOTTOM" %in% sideBorder) { - style$borderBottom <- weight[which(sideBorder == "BOTTOM")] - style$borderBottomColour <- cols[which(sideBorder == "BOTTOM")] - } - - if ("DIAGONAL" %in% sideBorder) { - style$borderDiagonal <- weight[which(sideBorder == "DIAGONAL")] - style$borderDiagonalColour <- cols[which(sideBorder == "DIAGONAL")] - } - - return(style) -} - - -genHeaderFooterNode <- function(x) { - - # - # &Lfirst L&CfC&RfR - # &LfFootL&CfFootC&RfFootR - # &LTIS&CIS&REVEN H - # &LEVEN L F&CEVEN C F&REVEN RIGHT F - # &L&P&Cfirst C&Rfirst R - # &Lfirst L Foot&Cfirst C Foot&Rfirst R Foot - # - - ## ODD - if (length(x$oddHeader) > 0) { - oddHeader <- paste0( - "", - sprintf("&L%s", x$oddHeader[[1]]), - sprintf("&C%s", x$oddHeader[[2]]), - sprintf("&R%s", x$oddHeader[[3]]), - "", - collapse = "" - ) - } else { - oddHeader <- NULL - } - - if (length(x$oddFooter) > 0) { - oddFooter <- paste0( - "", - sprintf("&L%s", x$oddFooter[[1]]), - sprintf("&C%s", x$oddFooter[[2]]), - sprintf("&R%s", x$oddFooter[[3]]), - "", - collapse = "" - ) - } else { - oddFooter <- NULL - } - - ## EVEN - if (length(x$evenHeader) > 0) { - evenHeader <- paste0( - "", - sprintf("&L%s", x$evenHeader[[1]]), - sprintf("&C%s", x$evenHeader[[2]]), - sprintf("&R%s", x$evenHeader[[3]]), - "", - collapse = "" - ) - } else { - evenHeader <- NULL - } - - if (length(x$evenFooter) > 0) { - evenFooter <- paste0( - "", - sprintf("&L%s", x$evenFooter[[1]]), - sprintf("&C%s", x$evenFooter[[2]]), - sprintf("&R%s", x$evenFooter[[3]]), - "", - collapse = "" - ) - } else { - evenFooter <- NULL - } - - ## FIRST - if (length(x$firstHeader) > 0) { - firstHeader <- paste0( - "", - sprintf("&L%s", x$firstHeader[[1]]), - sprintf("&C%s", x$firstHeader[[2]]), - sprintf("&R%s", x$firstHeader[[3]]), - "", - collapse = "" - ) - } else { - firstHeader <- NULL - } - - if (length(x$firstFooter) > 0) { - firstFooter <- paste0( - "", - sprintf("&L%s", x$firstFooter[[1]]), - sprintf("&C%s", x$firstFooter[[2]]), - sprintf("&R%s", x$firstFooter[[3]]), - "", - collapse = "" - ) - } else { - firstFooter <- NULL - } - - headTag <- sprintf( - '', - as.integer(!(is.null(evenHeader) & is.null(evenFooter))), - as.integer(!(is.null(firstHeader) & is.null(firstFooter))) - ) - - paste0( - headTag, - oddHeader, - oddFooter, - evenHeader, - evenFooter, - firstHeader, - firstFooter, - "" - ) -} - - -buildFillList <- function(fills) { - fillAttrs <- rep(list(list()), length(fills)) - - ## patternFill - inds <- grepl("patternFill", fills) - fillAttrs[inds] <- lapply(fills[inds], nodeAttributes) - - ## gradientFill - inds <- grepl("gradientFill", fills) - fillAttrs[inds] <- fills[inds] - - return(fillAttrs) -} - - -getDefinedNamesSheet <- function(x) { - belongTo <- unlist(lapply(strsplit(x, split = ">|<"), "[[", 3)) - quoted <- grepl("^'", belongTo) - - belongTo[quoted] <- regmatches(belongTo[quoted], regexpr("(?<=').*(?='!)", belongTo[quoted], perl = TRUE)) - belongTo[!quoted] <- gsub("!\\$[A-Z0-9].*", "", belongTo[!quoted]) - belongTo[!quoted] <- gsub("!#REF!.*", "", belongTo[!quoted]) - - return(belongTo) -} - - -getSharedStringsFromFile <- function(sharedStringsFile, isFile) { - - ## read in, get si tags, get t tag value and pull out all string nodes - sharedStrings <- get_shared_strings(xmlFile = sharedStringsFile, isFile = isFile) ## read from file - - - Encoding(sharedStrings) <- "UTF-8" - z <- tolower(sharedStrings) - sharedStrings[z == "true"] <- "TRUE" - sharedStrings[z == "false"] <- "FALSE" - z <- NULL ## effectivel remove z - - ## XML replacements - sharedStrings <- replaceXMLEntities(sharedStrings) - - return(sharedStrings) -} - - -clean_names <- function(x, schar) { - x <- gsub("^[[:space:]]+|[[:space:]]+$", "", x) - x <- gsub("[[:space:]]+", schar, x) - return(x) -} - - - -mergeCell2mapping <- function(x) { - refs <- regmatches(x, regexpr("(?<=ref=\")[A-Z0-9:]+", x, perl = TRUE)) - refs <- strsplit(refs, split = ":") - rows <- lapply(refs, function(r) { - r <- as.integer(gsub(pattern = "[A-Z]", replacement = "", r, perl = TRUE)) - seq(from = r[1], to = r[2], by = 1) - }) - - cols <- lapply(refs, function(r) { - r <- convertFromExcelRef(r) - seq(from = r[1], to = r[2], by = 1) - }) - - ## for each we grid.expand - refs <- do.call("rbind", lapply(seq_along(rows), function(i) { - tmp <- expand.grid("cols" = cols[[i]], "rows" = rows[[i]]) - tmp$ref <- paste0(convert_to_excel_ref(cols = tmp$cols, LETTERS = LETTERS), tmp$rows) - tmp$anchor_cell <- tmp$ref[1] - return(tmp[, c("anchor_cell", "ref", "rows")]) - })) - - - refs <- refs[refs$anchor_cell != refs$ref, ] - - return(refs) -} - - - - -splitHeaderFooter <- function(x) { - tmp <- gsub("<(/|)(odd|even|first)(Header|Footer)>(&|)", "", x, perl = TRUE) - special_tags <- regmatches(tmp, regexpr("&[^LCR]", tmp)) - if (length(special_tags) > 0) { - for (i in seq_along(special_tags)) { - tmp <- gsub(special_tags[i], sprintf("openxlsx__%s67298679", i), tmp, fixed = TRUE) - } - } - - tmp <- strsplit(tmp, split = "&")[[1]] - - if (length(special_tags) > 0) { - for (i in seq_along(special_tags)) { - tmp <- gsub(sprintf("openxlsx__%s67298679", i), special_tags[i], tmp, fixed = TRUE) - } - } - - - res <- rep(list(NULL), 3) - ind <- substr(tmp, 1, 1) == "L" - if (any(ind)) { - res[[1]] <- substring(tmp, 2)[ind] - } - - ind <- substr(tmp, 1, 1) == "C" - if (any(ind)) { - res[[2]] <- substring(tmp, 2)[ind] - } - - ind <- substr(tmp, 1, 1) == "R" - if (any(ind)) { - res[[3]] <- substring(tmp, 2)[ind] - } - - res -} - - - - -getFile <- function(xlsxFile) { - - ## Is this a file or URL (code taken from read.table()) - on.exit(try(close(fl), silent = TRUE), add = TRUE) - fl <- file(description = xlsxFile) - - ## If URL download - if ("url" %in% class(fl)) { - tmpFile <- tempfile(fileext = ".xlsx") - download.file(url = xlsxFile, destfile = tmpFile, cacheOK = FALSE, mode = "wb", quiet = TRUE) - xlsxFile <- tmpFile - } - - return(xlsxFile) -} - -# Rotate the 15-bit integer by n bits to the -hashPassword <- function(password) { - # password limited to 15 characters - chars <- head(strsplit(password, "")[[1]], 15) - # See OpenOffice's documentation of the Excel format: http://www.openoffice.org/sc/excelfileformat.pdf - # Start from the last character and for each character - # - XOR hash with the ASCII character code - # - rotate hash (16 bits) one bit to the left - # Finally, XOR hash with 0xCE4B and XOR with password length - # Output as hex (uppercase) - rotate16bit <- function(hash, n = 1) { - bitwOr(bitwAnd(bitwShiftR(hash, 15 - n), 0x01), bitwAnd(bitwShiftL(hash, n), 0x7fff)) - } - hash <- Reduce(function(char, h) { - h <- bitwXor(h, as.integer(charToRaw(char))) - rotate16bit(h, 1) - }, chars, 0, right = TRUE) - hash <- bitwXor(bitwXor(hash, length(chars)), 0xCE4B) - format(as.hexmode(hash), upper.case = TRUE) -} - -readUTF8 <- function(x) { - readLines(x, warn = FALSE, encoding = "UTF-8") -} + + + + +#' @name makeHyperlinkString +#' @title create Excel hyperlink string +#' @description Wrapper to create internal hyperlink string to pass to writeFormula(). Either link to external urls or local files or straight to cells of local Excel sheets. +#' @param sheet Name of a worksheet +#' @param row integer row number for hyperlink to link to +#' @param col column number of letter for hyperlink to link to +#' @param text display text +#' @param file Excel file name to point to. If NULL hyperlink is internal. +#' @seealso [writeFormula()] +#' @export makeHyperlinkString +#' @examples +#' +#' ## Writing internal hyperlinks +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet1") +#' addWorksheet(wb, "Sheet2") +#' addWorksheet(wb, "Sheet 3") +#' writeData(wb, sheet = 3, x = iris) +#' +#' ## External Hyperlink +#' x <- c("https://www.google.com", "https://www.google.com.au") +#' names(x) <- c("google", "google Aus") +#' class(x) <- "hyperlink" +#' +#' writeData(wb, sheet = 1, x = x, startCol = 10) +#' +#' +#' ## Internal Hyperlink - create hyperlink formula manually +#' writeFormula(wb, "Sheet1", +#' x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")', +#' startCol = 3 +#' ) +#' +#' ## Internal - No text to display using makeHyperlinkString() function +#' writeFormula(wb, "Sheet1", +#' startRow = 1, +#' x = makeHyperlinkString(sheet = "Sheet 3", row = 1, col = 2) +#' ) +#' +#' ## Internal - Text to display +#' writeFormula(wb, "Sheet1", +#' startRow = 2, +#' x = makeHyperlinkString( +#' sheet = "Sheet 3", row = 1, col = 2, +#' text = "Link to Sheet 3" +#' ) +#' ) +#' +#' ## Link to file - No text to display +#' writeFormula(wb, "Sheet1", +#' startRow = 4, +#' x = makeHyperlinkString( +#' sheet = "testing", row = 3, col = 10, +#' file = system.file("extdata", "loadExample.xlsx", package = "openxlsx") +#' ) +#' ) +#' +#' ## Link to file - Text to display +#' writeFormula(wb, "Sheet1", +#' startRow = 3, +#' x = makeHyperlinkString( +#' sheet = "testing", row = 3, col = 10, +#' file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"), +#' text = "Link to File." +#' ) +#' ) +#' +#' ## Link to external file - Text to display +#' writeFormula(wb, "Sheet1", +#' startRow = 10, startCol = 1, +#' x = '=HYPERLINK(\\"[C:/Users]\\", \\"Link to an external file\\")' +#' ) +#' +#' ## Link to internal file +#' x = makeHyperlinkString(text = "test.png", file = "D:/somepath/somepicture.png") +#' writeFormula(wb, "Sheet1", startRow = 11, startCol = 1, x = x) +#' +#' \dontrun{ +#' saveWorkbook(wb, "internalHyperlinks.xlsx", overwrite = TRUE) +#' } +#' +makeHyperlinkString <- function(sheet, row = 1, col = 1, text = NULL, file = NULL) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (missing(sheet)) { + if (!missing(row) || !missing(col)) warning("Option for col and/or row found, but no sheet was provided.") + + str <- sprintf("=HYPERLINK(\"%s\", \"%s\")", file, text) + } else { + cell <- paste0(int2col(col), row) + if (!is.null(file)) { + dest <- sprintf("[%s]'%s'!%s", file, sheet, cell) + } else { + dest <- sprintf("#'%s'!%s", sheet, cell) + } + + if (is.null(text)) { + str <- sprintf("=HYPERLINK(\"%s\")", dest) + } else { + str <- sprintf("=HYPERLINK(\"%s\", \"%s\")", dest, text) + } + } + + return(str) +} + + +getRId <- function(x) { + regmatches(x, gregexpr('(?<= r:id=")[0-9A-Za-z]+', x, perl = TRUE)) +} + +getId <- function(x) { + regmatches(x, gregexpr('(?<= Id=")[0-9A-Za-z]+', x, perl = TRUE)) +} + + + +## creates style object based on column classes +## Used in writeData for styling when no borders and writeData table for all column-class based styling +classStyles <- function(wb, sheet, startRow, startCol, colNames, nRow, colClasses, stack = TRUE) { + sheet <- wb$validateSheet(sheet) + allColClasses <- unlist(colClasses, use.names = FALSE) + rowInds <- (1 + startRow + colNames - 1L):(nRow + startRow + colNames - 1L) + startCol <- startCol - 1L + + newStylesElements <- NULL + names(colClasses) <- NULL + + if ("hyperlink" %in% allColClasses) { + + ## style hyperlinks + inds <- which(sapply(colClasses, function(x) "hyperlink" %in% x)) + + hyperlinkstyle <- createStyle(textDecoration = "underline") + hyperlinkstyle$fontColour <- list("theme" = "10") + styleElements <- list( + "style" = hyperlinkstyle, + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + if ("date" %in% allColClasses) { + + ## style dates + inds <- which(sapply(colClasses, function(x) "date" %in% x)) + + styleElements <- list( + "style" = createStyle(numFmt = "date"), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + if (any(c("posixlt", "posixct", "posixt") %in% allColClasses)) { + + ## style POSIX + inds <- which(sapply(colClasses, function(x) any(c("posixct", "posixt", "posixlt") %in% x))) + + styleElements <- list( + "style" = createStyle(numFmt = "LONGDATE"), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + + ## style currency as CURRENCY + if ("currency" %in% allColClasses) { + inds <- which(sapply(colClasses, function(x) "currency" %in% x)) + + styleElements <- list( + "style" = createStyle(numFmt = "CURRENCY"), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + ## style accounting as ACCOUNTING + if ("accounting" %in% allColClasses) { + inds <- which(sapply(colClasses, function(x) "accounting" %in% x)) + + styleElements <- list( + "style" = createStyle(numFmt = "ACCOUNTING"), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + ## style percentages + if ("percentage" %in% allColClasses) { + inds <- which(sapply(colClasses, function(x) "percentage" %in% x)) + + styleElements <- list( + "style" = createStyle(numFmt = "percentage"), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + ## style big mark + if ("scientific" %in% allColClasses) { + inds <- which(sapply(colClasses, function(x) "scientific" %in% x)) + + styleElements <- list( + "style" = createStyle(numFmt = "scientific"), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + ## style big mark + if ("3" %in% allColClasses | "comma" %in% allColClasses) { + inds <- which(sapply(colClasses, function(x) "3" %in% tolower(x) | "comma" %in% tolower(x))) + + styleElements <- list( + "style" = createStyle(numFmt = "3"), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + ## numeric sigfigs (Col must be numeric and numFmt options must only have 0s and \\.) + if ("numeric" %in% allColClasses & !grepl("[^0\\.,#\\$\\* %]", getOption("openxlsx.numFmt", "GENERAL"))) { + inds <- which(sapply(colClasses, function(x) "numeric" %in% tolower(x))) + + styleElements <- list( + "style" = createStyle(numFmt = getOption("openxlsx.numFmt", "0")), + "sheet" = wb$sheet_names[sheet], + "rows" = rep.int(rowInds, times = length(inds)), + "cols" = rep(inds + startCol, each = length(rowInds)) + ) + + newStylesElements <- append(newStylesElements, list(styleElements)) + } + + + if (!is.null(newStylesElements)) { + if (stack) { + for (i in seq_along(newStylesElements)) { + wb$addStyle( + sheet = sheet, + style = newStylesElements[[i]]$style, + rows = newStylesElements[[i]]$rows, + cols = newStylesElements[[i]]$cols, stack = TRUE + ) + } + } else { + wb$styleObjects <- append(wb$styleObjects, newStylesElements) + } + } + + + + invisible(1) +} + + +#' @name validateColour +#' @description validate the colour input +#' @param colour colour +#' @param errorMsg Error message +#' @author Philipp Schauberger +#' @importFrom grDevices colours +#' @keywords internal +#' @noRd +validateColour <- function(colour, errorMsg = "Invalid colour!") { + + ## check if + if (is.null(colour)) { + colour <- "black" + } + + validColours <- colours() + + if (any(colour %in% validColours)) { + colour[colour %in% validColours] <- col2hex(colour[colour %in% validColours]) + } + + if (any(!grepl("^#[A-Fa-f0-9]{6}$", colour))) { + stop(errorMsg, call. = FALSE) + } + + colour <- gsub("^#", "FF", toupper(colour)) + + return(colour) +} + +#' @name col2hex +#' @description convert rgb to hex +#' @param creator my.col +#' @author Philipp Schauberger +#' @importFrom grDevices col2rgb rgb +#' @keywords internal +#' @noRd +col2hex <- function(my.col) { + rgb(t(col2rgb(my.col)), maxColorValue = 255) +} + + +## header and footer replacements +headerFooterSub <- function(x) { + if (!is.null(x)) { + x <- replaceIllegalCharacters(x) + x <- gsub("\\[Page\\]", "P", x) + x <- gsub("\\[Pages\\]", "N", x) + x <- gsub("\\[Date\\]", "D", x) + x <- gsub("\\[Time\\]", "T", x) + x <- gsub("\\[Path\\]", "Z", x) + x <- gsub("\\[File\\]", "F", x) + x <- gsub("\\[Tab\\]", "A", x) + } + + return(x) +} + + +writeCommentXML <- function(comment_list, file_name) { + authors <- unique(sapply(comment_list, "[[", "author")) + xml <- '' + xml <- c(xml, paste0("", paste(sprintf("%s", authors), collapse = ""), "")) + + for (i in seq_along(comment_list)) { + authorInd <- which(authors == comment_list[[i]]$author) - 1L + xml <- c(xml, sprintf('', comment_list[[i]]$ref, authorInd)) + + if (length(comment_list[[i]]$style) != 0) { + ## check that style information is present + for (j in seq_along(comment_list[[i]]$comment)) { + xml <- c(xml, sprintf('%s%s', + comment_list[[i]]$style[[j]], + comment_list[[i]]$comment[[j]])) + } + } else { + ## Case with no styling information. + for (j in seq_along(comment_list[[i]]$comment)) { + xml <- c(xml, sprintf('%s', + comment_list[[i]]$comment[[j]])) + } + } + + xml <- c(xml, "") + } + + write_file(body = paste(xml, collapse = ""), tail = "", fl = file_name) + + NULL +} + + +illegalchars <- c("&", '"', "'", "<", ">", "\a", "\b", "\v", "\f") +illegalcharsreplace <- c("&", """, "'", "<", ">", "", "", "", "") + +replaceIllegalCharacters <- function(v) { + vEnc <- Encoding(v) + v <- as.character(v) + + flg <- vEnc != "UTF-8" + if (any(flg)) { + v[flg] <- stri_conv(v[flg], from = "", to = "UTF-8") + } + + v <- stri_replace_all_fixed(v, illegalchars, illegalcharsreplace, vectorize_all = FALSE) + + return(v) +} + + +replaceXMLEntities <- function(v) { + v <- gsub("&", "&", v, fixed = TRUE) + v <- gsub(""", '"', v, fixed = TRUE) + v <- gsub("'", "'", v, fixed = TRUE) + v <- gsub("<", "<", v, fixed = TRUE) + v <- gsub(">", ">", v, fixed = TRUE) + + return(v) +} + + +pxml <- function(x) { + paste(unique(unlist(x)), collapse = "") +} + + +removeHeadTag <- function(x) { + x <- paste(x, collapse = "") + + if (any(grepl("<\\?", x))) { + x <- gsub("<\\?xml [^>]+", "", x) + } + + x <- gsub("^>", "", x) + x +} + +validateBorderStyle <- function(borderStyle) { + valid <- c( + "none", "thin", "medium", "dashed", "dotted", "thick", "double", "hair", "mediumDashed", + "dashDot", "mediumDashDot", "dashDotDot", "mediumDashDotDot", "slantDashDot" + ) + + ind <- match(tolower(borderStyle), tolower(valid)) + if (any(is.na(ind))) { + stop("Invalid borderStyle", call. = FALSE) + } + + return(valid[ind]) +} + +getAttrsFont <- function(xml, tag) { + x <- lapply(xml, getChildlessNode, tag = tag) + x[sapply(x, length) == 0] <- "" + x <- unlist(x) + a <- lapply(x, function(x) unlist(regmatches(x, gregexpr('[a-zA-Z]+=".*?"', x)))) + + nms <- lapply(a, function(xml) regmatches(xml, regexpr('[a-zA-Z]+(?=\\=".*?")', xml, perl = TRUE))) + vals <- lapply(a, function(xml) regmatches(xml, regexpr('(?<=").*?(?=")', xml, perl = TRUE))) + vals <- lapply(vals, function(x) { + Encoding(x) <- "UTF-8" + x + }) + vals <- lapply(seq_along(vals), function(i) { + names(vals[[i]]) <- nms[[i]] + vals[[i]] + }) + + return(vals) +} + +getAttrs <- function(xml, tag) { + x <- lapply(xml, getChildlessNode_ss, tag = tag) + x[sapply(x, length) == 0] <- "" + a <- lapply(x, function(x) regmatches(x, regexpr('[a-zA-Z]+=".*?"', x))) + + names <- lapply(a, function(xml) regmatches(xml, regexpr('[a-zA-Z]+(?=\\=".*?")', xml, perl = TRUE))) + vals <- lapply(a, function(xml) regmatches(xml, regexpr('(?<=").*?(?=")', xml, perl = TRUE))) + vals <- lapply(vals, function(x) { + Encoding(x) <- "UTF-8" + x + }) + + names(vals) <- names + return(vals) +} + + +buildFontList <- function(fonts) { + sz <- getAttrs(fonts, "sz") + colour <- getAttrsFont(fonts, "color") + name <- getAttrs(fonts, tag = "name") + family <- getAttrs(fonts, "family") + scheme <- getAttrs(fonts, "scheme") + + italic <- lapply(fonts, getChildlessNode, tag = "i") + bold <- lapply(fonts, getChildlessNode, tag = "b") + underline <- lapply(fonts, getChildlessNode, tag = "u") + strikeout <- lapply(fonts, getChildlessNode, tag = "strike") + + ## Build font objects + ft <- replicate(list(), n = length(fonts)) + for (i in seq_along(fonts)) { + f <- NULL + nms <- NULL + if (length(unlist(sz[i])) > 0) { + f <- c(f, sz[i]) + nms <- c(nms, "sz") + } + + if (length(unlist(colour[i])) > 0) { + f <- c(f, colour[i]) + nms <- c(nms, "color") + } + + if (length(unlist(name[i])) > 0) { + f <- c(f, name[i]) + nms <- c(nms, "name") + } + + if (length(unlist(family[i])) > 0) { + f <- c(f, family[i]) + nms <- c(nms, "family") + } + + if (length(unlist(scheme[i])) > 0) { + f <- c(f, scheme[i]) + nms <- c(nms, "scheme") + } + + if (length(italic[[i]]) > 0) { + f <- c(f, "italic") + nms <- c(nms, "italic") + } + + if (length(bold[[i]]) > 0) { + f <- c(f, "bold") + nms <- c(nms, "bold") + } + + if (length(underline[[i]]) > 0) { + f <- c(f, "underline") + nms <- c(nms, "underline") + } + + if (length(unlist(strikeout[i])) > 0) { + f <- c(f, strikeout[i]) + nms <- c(nms, "strikeout") + } + + f <- lapply(seq_along(f), function(i) unlist(f[i])) + names(f) <- nms + + ft[[i]] <- f + } + + ft +} + + + +get_named_regions_from_string <- function(dn) { + dn <- gsub("", "", dn, fixed = TRUE) + dn <- gsub("", "", dn, fixed = TRUE) + + dn <- unique(unlist(strsplit(dn, split = "", fixed = TRUE))) + dn <- grep(").*", dn, perl = TRUE)) + dn_pos <- gsub("[$']", "", dn_pos) + + has_bang <- grepl("!", dn_pos, fixed = TRUE) + dn_sheets <- ifelse(has_bang, + gsub("^(.*)!.*$", "\\1", dn_pos), + "" + ) + dn_coords <- ifelse(has_bang, + gsub("^.*!(.*)$", "\\1", dn_pos), + "" + ) + + attr(dn_names, "sheet") <- dn_sheets + attr(dn_names, "position") <- dn_coords + + return(dn_names) +} + + + +nodeAttributes <- function(x) { + x <- paste0("<", unlist(strsplit(x, split = "<"))) + x <- grep(" 1) tmp <- tmp[[1]] + if (length(tmp) == 1) { + sideBorder[[i]] <- tmp + } + } + + sideBorder <- sideBorder[sideBorder != ""] + x <- x[sideBorder != ""] + if (length(sideBorder) == 0) { + return(NULL) + } + + + ## style + weight <- gsub('style=|"', "", regmatches(x, regexpr('style="[a-z]+"', x, perl = TRUE, ignore.case = TRUE))) + + + ## Colours + cols <- replicate(n = length(sideBorder), list(rgb = "FF000000")) + colNodes <- unlist(sapply(x, getChildlessNode, tag = "color", USE.NAMES = FALSE)) + + if (length(colNodes) > 0) { + attrs <- regmatches(colNodes, regexpr('(theme|indexed|rgb|auto)=".+"', colNodes)) + } else { + attrs <- NULL + } + + if (length(attrs) != length(x)) { + return( + list( + "borders" = paste(sideBorder, collapse = ""), + "colour" = cols + ) + ) + } + + attrs <- strsplit(attrs, split = "=") + cols <- sapply(attrs, function(attr) { + if (length(attr) == 2) { + y <- list(gsub('"', "", attr[2])) + names(y) <- gsub(" ", "", attr[[1]]) + } else { + tmp <- paste(attr[-1], collapse = "=") + y <- gsub('^"|"$', "", tmp) + names(y) <- gsub(" ", "", attr[[1]]) + } + return(y) + }) + + ## sideBorder & cols + if ("LEFT" %in% sideBorder) { + style$borderLeft <- weight[which(sideBorder == "LEFT")] + style$borderLeftColour <- cols[which(sideBorder == "LEFT")] + } + + if ("RIGHT" %in% sideBorder) { + style$borderRight <- weight[which(sideBorder == "RIGHT")] + style$borderRightColour <- cols[which(sideBorder == "RIGHT")] + } + + if ("TOP" %in% sideBorder) { + style$borderTop <- weight[which(sideBorder == "TOP")] + style$borderTopColour <- cols[which(sideBorder == "TOP")] + } + + if ("BOTTOM" %in% sideBorder) { + style$borderBottom <- weight[which(sideBorder == "BOTTOM")] + style$borderBottomColour <- cols[which(sideBorder == "BOTTOM")] + } + + if ("DIAGONAL" %in% sideBorder) { + style$borderDiagonal <- weight[which(sideBorder == "DIAGONAL")] + style$borderDiagonalColour <- cols[which(sideBorder == "DIAGONAL")] + } + + return(style) +} + + +genHeaderFooterNode <- function(x) { + + # + # &Lfirst L&CfC&RfR + # &LfFootL&CfFootC&RfFootR + # &LTIS&CIS&REVEN H + # &LEVEN L F&CEVEN C F&REVEN RIGHT F + # &L&P&Cfirst C&Rfirst R + # &Lfirst L Foot&Cfirst C Foot&Rfirst R Foot + # + + ## ODD + if (length(x$oddHeader) > 0) { + oddHeader <- paste0( + "", + sprintf("&L%s", x$oddHeader[[1]]), + sprintf("&C%s", x$oddHeader[[2]]), + sprintf("&R%s", x$oddHeader[[3]]), + "", + collapse = "" + ) + } else { + oddHeader <- NULL + } + + if (length(x$oddFooter) > 0) { + oddFooter <- paste0( + "", + sprintf("&L%s", x$oddFooter[[1]]), + sprintf("&C%s", x$oddFooter[[2]]), + sprintf("&R%s", x$oddFooter[[3]]), + "", + collapse = "" + ) + } else { + oddFooter <- NULL + } + + ## EVEN + if (length(x$evenHeader) > 0) { + evenHeader <- paste0( + "", + sprintf("&L%s", x$evenHeader[[1]]), + sprintf("&C%s", x$evenHeader[[2]]), + sprintf("&R%s", x$evenHeader[[3]]), + "", + collapse = "" + ) + } else { + evenHeader <- NULL + } + + if (length(x$evenFooter) > 0) { + evenFooter <- paste0( + "", + sprintf("&L%s", x$evenFooter[[1]]), + sprintf("&C%s", x$evenFooter[[2]]), + sprintf("&R%s", x$evenFooter[[3]]), + "", + collapse = "" + ) + } else { + evenFooter <- NULL + } + + ## FIRST + if (length(x$firstHeader) > 0) { + firstHeader <- paste0( + "", + sprintf("&L%s", x$firstHeader[[1]]), + sprintf("&C%s", x$firstHeader[[2]]), + sprintf("&R%s", x$firstHeader[[3]]), + "", + collapse = "" + ) + } else { + firstHeader <- NULL + } + + if (length(x$firstFooter) > 0) { + firstFooter <- paste0( + "", + sprintf("&L%s", x$firstFooter[[1]]), + sprintf("&C%s", x$firstFooter[[2]]), + sprintf("&R%s", x$firstFooter[[3]]), + "", + collapse = "" + ) + } else { + firstFooter <- NULL + } + + headTag <- sprintf( + '', + as.integer(!(is.null(evenHeader) & is.null(evenFooter))), + as.integer(!(is.null(firstHeader) & is.null(firstFooter))) + ) + + paste0( + headTag, + oddHeader, + oddFooter, + evenHeader, + evenFooter, + firstHeader, + firstFooter, + "" + ) +} + + +buildFillList <- function(fills) { + fillAttrs <- rep(list(list()), length(fills)) + + ## patternFill + inds <- grepl("patternFill", fills) + fillAttrs[inds] <- lapply(fills[inds], nodeAttributes) + + ## gradientFill + inds <- grepl("gradientFill", fills) + fillAttrs[inds] <- fills[inds] + + return(fillAttrs) +} + +# Can test with below: +# x <- "" +getDefinedNamesSheet <- function(x) { + sub("'?\\!.*", "", sub("^.*>'", "", x)) +} + +# Not used but kepted in case fix above isn't correct +getDefinedNamedSheet_ <- function(x) { + belongTo <- unlist(lapply(strsplit(x, split = ">|<"), "[[", 3)) + quoted <- grepl("^'", belongTo) + + belongTo[quoted] <- regmatches(belongTo[quoted], regexpr("(?<=').*(?='!)", belongTo[quoted], perl = TRUE)) + belongTo[!quoted] <- gsub("!\\$[A-Z0-9].*", "", belongTo[!quoted]) + belongTo[!quoted] <- gsub("!#REF!.*", "", belongTo[!quoted]) + + return(belongTo) +} + +getSharedStringsFromFile <- function(sharedStringsFile, isFile) { + + ## read in, get si tags, get t tag value and pull out all string nodes + sharedStrings <- get_shared_strings(xmlFile = sharedStringsFile, isFile = isFile) ## read from file + + + Encoding(sharedStrings) <- "UTF-8" + z <- tolower(sharedStrings) + sharedStrings[z == "true"] <- "TRUE" + sharedStrings[z == "false"] <- "FALSE" + z <- NULL ## effectivel remove z + + ## XML replacements + sharedStrings <- replaceXMLEntities(sharedStrings) + + return(sharedStrings) +} + + +clean_names <- function(x, schar) { + x <- gsub("^[[:space:]]+|[[:space:]]+$", "", x) + x <- gsub("[[:space:]]+", schar, x) + return(x) +} + + + +mergeCell2mapping <- function(x) { + refs <- regmatches(x, regexpr("(?<=ref=\")[A-Z0-9:]+", x, perl = TRUE)) + refs <- strsplit(refs, split = ":") + rows <- lapply(refs, function(r) { + r <- as.integer(gsub(pattern = "[A-Z]", replacement = "", r, perl = TRUE)) + seq(from = r[1], to = r[2], by = 1) + }) + + cols <- lapply(refs, function(r) { + r <- convertFromExcelRef(r) + seq(from = r[1], to = r[2], by = 1) + }) + + ## for each we grid.expand + refs <- do.call("rbind", lapply(seq_along(rows), function(i) { + tmp <- expand.grid("cols" = cols[[i]], "rows" = rows[[i]]) + tmp$ref <- paste0(convert_to_excel_ref(cols = tmp$cols, LETTERS = LETTERS), tmp$rows) + tmp$anchor_cell <- tmp$ref[1] + return(tmp[, c("anchor_cell", "ref", "rows")]) + })) + + + refs <- refs[refs$anchor_cell != refs$ref, ] + + return(refs) +} + + + + +splitHeaderFooter <- function(x) { + tmp <- gsub("<(/|)(odd|even|first)(Header|Footer)>(&|)", "", x, perl = TRUE) + special_tags <- regmatches(tmp, regexpr("&[^LCR]", tmp)) + if (length(special_tags) > 0) { + for (i in seq_along(special_tags)) { + tmp <- gsub(special_tags[i], sprintf("openxlsx__%s67298679", i), tmp, fixed = TRUE) + } + } + + tmp <- strsplit(tmp, split = "&")[[1]] + + if (length(special_tags) > 0) { + for (i in seq_along(special_tags)) { + tmp <- gsub(sprintf("openxlsx__%s67298679", i), special_tags[i], tmp, fixed = TRUE) + } + } + + + res <- rep(list(NULL), 3) + ind <- substr(tmp, 1, 1) == "L" + if (any(ind)) { + res[[1]] <- substring(tmp, 2)[ind] + } + + ind <- substr(tmp, 1, 1) == "C" + if (any(ind)) { + res[[2]] <- substring(tmp, 2)[ind] + } + + ind <- substr(tmp, 1, 1) == "R" + if (any(ind)) { + res[[3]] <- substring(tmp, 2)[ind] + } + + res +} + + + + +getFile <- function(xlsxFile) { + + ## Is this a file or URL (code taken from read.table()) + on.exit(try(close(fl), silent = TRUE), add = TRUE) + fl <- file(description = xlsxFile) + + ## If URL download + if ("url" %in% class(fl)) { + tmpFile <- tempfile(fileext = ".xlsx") + download.file(url = xlsxFile, destfile = tmpFile, cacheOK = FALSE, mode = "wb", quiet = TRUE) + xlsxFile <- tmpFile + } + + return(xlsxFile) +} + +# Rotate the 15-bit integer by n bits to the +hashPassword <- function(password) { + # password limited to 15 characters + chars <- head(strsplit(password, "")[[1]], 15) + # See OpenOffice's documentation of the Excel format: http://www.openoffice.org/sc/excelfileformat.pdf + # Start from the last character and for each character + # - XOR hash with the ASCII character code + # - rotate hash (16 bits) one bit to the left + # Finally, XOR hash with 0xCE4B and XOR with password length + # Output as hex (uppercase) + rotate16bit <- function(hash, n = 1) { + bitwOr(bitwAnd(bitwShiftR(hash, 15 - n), 0x01), bitwAnd(bitwShiftL(hash, n), 0x7fff)) + } + hash <- Reduce(function(char, h) { + h <- bitwXor(h, as.integer(charToRaw(char))) + rotate16bit(h, 1) + }, chars, 0, right = TRUE) + hash <- bitwXor(bitwXor(hash, length(chars)), 0xCE4B) + format(as.hexmode(hash), upper.case = TRUE) +} + +readUTF8 <- function(x) { + readLines(x, warn = FALSE, encoding = "UTF-8") +} diff -Nru r-cran-openxlsx-4.2.4/R/HyperlinkClass.R r-cran-openxlsx-4.2.5/R/HyperlinkClass.R --- r-cran-openxlsx-4.2.4/R/HyperlinkClass.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/HyperlinkClass.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,109 +1,109 @@ - - - -Hyperlink <- setRefClass("Hyperlink", - fields = c( - "ref", - "target", - "location", - "display", - "is_external" - ), - - methods = list() -) - - -Hyperlink$methods(initialize = function(ref, target, location, display = NULL, is_external = TRUE) { - ref <<- ref - target <<- target - location <<- location - display <<- display - is_external <<- is_external -}) - -Hyperlink$methods(to_xml = function(id) { - loc <- sprintf('location="%s"', location) - disp <- sprintf('display="%s"', display) - rf <- sprintf('ref="%s"', ref) - - if (is_external) { - rid <- sprintf('r:id="rId%s"', id) - } else { - rid <- NULL - } - - paste("") -}) - -Hyperlink$methods(to_target_xml = function(id) { - if (is_external) { - return(sprintf('', id, target)) - } else { - return(NULL) - } -}) - - - -xml_to_hyperlink <- function(xml) { - - # xml <- c('', - # '', - # '') - - if (length(xml) == 0) { - return(xml) - } - - targets <- names(xml) - if (is.null(targets)) { - targets <- rep(NA, length(xml)) - } - - xml <- unname(xml) - - a <- unlist(lapply(xml, function(x) regmatches(x, gregexpr('[a-zA-Z]+=".*?"', x))), recursive = FALSE) - names <- lapply(a, function(xml) regmatches(xml, regexpr('[a-zA-Z]+(?=\\=".*?")', xml, perl = TRUE))) - vals <- lapply(a, function(xml) regmatches(xml, regexpr('(?<=").*?(?=")', xml, perl = TRUE))) - vals <- lapply(vals, function(x) { - Encoding(x) <- "UTF-8" - x - }) - - hyperlink_objects <- lapply(seq_along(xml), function(i) { - tmp_vals <- vals[[i]] - tmp_nms <- names[[i]] - names(tmp_vals) <- tmp_nms - - ## ref - ref <- tmp_vals[["ref"]] - - ## location - if ("location" %in% tmp_nms) { - location <- tmp_vals[["location"]] - } else { - location <- NULL - } - - ## location - if ("display" %in% tmp_nms) { - display <- tmp_vals[["display"]] - } else { - display <- NULL - } - - ## target/external - if (is.na(targets[i])) { - target <- NULL - is_external <- FALSE - } else { - is_external <- TRUE - target <- targets[i] - } - - Hyperlink$new(ref = ref, target = target, location = location, display = display, is_external = is_external) - }) - - return(hyperlink_objects) -} + + + +Hyperlink <- setRefClass("Hyperlink", + fields = c( + "ref", + "target", + "location", + "display", + "is_external" + ), + + methods = list() +) + + +Hyperlink$methods(initialize = function(ref, target, location, display = NULL, is_external = TRUE) { + ref <<- ref + target <<- target + location <<- location + display <<- display + is_external <<- is_external +}) + +Hyperlink$methods(to_xml = function(id) { + loc <- sprintf('location="%s"', location) + disp <- sprintf('display="%s"', display) + rf <- sprintf('ref="%s"', ref) + + if (is_external) { + rid <- sprintf('r:id="rId%s"', id) + } else { + rid <- NULL + } + + paste("") +}) + +Hyperlink$methods(to_target_xml = function(id) { + if (is_external) { + return(sprintf('', id, target)) + } else { + return(NULL) + } +}) + + + +xml_to_hyperlink <- function(xml) { + + # xml <- c('', + # '', + # '') + + if (length(xml) == 0) { + return(xml) + } + + targets <- names(xml) + if (is.null(targets)) { + targets <- rep(NA, length(xml)) + } + + xml <- unname(xml) + + a <- unlist(lapply(xml, function(x) regmatches(x, gregexpr('[a-zA-Z]+=".*?"', x))), recursive = FALSE) + names <- lapply(a, function(xml) regmatches(xml, regexpr('[a-zA-Z]+(?=\\=".*?")', xml, perl = TRUE))) + vals <- lapply(a, function(xml) regmatches(xml, regexpr('(?<=").*?(?=")', xml, perl = TRUE))) + vals <- lapply(vals, function(x) { + Encoding(x) <- "UTF-8" + x + }) + + hyperlink_objects <- lapply(seq_along(xml), function(i) { + tmp_vals <- vals[[i]] + tmp_nms <- names[[i]] + names(tmp_vals) <- tmp_nms + + ## ref + ref <- tmp_vals[["ref"]] + + ## location + if ("location" %in% tmp_nms) { + location <- tmp_vals[["location"]] + } else { + location <- NULL + } + + ## location + if ("display" %in% tmp_nms) { + display <- tmp_vals[["display"]] + } else { + display <- NULL + } + + ## target/external + if (is.na(targets[i])) { + target <- NULL + is_external <- FALSE + } else { + is_external <- TRUE + target <- targets[i] + } + + Hyperlink$new(ref = ref, target = target, location = location, display = display, is_external = is_external) + }) + + return(hyperlink_objects) +} diff -Nru r-cran-openxlsx-4.2.4/R/loadWorkbook.R r-cran-openxlsx-4.2.5/R/loadWorkbook.R --- r-cran-openxlsx-4.2.4/R/loadWorkbook.R 2021-06-08 10:43:51.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/loadWorkbook.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,1040 +1,1045 @@ - - - -#' @name loadWorkbook -#' @title Load an existing .xlsx file -#' @author Alexander Walker, Philipp Schauberger -#' @param file A path to an existing .xlsx or .xlsm file -#' @param xlsxFile alias for file -#' @param isUnzipped Set to TRUE if the xlsx file is already unzipped -#' @description loadWorkbook returns a workbook object conserving styles and -#' formatting of the original .xlsx file. -#' @return Workbook object. -#' @export -#' @seealso \code{\link{removeWorksheet}} -#' @examples -#' ## load existing workbook from package folder -#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -#' names(wb) # list worksheets -#' wb ## view object -#' ## Add a worksheet -#' addWorksheet(wb, "A new worksheet") -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "loadExample.xlsx", overwrite = TRUE) -#' } -#' -loadWorkbook <- function(file, xlsxFile = NULL, isUnzipped = FALSE) { - - ## If this is a unzipped workbook, skip the temp dir stuff - if (isUnzipped) { - xmlDir <- file - xmlFiles <- list.files(path = xmlDir, full.names = TRUE, recursive = TRUE, all.files = TRUE) - } else { - if (!is.null(xlsxFile)) { - file <- xlsxFile - } - - file <- getFile(file) - if (!file.exists(file)) { - stop("File does not exist.") - } - - ## create temp dir - xmlDir <- file.path(tempdir(), paste0(tempfile(tmpdir = ""), "_openxlsx_loadWorkbook")) - - ## Unzip files to temp directory - xmlFiles <- unzip(file, exdir = xmlDir) - } - wb <- createWorkbook() - - ## Not used - # .relsXML <- xmlFiles[grepl("_rels/.rels$", xmlFiles, perl = TRUE)] - # appXML <- xmlFiles[grepl("app.xml$", xmlFiles, perl = TRUE)] - - drawingsXML <- grep("drawings/drawing[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - worksheetsXML <- grep("/worksheets/sheet[0-9]+", xmlFiles, perl = TRUE, value = TRUE) - - coreXML <- grep("core.xml$", xmlFiles, perl = TRUE, value = TRUE) - workbookXML <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) - stylesXML <- grep("styles.xml$", xmlFiles, perl = TRUE, value = TRUE) - sharedStringsXML <- grep("sharedStrings.xml$", xmlFiles, perl = TRUE, value = TRUE) - themeXML <- grep("theme[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - drawingRelsXML <- grep("drawing[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - sheetRelsXML <- grep("sheet[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - media <- grep("image[0-9]+.[a-z]+$", xmlFiles, perl = TRUE, value = TRUE) - vmlDrawingXML <- grep("drawings/vmlDrawing[0-9]+\\.vml$", xmlFiles, perl = TRUE, value = TRUE) - vmlDrawingRelsXML <- grep("vmlDrawing[0-9]+.vml.rels$", xmlFiles, perl = TRUE, value = TRUE) - commentsXML <- grep("xl/comments[0-9]+\\.xml", xmlFiles, perl = TRUE, value = TRUE) - threadCommentsXML <- grep("xl/threadedComments/threadedComment[0-9]+\\.xml", xmlFiles, perl = TRUE, value = TRUE) - personXML <- grep("xl/persons/person.xml$", xmlFiles, perl = TRUE, value = TRUE) - embeddings <- grep("xl/embeddings", xmlFiles, perl = TRUE, value = TRUE) - charts <- grep("xl/charts/.*xml$", xmlFiles, perl = TRUE, value = TRUE) - chartsRels <- grep("xl/charts/_rels", xmlFiles, perl = TRUE, value = TRUE) - chartSheetsXML <- grep("xl/chartsheets/sheet[0-9]+\\.xml", xmlFiles, perl = TRUE, value = TRUE) - tablesXML <- grep("tables/table[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - tableRelsXML <- grep("table[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - queryTablesXML <- grep("queryTable[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - connectionsXML <- grep("connections.xml$", xmlFiles, perl = TRUE, value = TRUE) - extLinksXML <- grep("externalLink[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - extLinksRelsXML <- grep("externalLink[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - - - # pivot tables - pivotTableXML <- grep("pivotTable[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - pivotTableRelsXML <- grep("pivotTable[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - pivotDefXML <- grep("pivotCacheDefinition[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - pivotDefRelsXML <- grep("pivotCacheDefinition[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - pivotCacheRecords <- grep("pivotCacheRecords[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - - ## slicers - slicerXML <- grep("slicer[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - slicerCachesXML <- grep("slicerCache[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) - - ## VBA Macro - vbaProject <- grep("vbaProject\\.bin$", xmlFiles, perl = TRUE, value = TRUE) - - ## remove all EXCEPT media and charts - if (!isUnzipped) { - on.exit({ - paths <- grep( - "charts|media|vmlDrawing|comment|embeddings|pivot|slicer|vbaProject|person", - xmlFiles, - ignore.case = TRUE, - value = TRUE, - invert = TRUE - ) - unlink(paths, recursive = TRUE, force = TRUE) - }, - add = TRUE - ) -} - - ## core - if (length(coreXML) == 1) { - coreXML <- paste(readUTF8(coreXML), collapse = "") - wb$core <- removeHeadTag(x = coreXML) - } - - nSheets <- length(worksheetsXML) + length(chartSheetsXML) - - ## get Rid of chartsheets, these do not have a worksheet/sheeti.xml - worksheet_rId_mapping <- NULL - workbookRelsXML <- grep("workbook.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - if (length(workbookRelsXML) > 0) { - workbookRelsXML <- paste(readUTF8(workbookRelsXML), collapse = "") - workbookRelsXML <- getChildlessNode(xml = workbookRelsXML, tag = "Relationship") - worksheet_rId_mapping <- grep("worksheets/sheet", workbookRelsXML, fixed = TRUE, value = TRUE) - } - - ## - chartSheetRIds <- NULL - if (length(chartSheetsXML) > 0) { - workbookRelsXML <- grep("chartsheets/sheet", workbookRelsXML, fixed = TRUE, value = TRUE) - - chartSheetRIds <- unlist(getId(workbookRelsXML)) - chartsheet_rId_mapping <- unlist(regmatches(workbookRelsXML, gregexpr("sheet[0-9]+\\.xml", workbookRelsXML, perl = TRUE, ignore.case = TRUE))) - - sheetNo <- as.integer(regmatches(chartSheetsXML, regexpr("(?<=sheet)[0-9]+(?=\\.xml)", chartSheetsXML, perl = TRUE))) - chartSheetsXML <- chartSheetsXML[order(sheetNo)] - - chartSheetsRelsXML <- grep("xl/chartsheets/_rels", xmlFiles, perl = TRUE, value = TRUE) - sheetNo2 <- as.integer(regmatches(chartSheetsRelsXML, regexpr("(?<=sheet)[0-9]+(?=\\.xml\\.rels)", chartSheetsRelsXML, perl = TRUE))) - chartSheetsRelsXML <- chartSheetsRelsXML[order(sheetNo2)] - - chartSheetsRelsDir <- dirname(chartSheetsRelsXML[1]) - } - - - ## xl\ - ## xl\workbook - if (length(workbookXML) > 0) { - workbook <- readUTF8(workbookXML) - workbook <- removeHeadTag(workbook) - - sheets <- unlist(regmatches(workbook, gregexpr("(?<=).*(?=)", workbook, perl = TRUE))) - sheets <- unlist(regmatches(sheets, gregexpr("]*>", sheets, perl = TRUE))) - - ## Some veryHidden sheets do not have a sheet content and their rId is empty. - ## Such sheets need to be filtered out because otherwise their sheet names - ## occur in the list of all sheet names, leading to a wrong association - ## of sheet names with sheet indeces. - sheets <- grep('r:id="[[:blank:]]*"', sheets, invert = TRUE, value = TRUE) - - - ## sheetId is meaningless - ## sheet rId links to the workbook.xml.resl which links worksheets/sheet(i).xml file - ## order they appear here gives order of worksheets in xlsx file - - sheetrId <- unlist(getRId(sheets)) - sheetId <- unlist(regmatches(sheets, gregexpr('(?<=sheetId=")[0-9]+', sheets, perl = TRUE))) - sheetNames <- unlist(regmatches(sheets, gregexpr('(?<=name=")[^"]+', sheets, perl = TRUE))) - sheetNames <- replaceXMLEntities(sheetNames) - - - is_chart_sheet <- sheetrId %in% chartSheetRIds - is_visible <- !grepl("hidden", unlist(strsplit(sheets, split = " 0) { - wb$workbook$calcPr <- calcPr - } - - - workbookPr <- getChildlessNode(xml = workbook, tag = "workbookPr") - if (length(workbookPr) > 0) { - wb$workbook$workbookPr <- workbookPr - } - - workbookProtection <- getChildlessNode(xml = workbook, tag = "workbookProtection") - if (length(workbookProtection) > 0) { - wb$workbook$workbookProtection <- workbookProtection - } - - - ## defined Names - dNames <- getNodes(xml = workbook, tagIn = "") - if (length(dNames) > 0) { - dNames <- gsub("^|$", "", dNames) - wb$workbook$definedNames <- paste0(getNodes(xml = dNames, tagIn = "") - } - } - - - - - - ## xl\sharedStrings - if (length(sharedStringsXML) > 0) { - sharedStrings <- readUTF8(sharedStringsXML) - sharedStrings <- paste(sharedStrings, collapse = "\n") - sharedStrings <- removeHeadTag(sharedStrings) - - uniqueCount <- as.integer(regmatches(sharedStrings, regexpr('(?<=uniqueCount=")[0-9]+', sharedStrings, perl = TRUE))) - - ## read in and get nodes - vals <- getNodes(xml = sharedStrings, tagIn = "") - - if ("" %in% vals) { - vals[vals == ""] <- "NA" - Encoding(vals) <- "UTF-8" - attr(vals, "uniqueCount") <- uniqueCount - 1L - } else { - Encoding(vals) <- "UTF-8" - attr(vals, "uniqueCount") <- uniqueCount - } - - wb$sharedStrings <- vals - } - - ## xl\pivotTables & xl\pivotCache - if (length(pivotTableXML) > 0) { - - # pivotTable cacheId links to workbook.xml which links to workbook.xml.rels via rId - # we don't modify the cacheId, only the rId - nPivotTables <- length(pivotDefXML) - rIds <- 20000L + 1:nPivotTables - - ## pivot tables - pivotTableXML <- pivotTableXML[order(nchar(pivotTableXML), pivotTableXML)] - pivotTableRelsXML <- pivotTableRelsXML[order(nchar(pivotTableRelsXML), pivotTableRelsXML)] - - ## Cache - pivotDefXML <- pivotDefXML[order(nchar(pivotDefXML), pivotDefXML)] - pivotDefRelsXML <- pivotDefRelsXML[order(nchar(pivotDefRelsXML), pivotDefRelsXML)] - pivotCacheRecords <- pivotCacheRecords[order(nchar(pivotCacheRecords), pivotCacheRecords)] - - - wb$pivotDefinitionsRels <- character(nPivotTables) - - pivot_content_type <- NULL - - if (length(pivotTableRelsXML) > 0) { - wb$pivotTables.xml.rels <- unlist(lapply(pivotTableRelsXML, function(x) removeHeadTag(cppReadFile(x)))) - } - - - # ## Check what caches are used - cache_keep <- unlist(regmatches(wb$pivotTables.xml.rels, gregexpr("(?<=pivotCache/pivotCacheDefinition)[0-9](?=\\.xml)", - wb$pivotTables.xml.rels, - perl = TRUE, ignore.case = TRUE - ))) - - ## pivot cache records - tmp <- unlist(regmatches(pivotCacheRecords, gregexpr("(?<=pivotCache/pivotCacheRecords)[0-9]+(?=\\.xml)", pivotCacheRecords, perl = TRUE, ignore.case = TRUE))) - pivotCacheRecords <- pivotCacheRecords[tmp %in% cache_keep] - - ## pivot cache definitions rels - tmp <- unlist(regmatches(pivotDefRelsXML, gregexpr("(?<=_rels/pivotCacheDefinition)[0-9]+(?=\\.xml)", pivotDefRelsXML, perl = TRUE, ignore.case = TRUE))) - pivotDefRelsXML <- pivotDefRelsXML[tmp %in% cache_keep] - - ## pivot cache definitions - tmp <- unlist(regmatches(pivotDefXML, gregexpr("(?<=pivotCache/pivotCacheDefinition)[0-9]+(?=\\.xml)", pivotDefXML, perl = TRUE, ignore.case = TRUE))) - pivotDefXML <- pivotDefXML[tmp %in% cache_keep] - - - - if (length(pivotTableXML) > 0) { - wb$pivotTables[seq_along(pivotTableXML)] <- pivotTableXML - pivot_content_type <- c( - pivot_content_type, - sprintf('', seq_along(pivotTableXML)) - ) - } - - if (length(pivotDefXML) > 0) { - wb$pivotDefinitions[seq_along(pivotDefXML)] <- pivotDefXML - pivot_content_type <- c( - pivot_content_type, - sprintf('', seq_along(pivotDefXML)) - ) - } - - if (length(pivotCacheRecords) > 0) { - wb$pivotRecords[seq_along(pivotCacheRecords)] <- pivotCacheRecords - pivot_content_type <- c( - pivot_content_type, - sprintf('', seq_along(pivotCacheRecords)) - ) - } - - if (length(pivotDefRelsXML) > 0) { - wb$pivotDefinitionsRels[seq_along(pivotDefRelsXML)] <- pivotDefRelsXML - } - - - - - ## update content_types - wb$Content_Types <- c(wb$Content_Types, pivot_content_type) - - - ## workbook rels - wb$workbook.xml.rels <- c( - wb$workbook.xml.rels, - sprintf('', rIds, seq_along(pivotDefXML)) - ) - - - caches <- getNodes(xml = workbook, tagIn = "") - caches <- getChildlessNode(xml = caches, tag = "pivotCache") - for (i in seq_along(caches)) { - caches[i] <- gsub('"rId[0-9]+"', sprintf('"rId%s"', rIds[i]), caches[i]) - } - - wb$workbook$pivotCaches <- paste0("", paste(caches, collapse = ""), "") - } - - ## xl\vbaProject - if (length(vbaProject) > 0) { - wb$vbaProject <- vbaProject - wb$Content_Types[grepl('' - wb$Content_Types <- c(wb$Content_Types, '') - } - - - ## xl\styles - if (length(stylesXML) > 0) { - styleObjects <- wb$loadStyles(stylesXML) - } else { - styleObjects <- list() - } - - ## xl\media - if (length(media) > 0) { - mediaNames <- regmatches(media, regexpr("image[0-9]+\\.[a-z]+$", media)) - fileTypes <- unique(gsub("image[0-9]+\\.", "", mediaNames)) - - contentNodes <- sprintf('', fileTypes, fileTypes) - contentNodes[fileTypes == "emf"] <- '' - - wb$Content_Types <- c(contentNodes, wb$Content_Types) - names(media) <- mediaNames - wb$media <- media - } - - - - ## xl\chart - if (length(charts) > 0) { - chartNames <- basename(charts) - nCharts <- sum(grepl("chart[0-9]+.xml", chartNames)) - nChartStyles <- sum(grepl("style[0-9]+.xml", chartNames)) - nChartCol <- sum(grepl("colors[0-9]+.xml", chartNames)) - - if (nCharts > 0) { - wb$Content_Types <- c(wb$Content_Types, sprintf('', 1:nCharts)) - } - - if (nChartStyles > 0) { - wb$Content_Types <- c(wb$Content_Types, sprintf('', 1:nChartStyles)) - } - - if (nChartCol > 0) { - wb$Content_Types <- c(wb$Content_Types, sprintf('', 1:nChartCol)) - } - - if (length(chartsRels)) { - charts <- c(charts, chartsRels) - chartNames <- c(chartNames, file.path("_rels", basename(chartsRels))) - } - - names(charts) <- chartNames - wb$charts <- charts - } - - - - - - - ## xl\theme - if (length(themeXML) > 0) { - wb$theme <- removeHeadTag(paste(unlist(lapply(sort(themeXML)[[1]], readUTF8)), collapse = "")) - } - - - ## externalLinks - if (length(extLinksXML) > 0) { - wb$externalLinks <- lapply(sort(extLinksXML), function(x) removeHeadTag(cppReadFile(x))) - - wb$Content_Types <- c( - wb$Content_Types, - sprintf('', seq_along(extLinksXML)) - ) - - wb$workbook.xml.rels <- c(wb$workbook.xml.rels, sprintf( - '', - seq_along(extLinksXML) - )) - } - - ## externalLinksRels - if (length(extLinksRelsXML) > 0) { - wb$externalLinksRels <- lapply(sort(extLinksRelsXML), function(x) removeHeadTag(cppReadFile(x))) - } - - - - - - - - ##* ----------------------------------------------------------------------------------------------*## - ### BEGIN READING IN WORKSHEET DATA - ##* ----------------------------------------------------------------------------------------------*## - - ## xl\worksheets - file_names <- regmatches(worksheet_rId_mapping, regexpr("sheet[0-9]+\\.xml", worksheet_rId_mapping, perl = TRUE)) - file_rIds <- unlist(getId(worksheet_rId_mapping)) - file_names <- file_names[match(sheetrId, file_rIds)] - - worksheetsXML <- file.path(dirname(worksheetsXML), file_names) - wb <- loadworksheets(wb = wb, styleObjects = styleObjects, xmlFiles = worksheetsXML, is_chart_sheet = is_chart_sheet) - - ## Fix styleobject encoding - if (length(wb$styleObjects) > 0) { - style_names <- sapply(wb$styleObjects, "[[", "sheet") - Encoding(style_names) <- "UTF-8" - wb$styleObjects <- lapply(seq_along(style_names), function(i) { - wb$styleObjects[[i]]$sheet <- style_names[[i]] - wb$styleObjects[[i]] - }) - } - - - ## Fix headers/footers - for (i in seq_along(worksheetsXML)) { - if (!is_chart_sheet[i]) { - if (length(wb$worksheets[[i]]$headerFooter) > 0) { - wb$worksheets[[i]]$headerFooter <- lapply(wb$worksheets[[i]]$headerFooter, splitHeaderFooter) - } - } - } - - - ##* ----------------------------------------------------------------------------------------------*## - ### READING IN WORKSHEET DATA COMPLETE - ##* ----------------------------------------------------------------------------------------------*## - - - ## Next sheetRels to see which drawings_rels belongs to which sheet - if (length(sheetRelsXML) > 0) { - - ## sheetrId is order sheet appears in xlsx file - ## create a 1-1 vector of rels to worksheet - ## haveRels is boolean vector where i-the element is TRUE/FALSE if sheet has a rels sheet - - if (length(chartSheetsXML) == 0) { - allRels <- file.path(dirname(sheetRelsXML[1]), paste0(file_names, ".rels")) - haveRels <- allRels %in% sheetRelsXML - } else { - haveRels <- rep(FALSE, length(wb$worksheets)) - allRels <- rep("", length(wb$worksheets)) - - for (i in 1:nSheets) { - if (is_chart_sheet[i]) { - ind <- which(chartSheetRIds == sheetrId[i]) - rels_file <- file.path(chartSheetsRelsDir, paste0(chartsheet_rId_mapping[ind], ".rels")) - } else { - ind <- sheetrId[i] - rels_file <- file.path(xmlDir, "xl", "worksheets", "_rels", paste0(file_names[i], ".rels")) - } - if (file.exists(rels_file)) { - allRels[i] <- rels_file - haveRels[i] <- TRUE - } - } - } - - ## sheet.xml have been reordered to be in the order of sheetrId - ## not every sheet has a worksheet rels - - xml <- lapply(seq_along(allRels), function(i) { - if (haveRels[i]) { - xml <- readUTF8(allRels[[i]]) - xml <- removeHeadTag(xml) - xml <- gsub("", "", xml) - xml <- gsub("", "", xml) - xml <- getChildlessNode(xml = xml, tag = "Relationship") - } else { - xml <- "" - } - return(xml) - }) - - - - - - ## Slicers ------------------------------------------------------------------------------------- - - - - if (length(slicerXML) > 0) { - slicerXML <- slicerXML[order(nchar(slicerXML), slicerXML)] - slicersFiles <- lapply(xml, function(x) as.integer(regmatches(x, regexpr("(?<=slicer)[0-9]+(?=\\.xml)", x, perl = TRUE)))) - inds <- sapply(slicersFiles, length) > 0 - - - ## worksheet_rels Id for slicer will be rId0 - k <- 1L - wb$slicers <- rep("", nSheets) - for (i in 1:nSheets) { - - ## read in slicer[j].XML sheets into sheet[i] - if (inds[i]) { - wb$slicers[[i]] <- slicerXML[k] - k <- k + 1L - - wb$worksheets_rels[[i]] <- unlist(c( - wb$worksheets_rels[[i]], - sprintf('', i) - )) - wb$Content_Types <- c( - wb$Content_Types, - sprintf('', i) - ) - - slicer_xml_exists <- FALSE - ## Append slicer to worksheet extLst - - if (length(wb$worksheets[[i]]$extLst) > 0) { - if (grepl('x14:slicer r:id="rId[0-9]+"', wb$worksheets[[i]]$extLst)) { - wb$worksheets[[i]]$extLst <- sub('x14:slicer r:id="rId[0-9]+"', 'x14:slicer r:id="rId0"', wb$worksheets[[i]]$extLst) - slicer_xml_exists <- TRUE - } - } - - if (!slicer_xml_exists) { - wb$worksheets[[i]]$extLst <- c(wb$worksheets[[i]]$extLst, genBaseSlicerXML()) - } - } - } - } - - - if (length(slicerCachesXML) > 0) { - - ## ---- slicerCaches - inds <- seq_along(slicerCachesXML) - wb$Content_Types <- c(wb$Content_Types, sprintf('', inds)) - wb$slicerCaches <- sapply(slicerCachesXML[order(nchar(slicerCachesXML), slicerCachesXML)], function(x) removeHeadTag(cppReadFile(x))) - wb$workbook.xml.rels <- c(wb$workbook.xml.rels, sprintf('', 1E5 + inds, inds)) - wb$workbook$extLst <- c(wb$workbook$extLst, genSlicerCachesExtLst(1E5 + inds)) - } - - - ## Tables -------------------------------------------------------------------------------------- - - - - if (length(tablesXML) > 0) { - tables <- lapply(xml, function(x) as.integer(regmatches(x, regexpr("(?<=table)[0-9]+(?=\\.xml)", x, perl = TRUE)))) - tableSheets <- unlist(lapply(seq_along(sheetrId), function(i) rep(i, length(tables[[i]])))) - - if (length(unlist(tables)) > 0) { - ## get the tables that belong to each worksheet and create a worksheets_rels for each - tCount <- 2L ## table r:Ids start at 3 - for (i in seq_along(tables)) { - if (length(tables[[i]]) > 0) { - k <- seq_along(tables[[i]]) + tCount - wb$worksheets_rels[[i]] <- unlist(c( - wb$worksheets_rels[[i]], - sprintf('', k, k) - )) - - - wb$worksheets[[i]]$tableParts <- sprintf("", k) - tCount <- tCount + length(k) - } - } - - ## sort the tables into the order they appear in the xml and tables variables - names(tablesXML) <- basename(tablesXML) - tablesXML <- tablesXML[sprintf("table%s.xml", unlist(tables))] - - ## tables are now in correct order so we can read them in as they are - wb$tables <- sapply(tablesXML, function(x) removeHeadTag(paste(readUTF8(x), collapse = ""))) - - ## pull out refs and attach names - refs <- regmatches(wb$tables, regexpr('(?<=ref=")[0-9A-Z:]+', wb$tables, perl = TRUE)) - names(wb$tables) <- refs - - wb$Content_Types <- c(wb$Content_Types, sprintf('', seq_along(wb$tables) + 2)) - - ## relabel ids - for (i in seq_along(wb$tables)) { - newId <- sprintf(' id="%s" ', i + 2) - wb$tables[[i]] <- sub(' id="[0-9]+" ', newId, wb$tables[[i]]) - } - - displayNames <- unlist(regmatches(wb$tables, regexpr('(?<=displayName=").*?[^"]+', wb$tables, perl = TRUE))) - if (length(displayNames) != length(tablesXML)) { - displayNames <- paste0("Table", seq_along(tablesXML)) - } - - attr(wb$tables, "sheet") <- tableSheets - attr(wb$tables, "tableName") <- displayNames - - for (i in seq_along(tableSheets)) { - table_sheet_i <- tableSheets[i] - attr(wb$worksheets[[table_sheet_i]]$tableParts, "tableName") <- c(attr(wb$worksheets[[table_sheet_i]]$tableParts, "tableName"), displayNames[i]) - } - } - } ## if(length(tablesXML) > 0) - - ## might we have some external hyperlinks - if (any(sapply(wb$worksheets[!is_chart_sheet], function(x) length(x$hyperlinks) > 0))) { - - ## Do we have external hyperlinks - hlinks <- lapply(xml, function(x) x[grepl("hyperlink", x) & grepl("External", x)]) - hlinksInds <- which(sapply(hlinks, length) > 0) - - ## If it's an external hyperlink it will have a target in the sheet_rels - if (length(hlinksInds) > 0) { - for (i in hlinksInds) { - ids <- unlist(lapply(hlinks[[i]], function(x) regmatches(x, gregexpr('(?<=Id=").*?"', x, perl = TRUE))[[1]])) - ids <- gsub('"$', "", ids) - - targets <- unlist(lapply(hlinks[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) - targets <- gsub('"$', "", targets) - - ids2 <- lapply(wb$worksheets[[i]]$hyperlinks, function(x) regmatches(x, gregexpr('(?<=r:id=").*?"', x, perl = TRUE))[[1]]) - ids2[sapply(ids2, length) == 0] <- NA - ids2 <- gsub('"$', "", unlist(ids2)) - - targets <- targets[match(ids2, ids)] - names(wb$worksheets[[i]]$hyperlinks) <- targets - } - } - } - - - - ## Drawings ------------------------------------------------------------------------------------ - - - - ## xml is in the order of the sheets, drawIngs is toes to sheet position of hasDrawing - ## Not every sheet has a drawing.xml - - - drawXMLrelationship <- lapply(xml, function(x) grep("drawings/drawing", x, value = TRUE)) - hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing - - if (length(drawingRelsXML) > 0) { - dRels <- lapply(drawingRelsXML, readUTF8) - dRels <- unlist(lapply(dRels, removeHeadTag)) - dRels <- gsub("", "", dRels) - dRels <- gsub("", "", dRels) - } - - if (length(drawingsXML) > 0) { - dXML <- lapply(drawingsXML, readUTF8) - dXML <- unlist(lapply(dXML, removeHeadTag)) - dXML <- gsub("", "", dXML) - dXML <- gsub("", "", dXML) - - # ptn1 <- "<(mc:AlternateContent|xdr:oneCellAnchor|xdr:twoCellAnchor|xdr:absoluteAnchor)" - # ptn2 <- "" - - ## split at one/two cell Anchor - # dXML <- regmatches(dXML, gregexpr(paste0(ptn1, ".*?", ptn2), dXML)) - } - - - ## loop over all worksheets and assign drawing to sheet - if (any(hasDrawing)) { - for (i in seq_along(xml)) { - if (hasDrawing[i]) { - target <- unlist(lapply(drawXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) - target <- basename(gsub('"$', "", target)) - - ## sheet_i has which(hasDrawing)[[i]] - relsInd <- grepl(target, drawingRelsXML) - if (any(relsInd)) { - wb$drawings_rels[i] <- dRels[relsInd] - } - - drawingInd <- grepl(target, drawingsXML) - if (any(drawingInd)) { - wb$drawings[i] <- dXML[drawingInd] - } - } - } - } - - - - - ## VML Drawings -------------------------------------------------------------------------------- - - - if (length(vmlDrawingXML) > 0) { - wb$Content_Types <- c(wb$Content_Types, '') - - drawXMLrelationship <- lapply(xml, function(x) grep("drawings/vmlDrawing", x, value = TRUE)) - hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing - - ## loop over all worksheets and assign drawing to sheet - if (any(hasDrawing)) { - for (i in seq_along(xml)) { - if (hasDrawing[i]) { - target <- unlist(lapply(drawXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) - target <- basename(gsub('"$', "", target)) - ind <- grepl(target, vmlDrawingXML) - - if (any(ind)) { - txt <- paste(readUTF8(vmlDrawingXML[ind]), collapse = "\n") - txt <- removeHeadTag(txt) - - i1 <- regexpr("", txt, fixed = TRUE) - - wb$vml[[i]] <- substring(text = txt, first = i1, last = (i2 - 1L)) - - relsInd <- grepl(target, vmlDrawingRelsXML) - if (any(relsInd)) { - wb$vml_rels[i] <- vmlDrawingRelsXML[relsInd] - } - } - } - } - } - } - - - - - - - - ## vmlDrawing and comments - if (length(commentsXML) > 0) { - drawXMLrelationship <- lapply(xml, function(x) grep("drawings/vmlDrawing[0-9]+\\.vml", x, value = TRUE)) - hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing - - commentXMLrelationship <- lapply(xml, function(x) grep("comments[0-9]+\\.xml", x, value = TRUE)) - hasComment <- sapply(commentXMLrelationship, length) > 0 ## which sheets have a comment - - for (i in seq_along(xml)) { - if (hasComment[i]) { - target <- unlist(lapply(drawXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) - target <- basename(gsub('"$', "", target)) - ind <- grepl(target, vmlDrawingXML) - - if (any(ind)) { - txt <- paste(readUTF8(vmlDrawingXML[ind]), collapse = "\n") - txt <- removeHeadTag(txt) - - cd <- unique(getNodes(xml = txt, tagIn = "") - - ## now loada comment - target <- unlist(lapply(commentXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) - target <- basename(gsub('"$', "", target)) - - txt <- paste(readUTF8(grep(target, commentsXML, value = TRUE)), collapse = "\n") - txt <- removeHeadTag(txt) - - authors <- getNodes(xml = txt, tagIn = "") - authors <- gsub("|", "", authors) - - comments <- getNodes(xml = txt, tagIn = "") - comments <- gsub("", "", comments) - comments <- getNodes(xml = comments, tagIn = "))[\\s\\S]+?(?=)", comments, perl = TRUE)) - comments <- lapply(comments, function(x) gsub(".*?>", "", x, perl = TRUE)) - - - wb$comments[[i]] <- lapply(seq_along(comments), function(j) { - comment_list <- list( - "ref" = refs[j], - "author" = authors[j], - "comment" = comments[[j]], - "style" = style[[j]], - "clientData" = cd[[j]] - ) - }) - } - } - } - } - - ## Threaded comments - if (length(threadCommentsXML) > 0) { - threadCommentsXMLrelationship <- lapply(xml, function(x) grep("threadedComment[0-9]+\\.xml", x, value = TRUE)) - hasThreadComments<- sapply(threadCommentsXMLrelationship, length) > 0 - if(any(hasThreadComments)) { - for (i in seq_along(xml)) { - if (hasThreadComments[i]) { - target <- unlist(lapply(threadCommentsXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) - target <- basename(gsub('"$', "", target)) - - wb$threadComments[[i]] <- grep(target, threadCommentsXML, value = TRUE) - - } - } - } - wb$Content_Types <- c( - wb$Content_Types, - sprintf('', - sapply(threadCommentsXML, basename)) - ) - } - - ## Persons (needed for Threaded Comment) - if(length(personXML) > 0){ - wb$persons <- personXML - wb$Content_Types <- c( - wb$Content_Types, - '' - ) - wb$workbook.xml.rels <- c( - wb$workbook.xml.rels, - '') - } - - - ## rels image - drawXMLrelationship <- lapply(xml, function(x) grep("relationships/image", x, value = TRUE)) - hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing - if (any(hasDrawing)) { - for (i in seq_along(xml)) { - if (hasDrawing[i]) { - image_ids <- unlist(getId(drawXMLrelationship[[i]])) - new_image_ids <- paste0("rId", seq_along(image_ids) + 70000) - for (j in seq_along(image_ids)) { - wb$worksheets[[i]]$oleObjects <- gsub(image_ids[j], new_image_ids[j], wb$worksheets[[i]]$oleObjects, fixed = TRUE) - wb$worksheets_rels[[i]] <- c(wb$worksheets_rels[[i]], gsub(image_ids[j], new_image_ids[j], drawXMLrelationship[[i]][j], fixed = TRUE)) - } - } - } - } - - ## rels image - drawXMLrelationship <- lapply(xml, function(x) grep("relationships/package", x, value = TRUE)) - hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing - if (any(hasDrawing)) { - for (i in seq_along(xml)) { - if (hasDrawing[i]) { - image_ids <- unlist(getId(drawXMLrelationship[[i]])) - new_image_ids <- paste0("rId", seq_along(image_ids) + 90000) - for (j in seq_along(image_ids)) { - wb$worksheets[[i]]$oleObjects <- gsub(image_ids[j], new_image_ids[j], wb$worksheets[[i]]$oleObjects, fixed = TRUE) - wb$worksheets_rels[[i]] <- c( - wb$worksheets_rels[[i]], - sprintf("", new_image_ids[j]) - ) - } - } - } - } - - - - ## Embedded docx - if (length(embeddings) > 0) { - wb$Content_Types <- c(wb$Content_Types, '') - wb$embeddings <- embeddings - } - - - - ## pivot tables - if (length(pivotTableXML) > 0) { - # pivotTableJ <- lapply(xml, function(x) as.integer(regmatches(x, regexpr("(?<=pivotTable)[0-9]+(?=\\.xml)", x, perl = TRUE)))) variable not used - # sheetWithPivot <- which(sapply(pivotTableJ, length) > 0) variable not used - - pivotRels <- lapply(xml, function(x) { - y <- grep("pivotTable", x, value = TRUE) - y[order(nchar(y), y)] - }) - hasPivot <- sapply(pivotRels, length) > 0 - - ## Modify rIds - for (i in seq_along(pivotRels)) { - if (hasPivot[i]) { - for (j in seq_along(pivotRels[[i]])) { - pivotRels[[i]][j] <- gsub('"rId[0-9]+"', sprintf('"rId%s"', 20000L + j), pivotRels[[i]][j]) - } - - wb$worksheets_rels[[i]] <- c(wb$worksheets_rels[[i]], pivotRels[[i]]) - } - } - - - ## remove any workbook_res references to pivot tables that are not being used in worksheet_rels - inds <- seq_along(wb$pivotTables.xml.rels) - fileNo <- as.integer(unlist(regmatches(unlist(wb$worksheets_rels), gregexpr("(?<=pivotTable)[0-9]+(?=\\.xml)", unlist(wb$worksheets_rels), perl = TRUE)))) - inds <- inds[!inds %in% fileNo] - - if (length(inds) > 0) { - toRemove <- paste(sprintf("(pivotCacheDefinition%s\\.xml)", inds), collapse = "|") - fileNo <- grep(toRemove, wb$pivotTables.xml.rels) - toRemove <- paste(sprintf("(pivotCacheDefinition%s\\.xml)", fileNo), collapse = "|") - - ## remove reference to file from workbook.xml.res - wb$workbook.xml.rels <- wb$workbook.xml.rels[!grepl(toRemove, wb$workbook.xml.rels)] - } - } - } ## end of worksheetRels - - ## convert hyperliks to hyperlink objects - for (i in 1:nSheets) { - wb$worksheets[[i]]$hyperlinks <- xml_to_hyperlink(wb$worksheets[[i]]$hyperlinks) - } - - - - ## queryTables - if (length(queryTablesXML) > 0) { - ids <- as.numeric(regmatches(queryTablesXML, regexpr("[0-9]+(?=\\.xml)", queryTablesXML, perl = TRUE))) - wb$queryTables <- unlist(lapply(queryTablesXML[order(ids)], function(x) removeHeadTag(cppReadFile(xmlFile = x)))) - wb$Content_Types <- c( - wb$Content_Types, - sprintf('', seq_along(queryTablesXML)) - ) - } - - - ## connections - if (length(connectionsXML) > 0) { - wb$connections <- removeHeadTag(cppReadFile(xmlFile = connectionsXML)) - wb$workbook.xml.rels <- c(wb$workbook.xml.rels, '') - wb$Content_Types <- c(wb$Content_Types, '') - } - - - - - ## table rels - if (length(tableRelsXML) > 0) { - - ## table_i_might have tableRels_i but I am re-ordering the tables to be in order of worksheets - ## I make every table have a table_rels so i need to fill in the gaps if any table_rels are missing - - tmp <- paste0(basename(tablesXML), ".rels") - hasRels <- tmp %in% basename(tableRelsXML) - - ## order tableRelsXML - tableRelsXML <- tableRelsXML[match(tmp[hasRels], basename(tableRelsXML))] - - ## - wb$tables.xml.rels <- character(length = length(tablesXML)) - - ## which sheet does it belong to - xml <- sapply(tableRelsXML, cppReadFile, USE.NAMES = FALSE) - xml <- sapply(xml, removeHeadTag, USE.NAMES = FALSE) - - wb$tables.xml.rels[hasRels] <- xml - } else if (length(tablesXML) > 0) { - wb$tables.xml.rels <- rep("", length(tablesXML)) - } - - - activesheet <- unlist(regmatches(workbook, gregexpr("(?<=).*(?=)", workbook, perl = TRUE))) - activesheet <- unlist(regmatches(activesheet, gregexpr("]*>", activesheet, perl = TRUE))) - - wb$ActiveSheet <- as.integer(getAttrs(activesheet,"activeTab")$activeTab) + 1L - - if(length(wb$ActiveSheet) == 0){ - wb$ActiveSheet <- 1L - } - - return(wb) -} + + + +#' @name loadWorkbook +#' @title Load an existing .xlsx file +#' @author Alexander Walker, Philipp Schauberger +#' @param file A path to an existing .xlsx or .xlsm file +#' @param xlsxFile alias for file +#' @param isUnzipped Set to TRUE if the xlsx file is already unzipped +#' @description loadWorkbook returns a workbook object conserving styles and +#' formatting of the original .xlsx file. +#' @return Workbook object. +#' @export +#' @seealso [removeWorksheet()] +#' @examples +#' ## load existing workbook from package folder +#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +#' names(wb) # list worksheets +#' wb ## view object +#' ## Add a worksheet +#' addWorksheet(wb, "A new worksheet") +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "loadExample.xlsx", overwrite = TRUE) +#' } +#' +loadWorkbook <- function(file, xlsxFile = NULL, isUnzipped = FALSE) { + + ## If this is a unzipped workbook, skip the temp dir stuff + if (isUnzipped) { + xmlDir <- file + xmlFiles <- list.files(path = xmlDir, full.names = TRUE, recursive = TRUE, all.files = TRUE) + } else { + if (!is.null(xlsxFile)) { + file <- xlsxFile + } + + file <- getFile(file) + if (!file.exists(file)) { + stop("File does not exist.") + } + + ## create temp dir + xmlDir <- tempfile() + + ## Unzip files to temp directory + xmlFiles <- unzip(file, exdir = xmlDir) + } + wb <- createWorkbook() + + ## Not used + # .relsXML <- xmlFiles[grepl("_rels/.rels$", xmlFiles, perl = TRUE)] + # appXML <- xmlFiles[grepl("app.xml$", xmlFiles, perl = TRUE)] + + drawingsXML <- grep("drawings/drawing[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + worksheetsXML <- grep("/worksheets/sheet[0-9]+", xmlFiles, perl = TRUE, value = TRUE) + + coreXML <- grep("core.xml$", xmlFiles, perl = TRUE, value = TRUE) + workbookXML <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) + stylesXML <- grep("styles.xml$", xmlFiles, perl = TRUE, value = TRUE) + sharedStringsXML <- grep("sharedStrings.xml$", xmlFiles, perl = TRUE, value = TRUE) + themeXML <- grep("theme[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + drawingRelsXML <- grep("drawing[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + sheetRelsXML <- grep("sheet[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + media <- grep("image[0-9]+.[a-z]+$", xmlFiles, perl = TRUE, value = TRUE) + vmlDrawingXML <- grep("drawings/vmlDrawing[0-9]+\\.vml$", xmlFiles, perl = TRUE, value = TRUE) + vmlDrawingRelsXML <- grep("vmlDrawing[0-9]+.vml.rels$", xmlFiles, perl = TRUE, value = TRUE) + commentsXML <- grep("xl/comments[0-9]+\\.xml", xmlFiles, perl = TRUE, value = TRUE) + threadCommentsXML <- grep("xl/threadedComments/threadedComment[0-9]+\\.xml", xmlFiles, perl = TRUE, value = TRUE) + personXML <- grep("xl/persons/person.xml$", xmlFiles, perl = TRUE, value = TRUE) + embeddings <- grep("xl/embeddings", xmlFiles, perl = TRUE, value = TRUE) + charts <- grep("xl/charts/.*xml$", xmlFiles, perl = TRUE, value = TRUE) + chartsRels <- grep("xl/charts/_rels", xmlFiles, perl = TRUE, value = TRUE) + chartSheetsXML <- grep("xl/chartsheets/sheet[0-9]+\\.xml", xmlFiles, perl = TRUE, value = TRUE) + tablesXML <- grep("tables/table[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + tableRelsXML <- grep("table[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + queryTablesXML <- grep("queryTable[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + connectionsXML <- grep("connections.xml$", xmlFiles, perl = TRUE, value = TRUE) + extLinksXML <- grep("externalLink[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + extLinksRelsXML <- grep("externalLink[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + + + # pivot tables + pivotTableXML <- grep("pivotTable[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + pivotTableRelsXML <- grep("pivotTable[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + pivotDefXML <- grep("pivotCacheDefinition[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + pivotDefRelsXML <- grep("pivotCacheDefinition[0-9]+.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + pivotCacheRecords <- grep("pivotCacheRecords[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + + ## slicers + slicerXML <- grep("slicer[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + slicerCachesXML <- grep("slicerCache[0-9]+.xml$", xmlFiles, perl = TRUE, value = TRUE) + + ## VBA Macro + vbaProject <- grep("vbaProject\\.bin$", xmlFiles, perl = TRUE, value = TRUE) + + ## remove all EXCEPT media and charts + if (!isUnzipped) { + on.exit({ + paths <- grep( + "charts|media|vmlDrawing|comment|embeddings|pivot|slicer|vbaProject|person", + xmlFiles, + ignore.case = TRUE, + value = TRUE, + invert = TRUE + ) + unlink(paths, recursive = TRUE, force = TRUE) + }, + add = TRUE + ) +} + + ## core + if (length(coreXML) == 1) { + coreXML <- paste(readUTF8(coreXML), collapse = "") + wb$core <- removeHeadTag(x = coreXML) + } + + nSheets <- length(worksheetsXML) + length(chartSheetsXML) + + ## get Rid of chartsheets, these do not have a worksheet/sheeti.xml + worksheet_rId_mapping <- NULL + workbookRelsXML <- grep("workbook.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + if (length(workbookRelsXML) > 0) { + workbookRelsXML <- paste(readUTF8(workbookRelsXML), collapse = "") + workbookRelsXML <- getChildlessNode(xml = workbookRelsXML, tag = "Relationship") + worksheet_rId_mapping <- grep("worksheets/sheet", workbookRelsXML, fixed = TRUE, value = TRUE) + } + + ## + chartSheetRIds <- NULL + if (length(chartSheetsXML) > 0) { + workbookRelsXML <- grep("chartsheets/sheet", workbookRelsXML, fixed = TRUE, value = TRUE) + + chartSheetRIds <- unlist(getId(workbookRelsXML)) + chartsheet_rId_mapping <- unlist(regmatches(workbookRelsXML, gregexpr("sheet[0-9]+\\.xml", workbookRelsXML, perl = TRUE, ignore.case = TRUE))) + + sheetNo <- as.integer(regmatches(chartSheetsXML, regexpr("(?<=sheet)[0-9]+(?=\\.xml)", chartSheetsXML, perl = TRUE))) + chartSheetsXML <- chartSheetsXML[order(sheetNo)] + + chartSheetsRelsXML <- grep("xl/chartsheets/_rels", xmlFiles, perl = TRUE, value = TRUE) + sheetNo2 <- as.integer(regmatches(chartSheetsRelsXML, regexpr("(?<=sheet)[0-9]+(?=\\.xml\\.rels)", chartSheetsRelsXML, perl = TRUE))) + chartSheetsRelsXML <- chartSheetsRelsXML[order(sheetNo2)] + + chartSheetsRelsDir <- dirname(chartSheetsRelsXML[1]) + } + + + ## xl\ + ## xl\workbook + if (length(workbookXML) > 0) { + workbook <- readUTF8(workbookXML) + workbook <- removeHeadTag(workbook) + + sheets <- unlist(regmatches(workbook, gregexpr("(?<=).*(?=)", workbook, perl = TRUE))) + sheets <- unlist(regmatches(sheets, gregexpr("]*>", sheets, perl = TRUE))) + + ## Some veryHidden sheets do not have a sheet content and their rId is empty. + ## Such sheets need to be filtered out because otherwise their sheet names + ## occur in the list of all sheet names, leading to a wrong association + ## of sheet names with sheet indeces. + sheets <- grep('r:id="[[:blank:]]*"', sheets, invert = TRUE, value = TRUE) + + + ## sheetId is meaningless + ## sheet rId links to the workbook.xml.resl which links worksheets/sheet(i).xml file + ## order they appear here gives order of worksheets in xlsx file + + sheetrId <- unlist(getRId(sheets)) + sheetId <- unlist(regmatches(sheets, gregexpr('(?<=sheetId=")[0-9]+', sheets, perl = TRUE))) + sheetNames <- unlist(regmatches(sheets, gregexpr('(?<=name=")[^"]+', sheets, perl = TRUE))) + sheetNames <- replaceXMLEntities(sheetNames) + + + is_chart_sheet <- sheetrId %in% chartSheetRIds + is_visible <- !grepl("hidden", sheets) + if (length(is_visible) != length(sheetrId)) { + is_visible <- rep(TRUE, length(sheetrId)) + } + + +# #active sheet ----------------------------------------------------------- + + + + + ## add worksheets to wb + j <- 1 + for (i in seq_along(sheetrId)) { + if (is_chart_sheet[i]) { + # count <- 0 variable not used + txt <- paste(readUTF8(chartSheetsXML[j]), collapse = "") + + zoom <- regmatches(txt, regexpr('(?<=zoomScale=")[0-9]+', txt, perl = TRUE)) + if (length(zoom) == 0) { + zoom <- 100 + } + + tabColour <- getChildlessNode(xml = txt, tag = "tabColor") + if (length(tabColour) == 0) { + tabColour <- NULL + } + + j <- j + 1L + + wb$addChartSheet(sheetName = sheetNames[i], tabColour = tabColour, zoom = as.numeric(zoom)) + } else { + wb$addWorksheet(sheetNames[i], visible = is_visible[i]) + } + } + + + ## replace sheetId + for (i in 1:nSheets) { + wb$workbook$sheets[[i]] <- gsub(sprintf(' sheetId="%s"', i), sprintf(' sheetId="%s"', sheetId[i]), wb$workbook$sheets[[i]]) + } + + + ## additional workbook attributes + calcPr <- getChildlessNode(xml = workbook, tag = "calcPr") + if (length(calcPr) > 0) { + wb$workbook$calcPr <- calcPr + } + + ## additional workbook attributes + extLst <- getChildlessNode(xml = workbook, tag = "extLst") + if (length(extLst) > 0) { + wb$workbook$extLst <- extLst + } + + workbookPr <- getChildlessNode(xml = workbook, tag = "workbookPr") + if (length(workbookPr) > 0) { + wb$workbook$workbookPr <- workbookPr + } + + workbookProtection <- getChildlessNode(xml = workbook, tag = "workbookProtection") + if (length(workbookProtection) > 0) { + wb$workbook$workbookProtection <- workbookProtection + } + + + ## defined Names + dNames <- getNodes(xml = workbook, tagIn = "") + if (length(dNames) > 0) { + dNames <- gsub("^|$", "", dNames) + wb$workbook$definedNames <- paste0(getNodes(xml = dNames, tagIn = "") + } + } + + + + + + ## xl\sharedStrings + if (length(sharedStringsXML) > 0) { + sharedStrings <- readUTF8(sharedStringsXML) + sharedStrings <- paste(sharedStrings, collapse = "\n") + sharedStrings <- removeHeadTag(sharedStrings) + + uniqueCount <- as.integer(regmatches(sharedStrings, regexpr('(?<=uniqueCount=")[0-9]+', sharedStrings, perl = TRUE))) + + ## read in and get nodes + vals <- getNodes(xml = sharedStrings, tagIn = "") + + if ("" %in% vals) { + vals[vals == ""] <- "NA" + Encoding(vals) <- "UTF-8" + attr(vals, "uniqueCount") <- uniqueCount - 1L + } else { + Encoding(vals) <- "UTF-8" + attr(vals, "uniqueCount") <- uniqueCount + } + + wb$sharedStrings <- vals + } + + ## xl\pivotTables & xl\pivotCache + if (length(pivotTableXML) > 0) { + + # pivotTable cacheId links to workbook.xml which links to workbook.xml.rels via rId + # we don't modify the cacheId, only the rId + nPivotTables <- length(pivotDefXML) + rIds <- 20000L + 1:nPivotTables + + ## pivot tables + pivotTableXML <- pivotTableXML[order(nchar(pivotTableXML), pivotTableXML)] + pivotTableRelsXML <- pivotTableRelsXML[order(nchar(pivotTableRelsXML), pivotTableRelsXML)] + + ## Cache + pivotDefXML <- pivotDefXML[order(nchar(pivotDefXML), pivotDefXML)] + pivotDefRelsXML <- pivotDefRelsXML[order(nchar(pivotDefRelsXML), pivotDefRelsXML)] + pivotCacheRecords <- pivotCacheRecords[order(nchar(pivotCacheRecords), pivotCacheRecords)] + + + wb$pivotDefinitionsRels <- character(nPivotTables) + + pivot_content_type <- NULL + + if (length(pivotTableRelsXML) > 0) { + wb$pivotTables.xml.rels <- unlist(lapply(pivotTableRelsXML, function(x) removeHeadTag(cppReadFile(x)))) + } + + + # ## Check what caches are used + cache_keep <- unlist(regmatches(wb$pivotTables.xml.rels, gregexpr("(?<=pivotCache/pivotCacheDefinition)[0-9](?=\\.xml)", + wb$pivotTables.xml.rels, + perl = TRUE, ignore.case = TRUE + ))) + + ## pivot cache records + tmp <- unlist(regmatches(pivotCacheRecords, gregexpr("(?<=pivotCache/pivotCacheRecords)[0-9]+(?=\\.xml)", pivotCacheRecords, perl = TRUE, ignore.case = TRUE))) + pivotCacheRecords <- pivotCacheRecords[tmp %in% cache_keep] + + ## pivot cache definitions rels + tmp <- unlist(regmatches(pivotDefRelsXML, gregexpr("(?<=_rels/pivotCacheDefinition)[0-9]+(?=\\.xml)", pivotDefRelsXML, perl = TRUE, ignore.case = TRUE))) + pivotDefRelsXML <- pivotDefRelsXML[tmp %in% cache_keep] + + ## pivot cache definitions + tmp <- unlist(regmatches(pivotDefXML, gregexpr("(?<=pivotCache/pivotCacheDefinition)[0-9]+(?=\\.xml)", pivotDefXML, perl = TRUE, ignore.case = TRUE))) + pivotDefXML <- pivotDefXML[tmp %in% cache_keep] + + + + if (length(pivotTableXML) > 0) { + wb$pivotTables[seq_along(pivotTableXML)] <- pivotTableXML + pivot_content_type <- c( + pivot_content_type, + sprintf('', seq_along(pivotTableXML)) + ) + } + + if (length(pivotDefXML) > 0) { + wb$pivotDefinitions[seq_along(pivotDefXML)] <- pivotDefXML + pivot_content_type <- c( + pivot_content_type, + sprintf('', seq_along(pivotDefXML)) + ) + } + + if (length(pivotCacheRecords) > 0) { + wb$pivotRecords[seq_along(pivotCacheRecords)] <- pivotCacheRecords + pivot_content_type <- c( + pivot_content_type, + sprintf('', seq_along(pivotCacheRecords)) + ) + } + + if (length(pivotDefRelsXML) > 0) { + wb$pivotDefinitionsRels[seq_along(pivotDefRelsXML)] <- pivotDefRelsXML + } + + + + + ## update content_types + wb$Content_Types <- c(wb$Content_Types, pivot_content_type) + + + ## workbook rels + wb$workbook.xml.rels <- c( + wb$workbook.xml.rels, + sprintf('', rIds, seq_along(pivotDefXML)) + ) + + + caches <- getNodes(xml = workbook, tagIn = "") + caches <- getChildlessNode(xml = caches, tag = "pivotCache") + for (i in seq_along(caches)) { + caches[i] <- gsub('"rId[0-9]+"', sprintf('"rId%s"', rIds[i]), caches[i]) + } + + wb$workbook$pivotCaches <- paste0("", paste(caches, collapse = ""), "") + } + + ## xl\vbaProject + if (length(vbaProject) > 0) { + wb$vbaProject <- vbaProject + wb$Content_Types[grepl('' + wb$Content_Types <- c(wb$Content_Types, '') + } + + + ## xl\styles + if (length(stylesXML) > 0) { + styleObjects <- wb$loadStyles(stylesXML) + } else { + styleObjects <- list() + } + + ## xl\media + if (length(media) > 0) { + mediaNames <- regmatches(media, regexpr("image[0-9]+\\.[a-z]+$", media)) + fileTypes <- unique(gsub("image[0-9]+\\.", "", mediaNames)) + + contentNodes <- sprintf('', fileTypes, fileTypes) + contentNodes[fileTypes == "emf"] <- '' + + wb$Content_Types <- c(contentNodes, wb$Content_Types) + names(media) <- mediaNames + wb$media <- media + } + + + + ## xl\chart + if (length(charts) > 0) { + chartNames <- basename(charts) + nCharts <- sum(grepl("chart[0-9]+.xml", chartNames)) + nChartStyles <- sum(grepl("style[0-9]+.xml", chartNames)) + nChartCol <- sum(grepl("colors[0-9]+.xml", chartNames)) + + if (nCharts > 0) { + wb$Content_Types <- c(wb$Content_Types, sprintf('', 1:nCharts)) + } + + if (nChartStyles > 0) { + wb$Content_Types <- c(wb$Content_Types, sprintf('', 1:nChartStyles)) + } + + if (nChartCol > 0) { + wb$Content_Types <- c(wb$Content_Types, sprintf('', 1:nChartCol)) + } + + if (length(chartsRels)) { + charts <- c(charts, chartsRels) + chartNames <- c(chartNames, file.path("_rels", basename(chartsRels))) + } + + names(charts) <- chartNames + wb$charts <- charts + } + + + + + + + ## xl\theme + if (length(themeXML) > 0) { + wb$theme <- removeHeadTag(paste(unlist(lapply(sort(themeXML)[[1]], readUTF8)), collapse = "")) + } + + + ## externalLinks + if (length(extLinksXML) > 0) { + wb$externalLinks <- lapply(sort(extLinksXML), function(x) removeHeadTag(cppReadFile(x))) + + wb$Content_Types <- c( + wb$Content_Types, + sprintf('', seq_along(extLinksXML)) + ) + + wb$workbook.xml.rels <- c(wb$workbook.xml.rels, sprintf( + '', + seq_along(extLinksXML) + )) + } + + ## externalLinksRels + if (length(extLinksRelsXML) > 0) { + wb$externalLinksRels <- lapply(sort(extLinksRelsXML), function(x) removeHeadTag(cppReadFile(x))) + } + + + + + + + + ##* ----------------------------------------------------------------------------------------------*## + ### BEGIN READING IN WORKSHEET DATA + ##* ----------------------------------------------------------------------------------------------*## + + ## xl\worksheets + file_names <- regmatches(worksheet_rId_mapping, regexpr("sheet[0-9]+\\.xml", worksheet_rId_mapping, perl = TRUE)) + file_rIds <- unlist(getId(worksheet_rId_mapping)) + file_names <- file_names[match(sheetrId, file_rIds)] + + worksheetsXML <- file.path(dirname(worksheetsXML), file_names) + wb <- loadworksheets(wb = wb, styleObjects = styleObjects, xmlFiles = worksheetsXML, is_chart_sheet = is_chart_sheet) + + ## Fix styleobject encoding + if (length(wb$styleObjects) > 0) { + style_names <- sapply(wb$styleObjects, "[[", "sheet") + Encoding(style_names) <- "UTF-8" + wb$styleObjects <- lapply(seq_along(style_names), function(i) { + wb$styleObjects[[i]]$sheet <- style_names[[i]] + wb$styleObjects[[i]] + }) + } + + + ## Fix headers/footers + for (i in seq_along(worksheetsXML)) { + if (!is_chart_sheet[i]) { + if (length(wb$worksheets[[i]]$headerFooter) > 0) { + wb$worksheets[[i]]$headerFooter <- lapply(wb$worksheets[[i]]$headerFooter, splitHeaderFooter) + } + } + } + + + ##* ----------------------------------------------------------------------------------------------*## + ### READING IN WORKSHEET DATA COMPLETE + ##* ----------------------------------------------------------------------------------------------*## + + + ## Next sheetRels to see which drawings_rels belongs to which sheet + if (length(sheetRelsXML) > 0) { + + ## sheetrId is order sheet appears in xlsx file + ## create a 1-1 vector of rels to worksheet + ## haveRels is boolean vector where i-the element is TRUE/FALSE if sheet has a rels sheet + + if (length(chartSheetsXML) == 0) { + allRels <- file.path(dirname(sheetRelsXML[1]), paste0(file_names, ".rels")) + haveRels <- allRels %in% sheetRelsXML + } else { + haveRels <- rep(FALSE, length(wb$worksheets)) + allRels <- rep("", length(wb$worksheets)) + + for (i in 1:nSheets) { + if (is_chart_sheet[i]) { + ind <- which(chartSheetRIds == sheetrId[i]) + rels_file <- file.path(chartSheetsRelsDir, paste0(chartsheet_rId_mapping[ind], ".rels")) + } else { + ind <- sheetrId[i] + rels_file <- file.path(xmlDir, "xl", "worksheets", "_rels", paste0(file_names[i], ".rels")) + } + if (file.exists(rels_file)) { + allRels[i] <- rels_file + haveRels[i] <- TRUE + } + } + } + + ## sheet.xml have been reordered to be in the order of sheetrId + ## not every sheet has a worksheet rels + + xml <- lapply(seq_along(allRels), function(i) { + if (haveRels[i]) { + xml <- readUTF8(allRels[[i]]) + xml <- removeHeadTag(xml) + xml <- gsub("", "", xml) + xml <- gsub("", "", xml) + xml <- getChildlessNode(xml = xml, tag = "Relationship") + } else { + xml <- "" + } + return(xml) + }) + + + + + + ## Slicers ------------------------------------------------------------------------------------- + + + + if (length(slicerXML) > 0) { + slicerXML <- slicerXML[order(nchar(slicerXML), slicerXML)] + slicersFiles <- lapply(xml, function(x) as.integer(regmatches(x, regexpr("(?<=slicer)[0-9]+(?=\\.xml)", x, perl = TRUE)))) + inds <- sapply(slicersFiles, length) > 0 + + + ## worksheet_rels Id for slicer will be rId0 + k <- 1L + wb$slicers <- rep("", nSheets) + for (i in 1:nSheets) { + + ## read in slicer[j].XML sheets into sheet[i] + if (inds[i]) { + wb$slicers[[i]] <- slicerXML[k] + k <- k + 1L + + wb$worksheets_rels[[i]] <- unlist(c( + wb$worksheets_rels[[i]], + sprintf('', i) + )) + wb$Content_Types <- c( + wb$Content_Types, + sprintf('', i) + ) + + slicer_xml_exists <- FALSE + ## Append slicer to worksheet extLst + + if (length(wb$worksheets[[i]]$extLst) > 0) { + if (grepl('x14:slicer r:id="rId[0-9]+"', wb$worksheets[[i]]$extLst)) { + wb$worksheets[[i]]$extLst <- sub('x14:slicer r:id="rId[0-9]+"', 'x14:slicer r:id="rId0"', wb$worksheets[[i]]$extLst) + slicer_xml_exists <- TRUE + } + } + + if (!slicer_xml_exists) { + wb$worksheets[[i]]$extLst <- c(wb$worksheets[[i]]$extLst, genBaseSlicerXML()) + } + } + } + } + + + if (length(slicerCachesXML) > 0) { + + ## ---- slicerCaches + inds <- seq_along(slicerCachesXML) + wb$Content_Types <- c(wb$Content_Types, sprintf('', inds)) + wb$slicerCaches <- sapply(slicerCachesXML[order(nchar(slicerCachesXML), slicerCachesXML)], function(x) removeHeadTag(cppReadFile(x))) + wb$workbook.xml.rels <- c(wb$workbook.xml.rels, sprintf('', 1E5 + inds, inds)) + wb$workbook$extLst <- c(wb$workbook$extLst, genSlicerCachesExtLst(1E5 + inds)) + } + + + ## Tables -------------------------------------------------------------------------------------- + + + + if (length(tablesXML) > 0) { + tables <- lapply(xml, function(x) as.integer(regmatches(x, regexpr("(?<=table)[0-9]+(?=\\.xml)", x, perl = TRUE)))) + tableSheets <- unlist(lapply(seq_along(sheetrId), function(i) rep(i, length(tables[[i]])))) + + if (length(unlist(tables)) > 0) { + ## get the tables that belong to each worksheet and create a worksheets_rels for each + tCount <- 2L ## table r:Ids start at 3 + for (i in seq_along(tables)) { + if (length(tables[[i]]) > 0) { + k <- seq_along(tables[[i]]) + tCount + wb$worksheets_rels[[i]] <- unlist(c( + wb$worksheets_rels[[i]], + sprintf('', k, k) + )) + + + wb$worksheets[[i]]$tableParts <- sprintf("", k) + tCount <- tCount + length(k) + } + } + + ## sort the tables into the order they appear in the xml and tables variables + names(tablesXML) <- basename(tablesXML) + tablesXML <- tablesXML[sprintf("table%s.xml", unlist(tables))] + + ## tables are now in correct order so we can read them in as they are + wb$tables <- sapply(tablesXML, function(x) removeHeadTag(paste(readUTF8(x), collapse = ""))) + + ## pull out refs and attach names + refs <- regmatches(wb$tables, regexpr('(?<=ref=")[0-9A-Z:]+', wb$tables, perl = TRUE)) + names(wb$tables) <- refs + + wb$Content_Types <- c(wb$Content_Types, sprintf('', seq_along(wb$tables) + 2)) + + ## relabel ids + for (i in seq_along(wb$tables)) { + newId <- sprintf(' id="%s" ', i + 2) + wb$tables[[i]] <- sub(' id="[0-9]+" ', newId, wb$tables[[i]]) + } + + displayNames <- unlist(regmatches(wb$tables, regexpr('(?<=displayName=").*?[^"]+', wb$tables, perl = TRUE))) + if (length(displayNames) != length(tablesXML)) { + displayNames <- paste0("Table", seq_along(tablesXML)) + } + + attr(wb$tables, "sheet") <- tableSheets + attr(wb$tables, "tableName") <- displayNames + + for (i in seq_along(tableSheets)) { + table_sheet_i <- tableSheets[i] + attr(wb$worksheets[[table_sheet_i]]$tableParts, "tableName") <- c(attr(wb$worksheets[[table_sheet_i]]$tableParts, "tableName"), displayNames[i]) + } + } + } ## if(length(tablesXML) > 0) + + ## might we have some external hyperlinks + if (any(sapply(wb$worksheets[!is_chart_sheet], function(x) length(x$hyperlinks) > 0))) { + + ## Do we have external hyperlinks + hlinks <- lapply(xml, function(x) x[grepl("hyperlink", x) & grepl("External", x)]) + hlinksInds <- which(sapply(hlinks, length) > 0) + + ## If it's an external hyperlink it will have a target in the sheet_rels + if (length(hlinksInds) > 0) { + for (i in hlinksInds) { + ids <- unlist(lapply(hlinks[[i]], function(x) regmatches(x, gregexpr('(?<=Id=").*?"', x, perl = TRUE))[[1]])) + ids <- gsub('"$', "", ids) + + targets <- unlist(lapply(hlinks[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) + targets <- gsub('"$', "", targets) + + ids2 <- lapply(wb$worksheets[[i]]$hyperlinks, function(x) regmatches(x, gregexpr('(?<=r:id=").*?"', x, perl = TRUE))[[1]]) + ids2[sapply(ids2, length) == 0] <- NA + ids2 <- gsub('"$', "", unlist(ids2)) + + targets <- targets[match(ids2, ids)] + names(wb$worksheets[[i]]$hyperlinks) <- targets + } + } + } + + + + ## Drawings ------------------------------------------------------------------------------------ + + + + ## xml is in the order of the sheets, drawIngs is toes to sheet position of hasDrawing + ## Not every sheet has a drawing.xml + + + drawXMLrelationship <- lapply(xml, function(x) grep("drawings/drawing", x, value = TRUE)) + hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing + + if (length(drawingRelsXML) > 0) { + dRels <- lapply(drawingRelsXML, readUTF8) + dRels <- unlist(lapply(dRels, removeHeadTag)) + dRels <- gsub("", "", dRels) + dRels <- gsub("", "", dRels) + } + + if (length(drawingsXML) > 0) { + dXML <- lapply(drawingsXML, readUTF8) + dXML <- unlist(lapply(dXML, removeHeadTag)) + dXML <- gsub("", "", dXML) + dXML <- gsub("", "", dXML) + + # ptn1 <- "<(mc:AlternateContent|xdr:oneCellAnchor|xdr:twoCellAnchor|xdr:absoluteAnchor)" + # ptn2 <- "" + + ## split at one/two cell Anchor + # dXML <- regmatches(dXML, gregexpr(paste0(ptn1, ".*?", ptn2), dXML)) + } + + + ## loop over all worksheets and assign drawing to sheet + if (any(hasDrawing)) { + for (i in seq_along(xml)) { + if (hasDrawing[i]) { + target <- unlist(lapply(drawXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) + target <- basename(gsub('"$', "", target)) + + ## sheet_i has which(hasDrawing)[[i]] + relsInd <- grepl(target, drawingRelsXML) + if (any(relsInd)) { + wb$drawings_rels[i] <- dRels[relsInd] + } + + drawingInd <- grepl(target, drawingsXML) + if (any(drawingInd)) { + wb$drawings[i] <- dXML[drawingInd] + } + } + } + } + + + + + ## VML Drawings -------------------------------------------------------------------------------- + + + if (length(vmlDrawingXML) > 0) { + wb$Content_Types <- c(wb$Content_Types, '') + + drawXMLrelationship <- lapply(xml, function(x) grep("drawings/vmlDrawing", x, value = TRUE)) + hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing + + ## loop over all worksheets and assign drawing to sheet + if (any(hasDrawing)) { + for (i in seq_along(xml)) { + if (hasDrawing[i]) { + target <- unlist(lapply(drawXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) + target <- basename(gsub('"$', "", target)) + ind <- grepl(target, vmlDrawingXML) + + if (any(ind)) { + txt <- paste(readUTF8(vmlDrawingXML[ind]), collapse = "\n") + txt <- removeHeadTag(txt) + + i1 <- regexpr("", txt, fixed = TRUE) + + wb$vml[[i]] <- substring(text = txt, first = i1, last = (i2 - 1L)) + + relsInd <- grepl(target, vmlDrawingRelsXML) + if (any(relsInd)) { + wb$vml_rels[i] <- vmlDrawingRelsXML[relsInd] + } + } + } + } + } + } + + + + + + + + ## vmlDrawing and comments + if (length(commentsXML) > 0) { + drawXMLrelationship <- lapply(xml, function(x) grep("drawings/vmlDrawing[0-9]+\\.vml", x, value = TRUE)) + hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing + + commentXMLrelationship <- lapply(xml, function(x) grep("comments[0-9]+\\.xml", x, value = TRUE)) + hasComment <- sapply(commentXMLrelationship, length) > 0 ## which sheets have a comment + + for (i in seq_along(xml)) { + if (hasComment[i]) { + target <- unlist(lapply(drawXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) + target <- basename(gsub('"$', "", target)) + ind <- grepl(target, vmlDrawingXML) + + if (any(ind)) { + txt <- paste(readUTF8(vmlDrawingXML[ind]), collapse = "\n") + txt <- removeHeadTag(txt) + + cd <- unique(getNodes(xml = txt, tagIn = "") + + ## now loada comment + target <- unlist(lapply(commentXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) + target <- basename(gsub('"$', "", target)) + + txt <- paste(readUTF8(grep(target, commentsXML, value = TRUE)), collapse = "\n") + txt <- removeHeadTag(txt) + + authors <- getNodes(xml = txt, tagIn = "") + authors <- gsub("|", "", authors) + + comments <- getNodes(xml = txt, tagIn = "") + comments <- gsub("", "", comments) + comments <- getNodes(xml = comments, tagIn = "))[\\s\\S]+?(?=)", comments, perl = TRUE)) + comments <- lapply(comments, function(x) gsub(".*?>", "", x, perl = TRUE)) + + + wb$comments[[i]] <- lapply(seq_along(comments), function(j) { + comment_list <- list( + "ref" = refs[j], + "author" = authors[j], + "comment" = comments[[j]], + "style" = style[[j]], + "clientData" = cd[[j]] + ) + }) + } + } + } + } + + ## Threaded comments + if (length(threadCommentsXML) > 0) { + threadCommentsXMLrelationship <- lapply(xml, function(x) grep("threadedComment[0-9]+\\.xml", x, value = TRUE)) + hasThreadComments<- sapply(threadCommentsXMLrelationship, length) > 0 + if(any(hasThreadComments)) { + for (i in seq_along(xml)) { + if (hasThreadComments[i]) { + target <- unlist(lapply(threadCommentsXMLrelationship[[i]], function(x) regmatches(x, gregexpr('(?<=Target=").*?"', x, perl = TRUE))[[1]])) + target <- basename(gsub('"$', "", target)) + + wb$threadComments[[i]] <- grep(target, threadCommentsXML, value = TRUE) + + } + } + } + wb$Content_Types <- c( + wb$Content_Types, + sprintf('', + sapply(threadCommentsXML, basename)) + ) + } + + ## Persons (needed for Threaded Comment) + if(length(personXML) > 0){ + wb$persons <- personXML + wb$Content_Types <- c( + wb$Content_Types, + '' + ) + wb$workbook.xml.rels <- c( + wb$workbook.xml.rels, + '') + } + + + ## rels image + drawXMLrelationship <- lapply(xml, function(x) grep("relationships/image", x, value = TRUE)) + hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing + if (any(hasDrawing)) { + for (i in seq_along(xml)) { + if (hasDrawing[i]) { + image_ids <- unlist(getId(drawXMLrelationship[[i]])) + new_image_ids <- paste0("rId", seq_along(image_ids) + 70000) + for (j in seq_along(image_ids)) { + wb$worksheets[[i]]$oleObjects <- gsub(image_ids[j], new_image_ids[j], wb$worksheets[[i]]$oleObjects, fixed = TRUE) + wb$worksheets_rels[[i]] <- c(wb$worksheets_rels[[i]], gsub(image_ids[j], new_image_ids[j], drawXMLrelationship[[i]][j], fixed = TRUE)) + } + } + } + } + + ## rels image + drawXMLrelationship <- lapply(xml, function(x) grep("relationships/package", x, value = TRUE)) + hasDrawing <- sapply(drawXMLrelationship, length) > 0 ## which sheets have a drawing + if (any(hasDrawing)) { + for (i in seq_along(xml)) { + if (hasDrawing[i]) { + image_ids <- unlist(getId(drawXMLrelationship[[i]])) + new_image_ids <- paste0("rId", seq_along(image_ids) + 90000) + for (j in seq_along(image_ids)) { + wb$worksheets[[i]]$oleObjects <- gsub(image_ids[j], new_image_ids[j], wb$worksheets[[i]]$oleObjects, fixed = TRUE) + wb$worksheets_rels[[i]] <- c( + wb$worksheets_rels[[i]], + sprintf("", new_image_ids[j]) + ) + } + } + } + } + + + + ## Embedded docx + if (length(embeddings) > 0) { + wb$Content_Types <- c(wb$Content_Types, '') + wb$embeddings <- embeddings + } + + + + ## pivot tables + if (length(pivotTableXML) > 0) { + # pivotTableJ <- lapply(xml, function(x) as.integer(regmatches(x, regexpr("(?<=pivotTable)[0-9]+(?=\\.xml)", x, perl = TRUE)))) variable not used + # sheetWithPivot <- which(sapply(pivotTableJ, length) > 0) variable not used + + pivotRels <- lapply(xml, function(x) { + y <- grep("pivotTable", x, value = TRUE) + y[order(nchar(y), y)] + }) + hasPivot <- sapply(pivotRels, length) > 0 + + ## Modify rIds + for (i in seq_along(pivotRels)) { + if (hasPivot[i]) { + for (j in seq_along(pivotRels[[i]])) { + pivotRels[[i]][j] <- gsub('"rId[0-9]+"', sprintf('"rId%s"', 20000L + j), pivotRels[[i]][j]) + } + + wb$worksheets_rels[[i]] <- c(wb$worksheets_rels[[i]], pivotRels[[i]]) + } + } + + + ## remove any workbook_res references to pivot tables that are not being used in worksheet_rels + inds <- seq_along(wb$pivotTables.xml.rels) + fileNo <- as.integer(unlist(regmatches(unlist(wb$worksheets_rels), gregexpr("(?<=pivotTable)[0-9]+(?=\\.xml)", unlist(wb$worksheets_rels), perl = TRUE)))) + inds <- inds[!inds %in% fileNo] + + if (length(inds) > 0) { + toRemove <- paste(sprintf("(pivotCacheDefinition%s\\.xml)", inds), collapse = "|") + fileNo <- grep(toRemove, wb$pivotTables.xml.rels) + toRemove <- paste(sprintf("(pivotCacheDefinition%s\\.xml)", fileNo), collapse = "|") + + ## remove reference to file from workbook.xml.res + wb$workbook.xml.rels <- wb$workbook.xml.rels[!grepl(toRemove, wb$workbook.xml.rels)] + } + } + } ## end of worksheetRels + + ## convert hyperliks to hyperlink objects + for (i in 1:nSheets) { + wb$worksheets[[i]]$hyperlinks <- xml_to_hyperlink(wb$worksheets[[i]]$hyperlinks) + } + + + + ## queryTables + if (length(queryTablesXML) > 0) { + ids <- as.numeric(regmatches(queryTablesXML, regexpr("[0-9]+(?=\\.xml)", queryTablesXML, perl = TRUE))) + wb$queryTables <- unlist(lapply(queryTablesXML[order(ids)], function(x) removeHeadTag(cppReadFile(xmlFile = x)))) + wb$Content_Types <- c( + wb$Content_Types, + sprintf('', seq_along(queryTablesXML)) + ) + } + + + ## connections + if (length(connectionsXML) > 0) { + wb$connections <- removeHeadTag(cppReadFile(xmlFile = connectionsXML)) + wb$workbook.xml.rels <- c(wb$workbook.xml.rels, '') + wb$Content_Types <- c(wb$Content_Types, '') + } + + + + + ## table rels + if (length(tableRelsXML) > 0) { + + ## table_i_might have tableRels_i but I am re-ordering the tables to be in order of worksheets + ## I make every table have a table_rels so i need to fill in the gaps if any table_rels are missing + + tmp <- paste0(basename(tablesXML), ".rels") + hasRels <- tmp %in% basename(tableRelsXML) + + ## order tableRelsXML + tableRelsXML <- tableRelsXML[match(tmp[hasRels], basename(tableRelsXML))] + + ## + wb$tables.xml.rels <- character(length = length(tablesXML)) + + ## which sheet does it belong to + xml <- sapply(tableRelsXML, cppReadFile, USE.NAMES = FALSE) + xml <- sapply(xml, removeHeadTag, USE.NAMES = FALSE) + + wb$tables.xml.rels[hasRels] <- xml + } else if (length(tablesXML) > 0) { + wb$tables.xml.rels <- rep("", length(tablesXML)) + } + + + activesheet <- unlist(regmatches(workbook, gregexpr("(?<=).*(?=)", workbook, perl = TRUE))) + activesheet <- unlist(regmatches(activesheet, gregexpr("]*>", activesheet, perl = TRUE))) + + wb$ActiveSheet <- as.integer(getAttrs(activesheet,"activeTab")$activeTab) + 1L + + if(length(wb$ActiveSheet) == 0){ + wb$ActiveSheet <- 1L + } + + return(wb) +} diff -Nru r-cran-openxlsx-4.2.4/R/onUnload.R r-cran-openxlsx-4.2.5/R/onUnload.R --- r-cran-openxlsx-4.2.4/R/onUnload.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/onUnload.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,3 +1,3 @@ -.onUnload <- function(libpath) { - library.dynam.unload("openxlsx", libpath) -} +.onUnload <- function(libpath) { + library.dynam.unload("openxlsx", libpath) +} diff -Nru r-cran-openxlsx-4.2.4/R/openXL.R r-cran-openxlsx-4.2.5/R/openXL.R --- r-cran-openxlsx-4.2.4/R/openXL.R 2021-06-09 10:46:55.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/openXL.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,106 +1,105 @@ -#' @name openXL -#' @title Open a Microsoft Excel file (xls/xlsx) or an openxlsx Workbook -#' @author Luca Braglia -#' @description This function tries to open a Microsoft Excel -#' (xls/xlsx) file or an openxlsx Workbook with the proper -#' application, in a portable manner. -#' -#' In Windows (c) and Mac (c), it uses system default handlers, -#' given the file type. -#' -#' In Linux it searches (via \code{which}) for available xls/xlsx -#' reader applications (unless \code{options('openxlsx.excelApp')} -#' is set to the app bin path), and if it finds anything, sets -#' \code{options('openxlsx.excelApp')} to the program choosen by -#' the user via a menu (if many are present, otherwise it will -#' set the only available). Currently searched for apps are -#' Libreoffice/Openoffice (\code{soffice} bin), Gnumeric -#' (\code{gnumeric}) and Calligra Sheets (\code{calligrasheets}). -#' -#' @param file path to the Excel (xls/xlsx) file or Workbook object. -#' @usage openXL(file=NULL) -#' @export openXL -#' @examples -#' # file example -#' example(writeData) -#' # openXL("writeDataExample.xlsx") -#' -#' # (not yet saved) Workbook example -#' wb <- createWorkbook() -#' x <- mtcars[1:6, ] -#' addWorksheet(wb, "Cars") -#' writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) -#' # openXL(wb) -openXL <- function(file = NULL) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (is.null(file)) stop("A file has to be specified.") - - ## workbook handling - if ("Workbook" %in% class(file)) { - file <- file$saveWorkbook() - } - - if (!file.exists(file)) stop("Non existent file or wrong path.") - - ## execution should be in background in order to not block R - ## interpreter - file <- normalizePath(file) - userSystem <- Sys.info()["sysname"] - - - if ("Linux" == userSystem) { - if (is.null(app <- unlist(options("openxlsx.excelApp")))) { - app <- chooseExcelApp() - } - myCommand <- paste(app, file, "&", sep = " ") - system(command = myCommand) - } else if ("Windows" == userSystem) { - shell(shQuote(string = file), wait = FALSE) #nolint - } else if ("Darwin" == userSystem) { - myCommand <- paste0("open ", file) - system(command = myCommand) - } else { - warning("Operating system not handled.") - } -} - - -chooseExcelApp <- function() { - m <- c( - `Libreoffice/OpenOffice` = "soffice", - `Calligra Sheets` = "calligrasheets", - `Gnumeric` = "gnumeric" - ) - - prog <- Sys.which(m) - names(prog) <- names(m) - nApps <- length(availProg <- prog["" != prog]) - - if (0 == nApps) { - stop( - "No applications (detected) available.\n", - "Set options('openxlsx.excelApp'), instead." - ) - } else if (1 == nApps) { - cat("Only", names(availProg), "found; I'll use it.\n") - unnprog <- unname(availProg) - options(openxlsx.excelApp = unnprog) - invisible(unnprog) - } else if (1 < nApps) { - if (!interactive()) { - stop( - "Cannot choose an Excel file opener non-interactively.\n", - "Set options('openxlsx.excelApp'), instead." - ) - } - res <- menu(names(availProg), title = "Excel Apps availables") - unnprog <- unname(availProg[res]) - if (res > 0L) options(openxlsx.excelApp = unnprog) - invisible(unname(unnprog)) - } else { - stop("Unexpected error.") - } -} +#' @name openXL +#' @title Open a Microsoft Excel file (xls/xlsx) or an openxlsx Workbook +#' @author Luca Braglia +#' @description This function tries to open a Microsoft Excel +#' (xls/xlsx) file or an openxlsx Workbook with the proper +#' application, in a portable manner. +#' +#' In Windows (c) and Mac (c), it uses system default handlers, +#' given the file type. +#' +#' In Linux it searches (via `which`) for available xls/xlsx +#' reader applications (unless `options('openxlsx.excelApp')` +#' is set to the app bin path), and if it finds anything, sets +#' `options('openxlsx.excelApp')` to the program choosen by +#' the user via a menu (if many are present, otherwise it will +#' set the only available). Currently searched for apps are +#' Libreoffice/Openoffice (`soffice` bin), Gnumeric +#' (`gnumeric`) and Calligra Sheets (`calligrasheets`). +#' +#' @param file path to the Excel (xls/xlsx) file or Workbook object. +#' @usage openXL(file=NULL) +#' @export openXL +#' @examples +#' # file example +#' example(writeData) +#' # openXL("writeDataExample.xlsx") +#' +#' # (not yet saved) Workbook example +#' wb <- createWorkbook() +#' x <- mtcars[1:6, ] +#' addWorksheet(wb, "Cars") +#' writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) +#' # openXL(wb) +openXL <- function(file = NULL) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (is.null(file)) stop("A file has to be specified.") + + ## workbook handling + if ("Workbook" %in% class(file)) { + file <- file$saveWorkbook() + } + + if (!file.exists(file)) stop("Non existent file or wrong path.") + + ## execution should be in background in order to not block R + ## interpreter + file <- normalizePath(file) + userSystem <- Sys.info()["sysname"] + + + if ("Linux" == userSystem) { + if (is.null(app <- unlist(options("openxlsx.excelApp")))) { + app <- chooseExcelApp() + } + myCommand <- paste(app, file, "&", sep = " ") + system(command = myCommand) + } else if ("Windows" == userSystem) { + shell(shQuote(string = file), wait = FALSE) #nolint + } else if ("Darwin" == userSystem) { + myCommand <- paste0("open ", file) + system(command = myCommand) + } else { + warning("Operating system not handled.") + } +} + + +chooseExcelApp <- function() { + m <- c( + `Libreoffice/OpenOffice` = "soffice", + `Calligra Sheets` = "calligrasheets", + `Gnumeric` = "gnumeric" + ) + + prog <- Sys.which(m) + names(prog) <- names(m) + nApps <- length(availProg <- prog["" != prog]) + + if (0 == nApps) { + stop( + "No applications (detected) available.\n", + "Set options('openxlsx.excelApp'), instead." + ) + } else if (1 == nApps) { + cat("Only", names(availProg), "found; I'll use it.\n") + unnprog <- unname(availProg) + options(openxlsx.excelApp = unnprog) + invisible(unnprog) + } else if (1 < nApps) { + if (!interactive()) { + stop( + "Cannot choose an Excel file opener non-interactively.\n", + "Set options('openxlsx.excelApp'), instead." + ) + } + res <- menu(names(availProg), title = "Excel Apps availables") + unnprog <- unname(availProg[res]) + if (res > 0L) options(openxlsx.excelApp = unnprog) + invisible(unname(unnprog)) + } else { + stop("Unexpected error.") + } +} diff -Nru r-cran-openxlsx-4.2.4/R/openxlsxCoerce.R r-cran-openxlsx-4.2.5/R/openxlsxCoerce.R --- r-cran-openxlsx-4.2.4/R/openxlsxCoerce.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/openxlsxCoerce.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,236 +1,235 @@ - - -## - -openxlsxCoerce <- function(x, rowNames) { - UseMethod("openxlsxCoerce") -} - -openxlsxCoerce.default <- function(x, rowNames) { - x <- as.data.frame(x, stringsAsFactors = FALSE) - return(x) -} - - -openxlsxCoerce.data.frame <- function(x, rowNames) { - - ## cbind rownames to x - if (rowNames) { - x <- cbind(data.frame("row names" = rownames(x), stringsAsFactors = FALSE), as.data.frame(x, stringsAsFactors = FALSE)) - names(x)[[1]] <- "" - } - - return(x) -} - - -openxlsxCoerce.data.table <- function(x, rowNames) { - x <- as.data.frame(x, stringsAsFactors = FALSE) - - ## cbind rownames to x - if (rowNames) { - x <- cbind(data.frame("row names" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[[1]] <- "" - } - - return(x) -} - - -openxlsxCoerce.matrix <- function(x, rowNames) { - x <- as.data.frame(x, stringsAsFactors = FALSE) - - if (rowNames) { - x <- cbind(data.frame("row names" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[[1]] <- "" - } - - return(x) -} - - -openxlsxCoerce.array <- function(x, rowNames) { - stop("array in writeData : currently not supported") -} - -openxlsxCoerce.aov <- function(x, rowNames) { - x <- summary(x) - x <- cbind(x[[1]]) - x <- cbind(data.frame("row name" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[1] <- "" - - return(x) -} - - -openxlsxCoerce.lm <- function(x, rowNames) { - x <- as.data.frame(summary(x)[["coefficients"]]) - x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[1] <- "" - - return(x) -} - - -openxlsxCoerce.anova <- function(x, rowNames) { - x <- as.data.frame(x) - - if (rowNames) { - x <- cbind(data.frame("row name" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[1] <- "" - } - - return(x) -} - - -openxlsxCoerce.glm <- function(x, rowNames) { - x <- as.data.frame(summary(x)[["coefficients"]]) - x <- cbind(data.frame("row name" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[1] <- "" - - return(x) -} - - -openxlsxCoerce.table <- function(x, rowNames) { - x <- as.data.frame(unclass(x)) - x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[1] <- "" - - return(x) -} - - -openxlsxCoerce.prcomp <- function(x, rowNames) { - x <- as.data.frame(x$rotation) - x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[1] <- "" - - return(x) -} - - -openxlsxCoerce.summary.prcomp <- function(x, rowNames) { - x <- as.data.frame(x$importance) - x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) - names(x)[1] <- "" - - return(x) -} - - - -#' @name openxlsxCoerce.survdiff -#' @description like print.survdiff with some ideas from the ascii package -#' @param x data.frame for input -#' @param rowNames rownames -#' @importFrom stats pchisq -#' @keywords internal -#' @noRd -openxlsxCoerce.survdiff <- function(x, rowNames) { - - - ## like print.survdiff with some ideas from the ascii package - if (length(x$n) == 1) { - z <- sign(x$exp - x$obs) * sqrt(x$chisq) - temp <- c(x$obs, x$exp, z, 1 - pchisq(x$chisq, 1)) - names(temp) <- c("Observed", "Expected", "Z", "p") - x <- as.data.frame(t(temp)) - } else { - if (is.matrix(x$obs)) { - otmp <- apply(x$obs, 1, sum) - etmp <- apply(x$exp, 1, sum) - } - else { - otmp <- x$obs - etmp <- x$exp - } - chisq <- c(x$chisq, rep(NA, length(x$n) - 1)) - df <- c((sum(1 * (etmp > 0))) - 1, rep(NA, length(x$n) - 1)) - p <- c(1 - pchisq(x$chisq, df[!is.na(df)]), rep(NA, length(x$n) - 1)) - - temp <- cbind( - x$n, otmp, etmp, - ((otmp - etmp)^2) / etmp, ((otmp - etmp)^2) / diag(x$var), - chisq, df, p - ) - - - colnames(temp) <- c( - "N", "Observed", "Expected", "(O-E)^2/E", "(O-E)^2/V", - "Chisq", "df", "p" - ) - - temp <- as.data.frame(temp, checknames = FALSE) - x <- cbind("Group" = names(x$n), temp) - names(x)[1] <- "" - } - - return(x) -} - - - -openxlsxCoerce.coxph <- function(x, rowNames) { - - ## sligthly modified print.coxph - coef <- x$coefficients - se <- sqrt(diag(x$var)) - - if (is.null(coef) | is.null(se)) { - stop("Input is not valid") - } - - if (is.null(x$naive.var)) { - tmp <- cbind(coef, exp(coef), se, coef / se, pchisq((coef / se)^2, 1)) - colnames(tmp) <- c("coef", "exp(coef)", "se(coef)", "z", "p") - } else { - nse <- sqrt(diag(x$naive.var)) - tmp <- cbind(coef, exp(coef), nse, se, coef / se, pchisq((coef / se)^2, 1)) - colnames(tmp) <- c("coef", "exp(coef)", "se(coef)", "robust se", "z", "p") - } - - x <- cbind("Variable" = names(coef), as.data.frame(tmp, checknames = FALSE)) - names(x)[1] <- "" - - return(x) -} - - - - -openxlsxCoerce.summary.coxph <- function(x, rowNames) { - coef <- x$coefficients - ci <- x$conf.int - # nvars <- nrow(coef) variable not used - - tmp <- cbind( - coef[, -ncol(coef), drop = FALSE], # p later - ci[, (ncol(ci) - 1):ncol(ci), drop = FALSE], # confint - coef[, ncol(coef), drop = FALSE] - ) # p.value - - x <- as.data.frame(tmp, checknames = FALSE) - - x <- cbind(data.frame("row names" = rownames(x)), x) - names(x)[[1]] <- "" - - return(x) -} - -openxlsxCoerce.cox.zph <- function(x, rowNames) { - tmp <- as.data.frame(x$table) - x <- cbind(data.frame("row names" = rownames(tmp)), tmp) - names(x)[[1]] <- "" - - return(x) -} - - -openxlsxCoerce.hyperlink <- function(x, rowNames) { - - ## vector of hyperlinks - class(x) <- c("character", "hyperlink") - x <- as.data.frame(x, stringsAsFactors = FALSE) -} + + +## + +openxlsxCoerce <- function(x, rowNames) { + UseMethod("openxlsxCoerce") +} + +openxlsxCoerce.default <- function(x, rowNames) { + x <- as.data.frame(x, stringsAsFactors = FALSE) + return(x) +} + + +openxlsxCoerce.data.frame <- function(x, rowNames) { + + ## cbind rownames to x + if (rowNames) { + x <- cbind(data.frame("row names" = rownames(x), stringsAsFactors = FALSE), as.data.frame(x, stringsAsFactors = FALSE)) + names(x)[[1]] <- "" + } + + return(x) +} + + +openxlsxCoerce.data.table <- function(x, rowNames) { + x <- as.data.frame(x, stringsAsFactors = FALSE) + + ## cbind rownames to x + if (rowNames) { + x <- cbind(data.frame("row names" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[[1]] <- "" + } + + return(x) +} + + +openxlsxCoerce.matrix <- function(x, rowNames) { + x <- as.data.frame(x, stringsAsFactors = FALSE) + + if (rowNames) { + x <- cbind(data.frame("row names" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[[1]] <- "" + } + + return(x) +} + + +openxlsxCoerce.array <- function(x, rowNames) { + stop("array in writeData : currently not supported") +} + +openxlsxCoerce.aov <- function(x, rowNames) { + x <- summary(x) + x <- cbind(x[[1]]) + x <- cbind(data.frame("row name" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[1] <- "" + + return(x) +} + + +openxlsxCoerce.lm <- function(x, rowNames) { + x <- as.data.frame(summary(x)[["coefficients"]]) + x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[1] <- "" + + return(x) +} + + +openxlsxCoerce.anova <- function(x, rowNames) { + x <- as.data.frame(x) + + if (rowNames) { + x <- cbind(data.frame("row name" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[1] <- "" + } + + return(x) +} + + +openxlsxCoerce.glm <- function(x, rowNames) { + x <- as.data.frame(summary(x)[["coefficients"]]) + x <- cbind(data.frame("row name" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[1] <- "" + + return(x) +} + + +openxlsxCoerce.table <- function(x, rowNames) { + x <- as.data.frame(unclass(x)) + x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[1] <- "" + + return(x) +} + + +openxlsxCoerce.prcomp <- function(x, rowNames) { + x <- as.data.frame(x$rotation) + x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[1] <- "" + + return(x) +} + + +openxlsxCoerce.summary.prcomp <- function(x, rowNames) { + x <- as.data.frame(x$importance) + x <- cbind(data.frame("Variable" = rownames(x), stringsAsFactors = FALSE), x) + names(x)[1] <- "" + + return(x) +} + + + +#' @name openxlsxCoerce.survdiff +#' @description like print.survdiff with some ideas from the ascii package +#' @param x data.frame for input +#' @param rowNames rownames +#' @importFrom stats pchisq +#' @keywords internal +#' @noRd +openxlsxCoerce.survdiff <- function(x, rowNames) { + + + ## like print.survdiff with some ideas from the ascii package + if (length(x$n) == 1) { + z <- sign(x$exp - x$obs) * sqrt(x$chisq) + temp <- c(x$obs, x$exp, z, 1 - pchisq(x$chisq, 1)) + names(temp) <- c("Observed", "Expected", "Z", "p") + x <- as.data.frame(t(temp)) + } else { + if (is.matrix(x$obs)) { + otmp <- apply(x$obs, 1, sum) + etmp <- apply(x$exp, 1, sum) + } + else { + otmp <- x$obs + etmp <- x$exp + } + chisq <- c(x$chisq, rep(NA, length(x$n) - 1)) + df <- c((sum(1 * (etmp > 0))) - 1, rep(NA, length(x$n) - 1)) + p <- c(1 - pchisq(x$chisq, df[!is.na(df)]), rep(NA, length(x$n) - 1)) + + temp <- cbind( + x$n, otmp, etmp, + ((otmp - etmp)^2) / etmp, ((otmp - etmp)^2) / diag(x$var), + chisq, df, p + ) + + + colnames(temp) <- c( + "N", "Observed", "Expected", "(O-E)^2/E", "(O-E)^2/V", + "Chisq", "df", "p" + ) + + temp <- as.data.frame(temp, checknames = FALSE) + x <- cbind("Group" = names(x$n), temp) + names(x)[1] <- "" + } + + return(x) +} + + + +openxlsxCoerce.coxph <- function(x, rowNames) { + + ## sligthly modified print.coxph + coef <- x$coefficients + se <- sqrt(diag(x$var)) + + if (is.null(coef) | is.null(se)) { + stop("Input is not valid") + } + + if (is.null(x$naive.var)) { + tmp <- cbind(coef, exp(coef), se, coef / se, pchisq((coef / se)^2, 1)) + colnames(tmp) <- c("coef", "exp(coef)", "se(coef)", "z", "p") + } else { + nse <- sqrt(diag(x$naive.var)) + tmp <- cbind(coef, exp(coef), nse, se, coef / se, pchisq((coef / se)^2, 1)) + colnames(tmp) <- c("coef", "exp(coef)", "se(coef)", "robust se", "z", "p") + } + + x <- cbind("Variable" = names(coef), as.data.frame(tmp, checknames = FALSE)) + names(x)[1] <- "" + + return(x) +} + + + + +openxlsxCoerce.summary.coxph <- function(x, rowNames) { + coef <- x$coefficients + ci <- x$conf.int + # nvars <- nrow(coef) variable not used + + tmp <- cbind( + coef[, -ncol(coef), drop = FALSE], # p later + ci[, (ncol(ci) - 1):ncol(ci), drop = FALSE], # confint + coef[, ncol(coef), drop = FALSE] + ) # p.value + + x <- as.data.frame(tmp, checknames = FALSE) + + x <- cbind(data.frame("row names" = rownames(x)), x) + names(x)[[1]] <- "" + + return(x) +} + +openxlsxCoerce.cox.zph <- function(x, rowNames) { + tmp <- as.data.frame(x$table) + x <- cbind(data.frame("row names" = rownames(tmp)), tmp) + names(x)[[1]] <- "" + + return(x) +} + + +openxlsxCoerce.hyperlink <- function(x, rowNames) { + ## vector of hyperlinks + class(x) <- c("character", "hyperlink") + x <- as.data.frame(x, stringsAsFactors = FALSE) +} diff -Nru r-cran-openxlsx-4.2.4/R/openxlsx-package.R r-cran-openxlsx-4.2.5/R/openxlsx-package.R --- r-cran-openxlsx-4.2.4/R/openxlsx-package.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/openxlsx-package.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,3 +1,3 @@ -## usethis namespace: start -#' @importFrom lifecycle deprecate_soft -## usethis namespace: end +## usethis namespace: start +#' @importFrom lifecycle deprecate_soft +## usethis namespace: end diff -Nru r-cran-openxlsx-4.2.4/R/openxlsx.R r-cran-openxlsx-4.2.5/R/openxlsx.R --- r-cran-openxlsx-4.2.4/R/openxlsx.R 2021-06-08 14:29:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/openxlsx.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,165 +1,168 @@ -#' xlsx reading, writing and editing. -#' -#' openxlsx simplifies the the process of writing and styling Excel xlsx files from R -#' and removes the dependency on Java. -#' -#' @name openxlsx -#' @docType package -#' @useDynLib openxlsx, .registration=TRUE -#' @importFrom zip zipr -#' @importFrom utils download.file head menu unzip -#' -#' @seealso -#' \itemize{ -#' \item{\code{vignette("Introduction", package = "openxlsx")}} -#' \item{\code{vignette("formatting", package = "openxlsx")}} -#' \item{\code{\link{writeData}}} -#' \item{\code{\link{writeDataTable}}} -#' \item{\code{\link{write.xlsx}}} -#' \item{\code{\link{read.xlsx}}} -#' \item{\code{\link{op.openxlsx}}} -#' } -#' for examples -#' -#' @details -#' The openxlsx package uses global options, most to simplify formatting. These -#' are stored in the \code{op.openxlsx} object. -#' -#' \describe{ -#' \item{openxlsx.bandedCols}{FALSE} -#' \item{openxlsx.bandedRows}{TRUE} -#' \item{openxlsx.borderColour}{"black"} -#' \item{openxlsx.borders}{"none"} -#' \item{openxlsx.borderStyle}{"thin"} -#' \item{openxlsx.compressionLevel}{"9"} -#' \item{openxlsx.creator}{""} -#' \item{openxlsx.dateFormat}{"mm/dd/yyyy"} -#' \item{openxlsx.datetimeFormat}{"yyyy-mm-dd hh:mm:ss"} -#' \item{openxlsx.headerStyle}{NULL} -#' \item{openxlsx.keepNA}{FALSE} -#' \item{openxlsx.na.string}{NULL} -#' \item{openxlsx.numFmt}{NULL} -#' \item{openxlsx.orientation}{"portrait"} -#' \item{openxlsx.paperSize}{9} -#' \item{openxlsx.tabColour}{"TableStyleLight9"} -#' \item{openxlsx.tableStyle}{"TableStyleLight9"} -#' \item{openxlsx.withFilter}{NA Whether to write data with or without a -#' filter. If NA will make filters with \code{writeDataTable} and will not for -#' \code{writeData}} -#' } -#' -#' See the Formatting vignette for examples. -#' -#' Additional options -#' -#' - NULL - -#' openxlsx Options -#' -#' See and get the openxlsx options -#' -#' @details -#' -#' \code{openxlsx_getOp()} retrieves the \code{"openxlsx"} options found in -#' \code{op.openxlsx}. If none are set (currently `NULL`) retrieves the -#' default option from \code{op.openxlsx}. This will also check that the -#' intended option is a standard option (listed in \code{op.openxlsx}) and -#' will provide a warning otherwise. -#' -#' \code{openxlsx_setOp()} is a safer way to set an option as it will first -#' check that the option is a standard option (as above) before setting. -#' -#' @examples -#' openxlsx_getOp("borders") -#' op.openxlsx[["openxlsx.borders"]] -#' -#' @export -#' @name openxlsx_options -op.openxlsx <- list( - openxlsx.bandedCols = FALSE, - openxlsx.bandedRows = TRUE, - openxlsx.borderColour = "black", - openxlsx.borders = NULL, - openxlsx.borderStyle = "thin", - # Where is compressionLevel called? - openxlsx.compressionLevel = 9, - openxlsx.creator = "", - openxlsx.dateFormat = "mm/dd/yyyy", - openxlsx.datetimeFormat = "yyyy-mm-dd hh:mm:ss", - openxlsx.hdpi = 300, - openxlsx.header = NULL, - openxlsx.headerStyle = NULL, - openxlsx.firstColumn = NULL, - openxlsx.firstFooter = NULL, - openxlsx.firstHeader = NULL, - openxlsx.footer = NULL, - openxlsx.evenFooter = NULL, - openxlsx.evenHeader = NULL, - openxlsx.gridLines = TRUE, - openxlsx.keepNA = FALSE, - openxlsx.lastColumn = NULL, - openxlsx.na.string = NULL, - openxlsx.maxWidth = 250, - openxlsx.minWidth = 3, - openxlsx.numFmt = "GENERAL", - openxlsx.oddFooter = NULL, - openxlsx.oddHeader = NULL, - openxlsx.orientation = "portrait", - openxlsx.paperSize = 9, - openxlsx.showGridLines = NA, - openxlsx.tabColour = NULL, - openxlsx.tableStyle = "TableStyleLight9", - openxlsx.vdpi = 300, - openxlsx.withFilter = NULL -) - - -#' @param x An option name (\code{"openxlsx."} prefix optional) -#' @param default A default value if \code{NULL} -#' @rdname openxlsx_options -#' @export -openxlsx_getOp <- function(x, default = NULL) { - if (length(x) != 1L || length(default) > 1L) { - stop("x must be length 1 and default NULL or length 1", call. = FALSE) - } - - x <- check_openxlsx_op(x) - getOption(x, op.openxlsx[[x]]) %||% default -} - -#' @param value The new value for the option (optional if x is a named list) -#' @rdname openxlsx_options -#' @export -openxlsx_setOp <- function(x, value) { - if (is.list(x)) { - if (is.null(names(x))) { - stop("x cannot be an unnamed list", call. = FALSE) - } - - mapply(openxlsx_setOp, x = names(x), value = x) - } - - value <- as.list(value) - names(value) <- check_openxlsx_op(x) - options(value) -} - -check_openxlsx_op <- function(x) { - if (length(x) != 1L || !is.character(x)) { - stop("option must be a character vector of length 1", call. = FALSE) - } - - if (!grepl("^openxlsx[.]", x)) { - x <- paste0("openxlsx.", x) - } - - if (!x %in% names(op.openxlsx)) { - warning( - x, " is not a standard openxlsx option\nCheck spelling", - call. = FALSE - ) - } - - x -} +#' xlsx reading, writing and editing. +#' +#' openxlsx simplifies the the process of writing and styling Excel xlsx files from R +#' and removes the dependency on Java. +#' +#' @name openxlsx +#' @docType package +#' @useDynLib openxlsx, .registration=TRUE +#' @importFrom zip zipr +#' @importFrom utils download.file head menu unzip +#' +#' @seealso +#' \itemize{ +#' \item{`vignette("Introduction", package = "openxlsx")`} +#' \item{`vignette("formatting", package = "openxlsx")`} +#' \item{[writeData()]} +#' \item{[writeDataTable()]} +#' \item{[write.xlsx()]} +#' \item{[read.xlsx()]} +#' \item{[op.openxlsx()]} +#' } +#' for examples +#' +#' @details +#' The openxlsx package uses global options, most to simplify formatting. These +#' are stored in the `op.openxlsx` object. +#' +#' \describe{ +#' \item{openxlsx.bandedCols}{FALSE} +#' \item{openxlsx.bandedRows}{TRUE} +#' \item{openxlsx.borderColour}{"black"} +#' \item{openxlsx.borders}{"none"} +#' \item{openxlsx.borderStyle}{"thin"} +#' \item{openxlsx.compressionLevel}{"9"} +#' \item{openxlsx.creator}{""} +#' \item{openxlsx.dateFormat}{"mm/dd/yyyy"} +#' \item{openxlsx.datetimeFormat}{"yyyy-mm-dd hh:mm:ss"} +#' \item{openxlsx.headerStyle}{NULL} +#' \item{openxlsx.keepNA}{FALSE} +#' \item{openxlsx.na.string}{NULL} +#' \item{openxlsx.numFmt}{NULL} +#' \item{openxlsx.orientation}{"portrait"} +#' \item{openxlsx.paperSize}{9} +#' \item{openxlsx.tabColour}{"TableStyleLight9"} +#' \item{openxlsx.tableStyle}{"TableStyleLight9"} +#' \item{openxlsx.withFilter}{NA Whether to write data with or without a +#' filter. If NA will make filters with `writeDataTable` and will not for +#' `writeData`} +#' } +#' +#' See the Formatting vignette for examples. +#' +#' Additional options +#' +#' + NULL + +#' openxlsx Options +#' +#' See and get the openxlsx options +#' +#' @details +#' +#' `openxlsx_getOp()` retrieves the `"openxlsx"` options found in +#' `op.openxlsx`. If none are set (currently `NULL`) retrieves the +#' default option from `op.openxlsx`. This will also check that the +#' intended option is a standard option (listed in `op.openxlsx`) and +#' will provide a warning otherwise. +#' +#' `openxlsx_setOp()` is a safer way to set an option as it will first +#' check that the option is a standard option (as above) before setting. +#' +#' @examples +#' openxlsx_getOp("borders") +#' op.openxlsx[["openxlsx.borders"]] +#' +#' @export +#' @name openxlsx_options +op.openxlsx <- list( + openxlsx.bandedCols = FALSE, + openxlsx.bandedRows = TRUE, + openxlsx.borderColour = "black", + openxlsx.borders = NULL, + openxlsx.borderStyle = "thin", + # Where is compressionLevel called? + openxlsx.compressionLevel = 9, + openxlsx.creator = "", + openxlsx.dateFormat = "mm/dd/yyyy", + openxlsx.datetimeFormat = "yyyy-mm-dd hh:mm:ss", + openxlsx.hdpi = 300, + openxlsx.header = NULL, + openxlsx.headerStyle = NULL, + openxlsx.firstColumn = NULL, + openxlsx.firstFooter = NULL, + openxlsx.firstHeader = NULL, + openxlsx.footer = NULL, + openxlsx.evenFooter = NULL, + openxlsx.evenHeader = NULL, + openxlsx.gridLines = TRUE, + openxlsx.keepNA = FALSE, + openxlsx.lastColumn = NULL, + openxlsx.na.string = NULL, + openxlsx.maxWidth = 250, + openxlsx.minWidth = 3, + openxlsx.numFmt = "GENERAL", + openxlsx.oddFooter = NULL, + openxlsx.oddHeader = NULL, + openxlsx.orientation = "portrait", + openxlsx.paperSize = 9, + openxlsx.showGridLines = NA, + openxlsx.tabColour = NULL, + openxlsx.tableStyle = "TableStyleLight9", + openxlsx.vdpi = 300, + openxlsx.withFilter = NULL +) + +#' @param x An option name (`"openxlsx."` prefix optional) +#' @param default A default value if `NULL` +#' @rdname openxlsx_options +#' @export +openxlsx_getOp <- function(x, default = NULL) { + if (length(x) != 1L || length(default) > 1L) { + stop("x must be length 1 and default NULL or length 1", call. = FALSE) + } + + x <- check_openxlsx_op(x) + getOption(x, op.openxlsx[[x]]) %||% default +} + +#' @param value The new value for the option (optional if x is a named list) +#' @rdname openxlsx_options +#' @export +openxlsx_setOp <- function(x, value) { + if (is.list(x)) { + if (is.null(names(x))) { + stop("x cannot be an unnamed list", call. = FALSE) + } + + return(invisible(mapply(openxlsx_setOp, x = names(x), value = x))) + } + + value <- as.list(value) + names(value) <- check_openxlsx_op(x) + options(value) +} + +check_openxlsx_op <- function(x) { + if (length(x) != 1L || !is.character(x)) { + stop("option must be a character vector of length 1", call. = FALSE) + } + + if (!grepl("^openxlsx[.]", x)) { + x <- paste0("openxlsx.", x) + } + + if (!x %in% names(op.openxlsx)) { + warning( + x, " is not a standard openxlsx option\nCheck spelling", + call. = FALSE + ) + } + + x +} + +openxlsx_resetOp <- function() { + options(op.openxlsx) +} diff -Nru r-cran-openxlsx-4.2.4/R/RcppExports.R r-cran-openxlsx-4.2.5/R/RcppExports.R --- r-cran-openxlsx-4.2.4/R/RcppExports.R 2021-06-09 10:54:22.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/RcppExports.R 2021-12-13 11:49:21.000000000 +0000 @@ -1,144 +1,144 @@ -# Generated by using Rcpp::compileAttributes() -> do not edit by hand -# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -calc_column_widths <- function(sheet_data, sharedStrings, autoColumns, widths, baseFontCharWidth, minW, maxW) { - .Call(`_openxlsx_calc_column_widths`, sheet_data, sharedStrings, autoColumns, widths, baseFontCharWidth, minW, maxW) -} - -convert_to_excel_ref <- function(cols, LETTERS) { - .Call(`_openxlsx_convert_to_excel_ref`, cols, LETTERS) -} - -convert_from_excel_ref <- function(x) { - .Call(`_openxlsx_convert_from_excel_ref`, x) -} - -convert_to_excel_ref_expand <- function(cols, LETTERS, rows) { - .Call(`_openxlsx_convert_to_excel_ref_expand`, cols, LETTERS, rows) -} - -isInternalHyperlink <- function(x) { - .Call(`_openxlsx_isInternalHyperlink`, x) -} - -write_file <- function(head = "", body = "", tail = "", fl = "") { - .Call(`_openxlsx_write_file`, head, body, tail, fl) -} - -cppReadFile <- function(xmlFile) { - .Call(`_openxlsx_cppReadFile`, xmlFile) -} - -read_file_newline <- function(xmlFile) { - .Call(`_openxlsx_read_file_newline`, xmlFile) -} - -get_letters <- function() { - .Call(`_openxlsx_get_letters`) -} - -markUTF8 <- function(x, clone) { - .Call(`_openxlsx_markUTF8`, x, clone) -} - -loadworksheets <- function(wb, styleObjects, xmlFiles, is_chart_sheet) { - .Call(`_openxlsx_loadworksheets`, wb, styleObjects, xmlFiles, is_chart_sheet) -} - -getNodes <- function(xml, tagIn) { - .Call(`_openxlsx_getNodes`, xml, tagIn) -} - -getOpenClosedNode <- function(xml, open_tag, close_tag) { - .Call(`_openxlsx_getOpenClosedNode`, xml, open_tag, close_tag) -} - -getAttr <- function(x, tag) { - .Call(`_openxlsx_getAttr`, x, tag) -} - -getChildlessNode_ss <- function(xml, tag) { - .Call(`_openxlsx_getChildlessNode_ss`, xml, tag) -} - -getChildlessNode <- function(xml, tag) { - .Call(`_openxlsx_getChildlessNode`, xml, tag) -} - -get_extLst_Major <- function(xml) { - .Call(`_openxlsx_get_extLst_Major`, xml) -} - -cell_ref_to_col <- function(x) { - .Call(`_openxlsx_cell_ref_to_col`, x) -} - -int_2_cell_ref <- function(cols) { - .Call(`_openxlsx_int_2_cell_ref`, cols) -} - -get_shared_strings <- function(xmlFile, isFile) { - .Call(`_openxlsx_get_shared_strings`, xmlFile, isFile) -} - -getCellInfo <- function(xmlFile, sharedStrings, skipEmptyRows, startRow, rows, getDates) { - .Call(`_openxlsx_getCellInfo`, xmlFile, sharedStrings, skipEmptyRows, startRow, rows, getDates) -} - -read_workbook <- function(cols_in, rows_in, v, string_inds, is_date, hasColNames, hasSepNames, skipEmptyRows, skipEmptyCols, nRows, clean_names) { - .Call(`_openxlsx_read_workbook`, cols_in, rows_in, v, string_inds, is_date, hasColNames, hasSepNames, skipEmptyRows, skipEmptyCols, nRows, clean_names) -} - -calc_number_rows <- function(x, skipEmptyRows) { - .Call(`_openxlsx_calc_number_rows`, x, skipEmptyRows) -} - -map_cell_types_to_integer <- function(t) { - .Call(`_openxlsx_map_cell_types_to_integer`, t) -} - -map_cell_types_to_char <- function(t) { - .Call(`_openxlsx_map_cell_types_to_char`, t) -} - -build_cell_types_integer <- function(classes, n_rows) { - .Call(`_openxlsx_build_cell_types_integer`, classes, n_rows) -} - -buildCellTypes <- function(classes, nRows) { - .Call(`_openxlsx_buildCellTypes`, classes, nRows) -} - -build_cell_merges <- function(comps) { - .Call(`_openxlsx_build_cell_merges`, comps) -} - -buildCellList <- function(r, t, v) { - .Call(`_openxlsx_buildCellList`, r, t, v) -} - -#' @import Rcpp -write_worksheet_xml <- function(prior, post, sheet_data, R_fileName) { - .Call(`_openxlsx_write_worksheet_xml`, prior, post, sheet_data, R_fileName) -} - -buildMatrixNumeric <- function(v, rowInd, colInd, colNames, nRows, nCols) { - .Call(`_openxlsx_buildMatrixNumeric`, v, rowInd, colInd, colNames, nRows, nCols) -} - -buildMatrixMixed <- function(v, rowInd, colInd, colNames, nRows, nCols, charCols, dateCols) { - .Call(`_openxlsx_buildMatrixMixed`, v, rowInd, colInd, colNames, nRows, nCols, charCols, dateCols) -} - -matrixRowInds <- function(indices) { - .Call(`_openxlsx_matrixRowInds`, indices) -} - -build_table_xml <- function(table, tableStyleXML, ref, colNames, showColNames, withFilter) { - .Call(`_openxlsx_build_table_xml`, table, tableStyleXML, ref, colNames, showColNames, withFilter) -} - -write_worksheet_xml_2 <- function(prior, post, sheet_data, row_heights_ = NULL, outline_levels_ = NULL, R_fileName = "output") { - .Call(`_openxlsx_write_worksheet_xml_2`, prior, post, sheet_data, row_heights_, outline_levels_, R_fileName) -} - +# Generated by using Rcpp::compileAttributes() -> do not edit by hand +# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 + +calc_column_widths <- function(sheet_data, sharedStrings, autoColumns, widths, baseFontCharWidth, minW, maxW) { + .Call(`_openxlsx_calc_column_widths`, sheet_data, sharedStrings, autoColumns, widths, baseFontCharWidth, minW, maxW) +} + +convert_to_excel_ref <- function(cols, LETTERS) { + .Call(`_openxlsx_convert_to_excel_ref`, cols, LETTERS) +} + +convert_from_excel_ref <- function(x) { + .Call(`_openxlsx_convert_from_excel_ref`, x) +} + +convert_to_excel_ref_expand <- function(cols, LETTERS, rows) { + .Call(`_openxlsx_convert_to_excel_ref_expand`, cols, LETTERS, rows) +} + +isInternalHyperlink <- function(x) { + .Call(`_openxlsx_isInternalHyperlink`, x) +} + +write_file <- function(head = "", body = "", tail = "", fl = "") { + .Call(`_openxlsx_write_file`, head, body, tail, fl) +} + +cppReadFile <- function(xmlFile) { + .Call(`_openxlsx_cppReadFile`, xmlFile) +} + +read_file_newline <- function(xmlFile) { + .Call(`_openxlsx_read_file_newline`, xmlFile) +} + +get_letters <- function() { + .Call(`_openxlsx_get_letters`) +} + +markUTF8 <- function(x, clone) { + .Call(`_openxlsx_markUTF8`, x, clone) +} + +loadworksheets <- function(wb, styleObjects, xmlFiles, is_chart_sheet) { + .Call(`_openxlsx_loadworksheets`, wb, styleObjects, xmlFiles, is_chart_sheet) +} + +getNodes <- function(xml, tagIn) { + .Call(`_openxlsx_getNodes`, xml, tagIn) +} + +getOpenClosedNode <- function(xml, open_tag, close_tag) { + .Call(`_openxlsx_getOpenClosedNode`, xml, open_tag, close_tag) +} + +getAttr <- function(x, tag) { + .Call(`_openxlsx_getAttr`, x, tag) +} + +getChildlessNode_ss <- function(xml, tag) { + .Call(`_openxlsx_getChildlessNode_ss`, xml, tag) +} + +getChildlessNode <- function(xml, tag) { + .Call(`_openxlsx_getChildlessNode`, xml, tag) +} + +get_extLst_Major <- function(xml) { + .Call(`_openxlsx_get_extLst_Major`, xml) +} + +cell_ref_to_col <- function(x) { + .Call(`_openxlsx_cell_ref_to_col`, x) +} + +int_2_cell_ref <- function(cols) { + .Call(`_openxlsx_int_2_cell_ref`, cols) +} + +get_shared_strings <- function(xmlFile, isFile) { + .Call(`_openxlsx_get_shared_strings`, xmlFile, isFile) +} + +getCellInfo <- function(xmlFile, sharedStrings, skipEmptyRows, startRow, rows, getDates) { + .Call(`_openxlsx_getCellInfo`, xmlFile, sharedStrings, skipEmptyRows, startRow, rows, getDates) +} + +read_workbook <- function(cols_in, rows_in, v, string_inds, is_date, hasColNames, hasSepNames, skipEmptyRows, skipEmptyCols, nRows, clean_names) { + .Call(`_openxlsx_read_workbook`, cols_in, rows_in, v, string_inds, is_date, hasColNames, hasSepNames, skipEmptyRows, skipEmptyCols, nRows, clean_names) +} + +calc_number_rows <- function(x, skipEmptyRows) { + .Call(`_openxlsx_calc_number_rows`, x, skipEmptyRows) +} + +map_cell_types_to_integer <- function(t) { + .Call(`_openxlsx_map_cell_types_to_integer`, t) +} + +map_cell_types_to_char <- function(t) { + .Call(`_openxlsx_map_cell_types_to_char`, t) +} + +build_cell_types_integer <- function(classes, n_rows) { + .Call(`_openxlsx_build_cell_types_integer`, classes, n_rows) +} + +buildCellTypes <- function(classes, nRows) { + .Call(`_openxlsx_buildCellTypes`, classes, nRows) +} + +build_cell_merges <- function(comps) { + .Call(`_openxlsx_build_cell_merges`, comps) +} + +buildCellList <- function(r, t, v) { + .Call(`_openxlsx_buildCellList`, r, t, v) +} + +#' @import Rcpp +write_worksheet_xml <- function(prior, post, sheet_data, R_fileName) { + .Call(`_openxlsx_write_worksheet_xml`, prior, post, sheet_data, R_fileName) +} + +buildMatrixNumeric <- function(v, rowInd, colInd, colNames, nRows, nCols) { + .Call(`_openxlsx_buildMatrixNumeric`, v, rowInd, colInd, colNames, nRows, nCols) +} + +buildMatrixMixed <- function(v, rowInd, colInd, colNames, nRows, nCols, charCols, dateCols) { + .Call(`_openxlsx_buildMatrixMixed`, v, rowInd, colInd, colNames, nRows, nCols, charCols, dateCols) +} + +matrixRowInds <- function(indices) { + .Call(`_openxlsx_matrixRowInds`, indices) +} + +build_table_xml <- function(table, tableStyleXML, ref, colNames, showColNames, withFilter) { + .Call(`_openxlsx_build_table_xml`, table, tableStyleXML, ref, colNames, showColNames, withFilter) +} + +write_worksheet_xml_2 <- function(prior, post, sheet_data, row_heights_ = NULL, outline_levels_ = NULL, R_fileName = "output") { + .Call(`_openxlsx_write_worksheet_xml_2`, prior, post, sheet_data, row_heights_, outline_levels_, R_fileName) +} + diff -Nru r-cran-openxlsx-4.2.4/R/readWorkbook.R r-cran-openxlsx-4.2.5/R/readWorkbook.R --- r-cran-openxlsx-4.2.4/R/readWorkbook.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/readWorkbook.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,609 +1,607 @@ - - - - -#' @name read.xlsx -#' @title Read from an Excel file or Workbook object -#' @description Read data from an Excel file or Workbook object into a data.frame -#' @param xlsxFile An xlsx file, Workbook object or URL to xlsx file. -#' @param sheet The name or index of the sheet to read data from. -#' @param startRow first row to begin looking for data. Empty rows at the top of a file are always skipped, -#' regardless of the value of startRow. -#' @param colNames If \code{TRUE}, the first row of data will be used as column names. -#' @param skipEmptyRows If \code{TRUE}, empty rows are skipped else empty rows after the first row containing data -#' will return a row of NAs. -#' @param rowNames If \code{TRUE}, first column of data will be used as row names. -#' @param detectDates If \code{TRUE}, attempt to recognise dates and perform conversion. -#' @param cols A numeric vector specifying which columns in the Excel file to read. -#' If NULL, all columns are read. -#' @param rows A numeric vector specifying which rows in the Excel file to read. -#' If NULL, all rows are read. -#' @param check.names logical. If TRUE then the names of the variables in the data frame -#' are checked to ensure that they are syntactically valid variable names -#' @param sep.names One character which substitutes blanks in column names. By default, "." -#' @param namedRegion A named region in the Workbook. If not NULL startRow, rows and cols parameters are ignored. -#' @param na.strings A character vector of strings which are to be interpreted as NA. Blank cells will be returned as NA. -#' @param fillMergedCells If TRUE, the value in a merged cell is given to all cells within the merge. -#' @param skipEmptyCols If \code{TRUE}, empty columns are skipped. -#' @seealso \code{\link{getNamedRegions}} -#' @details Formulae written using writeFormula to a Workbook object will not get picked up by read.xlsx(). -#' This is because only the formula is written and left to be evaluated when the file is opened in Excel. -#' Opening, saving and closing the file with Excel will resolve this. -#' @author Alexander Walker -#' @return data.frame -#' @export -#' @examples -#' -#' xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") -#' df1 <- read.xlsx(xlsxFile = xlsxFile, sheet = 1, skipEmptyRows = FALSE) -#' sapply(df1, class) -#' -#' df2 <- read.xlsx(xlsxFile = xlsxFile, sheet = 3, skipEmptyRows = TRUE) -#' df2$Date <- convertToDate(df2$Date) -#' sapply(df2, class) -#' head(df2) -#' -#' df2 <- read.xlsx( -#' xlsxFile = xlsxFile, sheet = 3, skipEmptyRows = TRUE, -#' detectDates = TRUE -#' ) -#' sapply(df2, class) -#' head(df2) -#' -#' wb <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -#' df3 <- read.xlsx(wb, sheet = 2, skipEmptyRows = FALSE, colNames = TRUE) -#' df4 <- read.xlsx(xlsxFile, sheet = 2, skipEmptyRows = FALSE, colNames = TRUE) -#' all.equal(df3, df4) -#' -#' wb <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -#' df3 <- read.xlsx(wb, -#' sheet = 2, skipEmptyRows = FALSE, -#' cols = c(1, 4), rows = c(1, 3, 4) -#' ) -#' -#' ## URL -#' ## -#' \dontrun{ -#' xlsxFile <- "https://github.com/awalker89/openxlsx/raw/master/inst/readTest.xlsx" -#' head(read.xlsx(xlsxFile)) -#' } -#' -#' @export -read.xlsx <- function( - xlsxFile, - sheet, - startRow = 1, - colNames = TRUE, - rowNames = FALSE, - detectDates = FALSE, - skipEmptyRows = TRUE, - skipEmptyCols = TRUE, - rows = NULL, - cols = NULL, - check.names = FALSE, - sep.names = ".", - namedRegion = NULL, - na.strings = "NA", - fillMergedCells = FALSE -) { - UseMethod("read.xlsx", xlsxFile) -} - -#' @export -read.xlsx.default <- function( - xlsxFile, - sheet, - startRow = 1, - colNames = TRUE, - rowNames = FALSE, - detectDates = FALSE, - skipEmptyRows = TRUE, - skipEmptyCols = TRUE, - rows = NULL, - cols = NULL, - check.names = FALSE, - sep.names = ".", - namedRegion = NULL, - na.strings = "NA", - fillMergedCells = FALSE -) { - ## Validate inputs and get files - xlsxFile <- getFile(xlsxFile) - - if (!file.exists(xlsxFile)) { - stop("File does not exist.") - } - - sheetselected <- TRUE - if (missing(sheet)) { - sheet <- 1 - sheetselected <- FALSE - } - - if (!grepl("\\.xlsx$", xlsxFile)) { - stop("openxlsx can only read .xlsx files", call. = FALSE) - } - - assert_true_false1(colNames) - assert_true_false1(rowNames) - assert_true_false1(detectDates) - assert_true_false1(skipEmptyRows) - assert_true_false1(check.names) - assert_character1(sep.names, scalar = TRUE) - assert_length(sheet, 1L) - assert_length(startRow, 1L) - - if (is.null(rows)) { - rows <- NA - } else if (length(rows) > 1L) { - rows <- as.integer(sort(rows)) - } - - xmlDir <- - file.path(tempdir(), paste0(sample(LETTERS, 10), collapse = ""), "_excelXMLRead") - xmlFiles <- unzip(xlsxFile, exdir = xmlDir) - - on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE) - - sharedStringsFile <- grep("sharedStrings.xml$", xmlFiles, perl = TRUE, value = TRUE) - workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) - workbookRelsXML <- grep("workbook.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) - - ## get workbook names - workbookRelsXML <- paste(readUTF8(workbookRelsXML), collapse = "") - workbookRelsXML <- getChildlessNode(xml = workbookRelsXML, tag = "Relationship") - - workbook <- unlist(readUTF8(workbook)) - workbook <- removeHeadTag(workbook) - - sheets <- unlist(regmatches( - workbook, - gregexpr("(?<=).*(?=)", workbook, perl = TRUE) - )) - sheets <- unlist(regmatches( - sheets, - gregexpr("]*>", sheets, perl = TRUE) - )) - ## Some veryHidden sheets do not have a sheet content and their rId is empty. - ## Such sheets need to be filtered out because otherwise their sheet names - ## occur in the list of all sheet names, leading to a wrong association - ## of sheet names with sheet indeces. - sheets <- grep('r:id="[[:blank:]]*"', sheets, invert = TRUE, value = TRUE) - - - ## make sure sheetId is 1 based - sheetrId <- unlist(getRId(sheets)) - sheetNames <- unlist(regmatches( - sheets, - gregexpr('(?<=name=")[^"]+', sheets, perl = TRUE) - )) - sheetNames <- replaceXMLEntities(sheetNames) - - - nSheets <- length(sheetrId) - if (nSheets == 0) { - stop("Workbook has no worksheets") - } - - ## Named region logic - reading_named_region <- FALSE - if (!is.null(namedRegion)) { - dn <- getNodes(xml = workbook, tagIn = "") - dn <- unlist(regmatches(dn, gregexpr("' and '!' - dn_sheetNames <- gsub(".*[>]([^.]+)[!].*", "\\1", dn) - - # Check if there are any whitespaces in dn_sheetNames. - # Hint: sheet names must not contain: \ / ? * [ ] - wsp <- grepl(pattern = "'", dn_sheetNames) - if (any(wsp)) { - # sheetNames in between ''' and '''. If there is a whitespace in a sheet - # name, the name will be "'sheet 1'" instead of "sheet 1. - dn_sheetNames[wsp] <- gsub("^'+|'+$", "\\1", dn_sheetNames[wsp]) - } - - # namedRegion in between 'name="' and '"' - dn_namedRegion <- gsub(".*name=\"(\\w+)\".*", "\\1", dn) - - if (length(dn) == 0) { - warning("Workbook has no named region.") - return(invisible(NULL)) - } - - if (all(dn_namedRegion != namedRegion)) { - warning("Workbook has no such named region.") - return(invisible(NULL)) - } - - idx <- match(dn_namedRegion, namedRegion) - - # make sure that the length of both vectors is identical - dn <- dn[!is.na(idx)] - dn_namedRegion <- dn_namedRegion[!is.na(idx)] - dn_sheetNames <- dn_sheetNames[!is.na(idx)] - - # a sheet was selected - if (sheetselected) { - idx <- match(dn_sheetNames, sheetNames) - if (is.numeric(sheet)) { - idx <- which(idx == sheet) - - } else { - idx <- which(dn_sheetNames == sheet) - } - dn <- dn[idx] - - if (length(dn) > 1) { - warning("unexpectedly found more than one dn.") - print(dn) - return(invisible(NULL)) - } - - if ( identical(dn, character(0)) ) { - warning("Workbook has no such named region on this sheet.") - return(invisible(NULL)) - } - } - - # Do not print warning if a specific sheet is requested - if ((length(dn) > 1) & (!sheetselected)) { - msg <- c(sprintf("Region '%s' found on multiple sheets: \n", namedRegion), - paste(dn_sheetNames, collapse = "\n"), - "\nUsing the first appearance.") - message(msg) - - dn <- dn[1] - dn_namedRegion <- dn_namedRegion[1] - dn_sheetNames <- dn_sheetNames[1] - } - - # region is redefined later - region <- regmatches(dn, regexpr("(?<=>)[^\\<]+", dn, perl = TRUE)) - sheet <- sheetNames[vapply(sheetNames, grepl, NA, dn)] - - if (length(sheet) > 1) { - sheet <- sheet[which.max(nchar(sheet))] - } - - region <- gsub("[^A-Z0-9:]", "", gsub(sheet, "", region, fixed = TRUE)) - - if (grepl(":", region, fixed = TRUE)) { - cols <- unlist(lapply( - strsplit(region, split = ":", fixed = TRUE), - convertFromExcelRef - )) - rows <- unlist(lapply(strsplit(region, split = ":", fixed = TRUE), function(x) { - as.integer(gsub("[A-Z]", "", x, perl = TRUE)) - })) - cols <- seq.int(min(cols), max(cols)) - rows <- seq.int(min(rows), max(rows)) - } else { - cols <- convertFromExcelRef(region) - rows <- as.integer(gsub("[A-Z]", "", region, perl = TRUE)) - } - - startRow <- 1 - reading_named_region <- TRUE - } - - ## get the file_name for each sheetrId - file_name <- sapply(sheetrId, function(rId) { - txt <- grep(sprintf('Id="%s"', rId), workbookRelsXML, fixed = TRUE, value = TRUE) - regmatches(txt, regexpr('(?<=Target=").+xml(?=")', txt, perl = TRUE)) - }) - - - ## get the correct sheets - if (is.character(sheet)) { - sheetNames <- replaceXMLEntities(sheetNames) - sheetInd <- which(sheetNames == sheet) - if (length(sheetInd) == 0) { - stop(sprintf('Cannot find sheet named "%s"', sheet)) - } - sheet <- file_name[sheetInd] - } else { - if (nSheets < sheet) { - stop(sprintf("sheet %s does not exist.", sheet)) - } - sheet <- file_name[sheet] - } - - if (length(sheet) == 0) { - stop("Length of sheet is 0", call. = FALSE) - } - - ## get file - worksheet <- xmlFiles[grepl(tolower(sheet), tolower(xmlFiles), fixed = TRUE)] - if (length(worksheet) == 0) { - stop("Length of worksheet is 0", call. = FALSE) - } - - ## read in sharedStrings - if (length(sharedStringsFile) > 0) { - sharedStrings <- - getSharedStringsFromFile(sharedStringsFile = sharedStringsFile, isFile = TRUE) - if (!is.null(na.strings)) { - sharedStrings[is.na(sharedStrings) | sharedStrings %in% na.strings] <- "openxlsx_na_vlu" - } - } else { - sharedStrings <- "" - } - - if (is.character(startRow)) { - startRowStr <- startRow - startRow <- 1 - } else { - startRowStr <- NULL - } - - ## single function get all r, s (if detect dates is TRUE), t, v - cell_info <- getCellInfo( - xmlFile = worksheet, - sharedStrings = sharedStrings, - skipEmptyRows = skipEmptyRows, - startRow = startRow, - rows = rows, - getDates = detectDates - ) - - if (fillMergedCells & length(cell_info$cellMerge) > 0) { - # stop("Not implemented") - - merge_mapping <- mergeCell2mapping(cell_info$cellMerge) - - ## remove any elements from r, string_refs, b, s that existing in merge_mapping - ## insert all missing refs into r - - to_remove_inds <- cell_info$r %in% merge_mapping$ref - to_remove_elems <- cell_info$r[to_remove_inds] - - if (any(to_remove_inds)) { - cell_info$r <- cell_info$r[!to_remove_inds] - cell_info$s <- cell_info$s[!to_remove_inds] - cell_info$v <- cell_info$v[!to_remove_inds] - cell_info$string_refs <- - cell_info$string_refs[!cell_info$string_refs %in% to_remove_elems] - } - - ## Now insert - inds <- match(merge_mapping$anchor_cell, cell_info$r) - - ## String refs (must sort) - new_string_refs <- - merge_mapping$ref[merge_mapping$anchor_cell %in% cell_info$string_refs] - cell_info$string_refs <- - c(cell_info$string_refs, new_string_refs) - cell_info$string_refs <- - cell_info$string_refs[order( - as.integer(gsub("[A-Z]", "", cell_info$string_refs, perl = TRUE)), - nchar(cell_info$string_refs), - cell_info$string_refs - )] - - ## r - cell_info$r <- c(cell_info$r, merge_mapping$ref) - cell_info$v <- c(cell_info$v, cell_info$v[inds]) - - ord <- order( - as.integer(gsub("[A-Z]", "", cell_info$r, perl = TRUE)), - nchar(cell_info$r), - cell_info$r - ) - - cell_info$r <- cell_info$r[ord] - cell_info$v <- cell_info$v[ord] - - if (length(cell_info$s) > 0) { - cell_info$s <- c(cell_info$s, cell_info$s[inds])[ord] - } - - cell_info$nRows <- calc_number_rows(x = cell_info$r, skipEmptyRows = skipEmptyRows) - } - - cell_rows <- as.integer(gsub("[A-Z]", "", cell_info$r, perl = TRUE)) - cell_cols <- convert_from_excel_ref(x = cell_info$r) - - ## subsetting ---- - ## Remove cells where cell is NA (na.strings or empty sharedString '') - - if (length(cell_info$v) == 0) { - warning("No data found on worksheet.\n", call. = FALSE) - return(NULL) - } - - keep <- !is.na(cell_info$v) - if (!is.null(cols)) { - keep <- keep & (cell_cols %in% cols) - } - - ## End of subsetting - - ## Subset - cell_rows <- cell_rows[keep] - cell_cols <- cell_cols[keep] - - v <- cell_info$v[keep] - s <- cell_info$s[keep] - - string_refs <- match(cell_info$string_refs, cell_info$r[keep]) - string_refs <- string_refs[!is.na(string_refs)] - - if (skipEmptyRows) { - nRows <- length(unique(cell_rows)) - } else if (reading_named_region) { - ## keep region the correct size - nRows <- max(rows) - min(rows) + 1 - } else { - nRows <- max(cell_rows) - min(cell_rows) + 1 - } - - if (nRows == 0 | length(cell_rows) == 0) { - warning("No data found on worksheet.", call. = FALSE) - return(NULL) - } - - Encoding(v) <- "UTF-8" ## only works if length(v) > 0 - - if (!is.null(startRowStr)) { - stop("startRowStr not implemented") - ind <- grep(startRowStr, v, ignore.case = TRUE) - if (length(ind) > 0) { - startRow <- as.numeric(gsub("[A-Z]", "", r[ind[[1]]])) - toKeep <- grep(sprintf("[A-Z]%s$", startRow), r)[[1]] - if (toKeep > 1) { - toRemove <- 1:(toKeep - 1) - string_refs <- string_refs[!string_refs %in% r[toRemove]] - v <- v[-toRemove] - r <- r[-toRemove] - nRows <- - calc_number_rows(x = r, skipEmptyRows = skipEmptyRows) - } - } - } - - ## Determine date cells (if required) - origin <- 25569L - if (detectDates) { - ## get date origin - if (grepl('date1904="1"|date1904="true"', workbook, ignore.case = TRUE)) { - origin <- 24107L - } - - stylesXML <- grep("styles.xml", xmlFiles, value = TRUE) - styles <- readUTF8(stylesXML) - styles <- removeHeadTag(styles) - - ## Number formats - numFmts <- getChildlessNode(xml = styles, tag = "numFmt") - - dateIds <- NULL - if (length(numFmts) > 0) { - numFmtsIds <- sapply(numFmts, getAttr, tag = 'numFmtId="', USE.NAMES = FALSE) - formatCodes <- sapply(numFmts, getAttr, tag = 'formatCode="', USE.NAMES = FALSE) - formatCodes <- gsub(".*(?<=\\])|@", "", formatCodes, perl = TRUE) - - ## this regex defines what "looks" like a date - dateIds <- numFmtsIds[!grepl("[^mdyhsapAMP[:punct:] ]", formatCodes) & - nchar(formatCodes > 3)] - } - - dateIds <- c(dateIds, 14) - - ## which styles are using these dateIds - cellXfs <- getNodes(xml = styles, tagIn = " 1L) { + rows <- as.integer(sort(rows)) + } + + xmlDir <- paste0(tempfile(), "_excelXMLRead") + xmlFiles <- unzip(xlsxFile, exdir = xmlDir) + on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE) + + sharedStringsFile <- grep("sharedStrings.xml$", xmlFiles, perl = TRUE, value = TRUE) + workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) + workbookRelsXML <- grep("workbook.xml.rels$", xmlFiles, perl = TRUE, value = TRUE) + + ## get workbook names + workbookRelsXML <- paste(readUTF8(workbookRelsXML), collapse = "") + workbookRelsXML <- getChildlessNode(xml = workbookRelsXML, tag = "Relationship") + + workbook <- unlist(readUTF8(workbook)) + workbook <- removeHeadTag(workbook) + + sheets <- unlist(regmatches( + workbook, + gregexpr("(?<=).*(?=)", workbook, perl = TRUE) + )) + sheets <- unlist(regmatches( + sheets, + gregexpr("]*>", sheets, perl = TRUE) + )) + ## Some veryHidden sheets do not have a sheet content and their rId is empty. + ## Such sheets need to be filtered out because otherwise their sheet names + ## occur in the list of all sheet names, leading to a wrong association + ## of sheet names with sheet indeces. + sheets <- grep('r:id="[[:blank:]]*"', sheets, invert = TRUE, value = TRUE) + + + ## make sure sheetId is 1 based + sheetrId <- unlist(getRId(sheets)) + sheetNames <- unlist(regmatches( + sheets, + gregexpr('(?<=name=")[^"]+', sheets, perl = TRUE) + )) + sheetNames <- replaceXMLEntities(sheetNames) + + + nSheets <- length(sheetrId) + if (nSheets == 0) { + stop("Workbook has no worksheets") + } + + ## Named region logic + reading_named_region <- FALSE + if (!is.null(namedRegion)) { + dn <- getNodes(xml = workbook, tagIn = "") + dn <- unlist(regmatches(dn, gregexpr("' and '!' + dn_sheetNames <- gsub(".*[>]([^.]+)[!].*", "\\1", dn) + + # Check if there are any whitespaces in dn_sheetNames. + # Hint: sheet names must not contain: \ / ? * [ ] + wsp <- grepl(pattern = "'", dn_sheetNames) + if (any(wsp)) { + # sheetNames in between ''' and '''. If there is a whitespace in a sheet + # name, the name will be "'sheet 1'" instead of "sheet 1. + dn_sheetNames[wsp] <- gsub("^'+|'+$", "\\1", dn_sheetNames[wsp]) + } + + # namedRegion in between 'name="' and '"' + dn_namedRegion <- gsub(".*name=\"(\\w+)\".*", "\\1", dn) + + if (length(dn) == 0) { + warning("Workbook has no named region.") + return(invisible(NULL)) + } + + if (all(dn_namedRegion != namedRegion)) { + warning("Workbook has no such named region.") + return(invisible(NULL)) + } + + idx <- match(dn_namedRegion, namedRegion) + + # make sure that the length of both vectors is identical + dn <- dn[!is.na(idx)] + dn_namedRegion <- dn_namedRegion[!is.na(idx)] + dn_sheetNames <- dn_sheetNames[!is.na(idx)] + + # a sheet was selected + if (sheetselected) { + idx <- match(dn_sheetNames, sheetNames) + if (is.numeric(sheet)) { + idx <- which(idx == sheet) + + } else { + idx <- which(dn_sheetNames == sheet) + } + dn <- dn[idx] + + if (length(dn) > 1) { + warning("unexpectedly found more than one dn.") + print(dn) + return(invisible(NULL)) + } + + if ( identical(dn, character(0)) ) { + warning("Workbook has no such named region on this sheet.") + return(invisible(NULL)) + } + } + + # Do not print warning if a specific sheet is requested + if ((length(dn) > 1) & (!sheetselected)) { + msg <- c(sprintf("Region '%s' found on multiple sheets: \n", namedRegion), + paste(dn_sheetNames, collapse = "\n"), + "\nUsing the first appearance.") + message(msg) + + dn <- dn[1] + dn_namedRegion <- dn_namedRegion[1] + dn_sheetNames <- dn_sheetNames[1] + } + + # region is redefined later + region <- regmatches(dn, regexpr("(?<=>)[^\\<]+", dn, perl = TRUE)) + sheet <- sheetNames[vapply(sheetNames, grepl, NA, dn)] + + if (length(sheet) > 1) { + sheet <- sheet[which.max(nchar(sheet))] + } + + region <- gsub("[^A-Z0-9:]", "", gsub(sheet, "", region, fixed = TRUE)) + + if (grepl(":", region, fixed = TRUE)) { + cols <- unlist(lapply( + strsplit(region, split = ":", fixed = TRUE), + convertFromExcelRef + )) + rows <- unlist(lapply(strsplit(region, split = ":", fixed = TRUE), function(x) { + as.integer(gsub("[A-Z]", "", x, perl = TRUE)) + })) + cols <- seq.int(min(cols), max(cols)) + rows <- seq.int(min(rows), max(rows)) + } else { + cols <- convertFromExcelRef(region) + rows <- as.integer(gsub("[A-Z]", "", region, perl = TRUE)) + } + + startRow <- 1 + reading_named_region <- TRUE + } + + ## get the file_name for each sheetrId + file_name <- sapply(sheetrId, function(rId) { + txt <- grep(sprintf('Id="%s"', rId), workbookRelsXML, fixed = TRUE, value = TRUE) + regmatches(txt, regexpr('(?<=Target=").+xml(?=")', txt, perl = TRUE)) + }) + + + ## get the correct sheets + if (is.character(sheet)) { + sheetNames <- replaceXMLEntities(sheetNames) + sheetInd <- which(sheetNames == sheet) + if (length(sheetInd) == 0) { + stop(sprintf('Cannot find sheet named "%s"', sheet)) + } + sheet <- file_name[sheetInd] + } else { + if (nSheets < sheet) { + stop(sprintf("sheet %s does not exist.", sheet)) + } + sheet <- file_name[sheet] + } + + if (length(sheet) == 0) { + stop("Length of sheet is 0", call. = FALSE) + } + + ## get file + worksheet <- xmlFiles[grepl(tolower(sheet), tolower(xmlFiles), fixed = TRUE)] + if (length(worksheet) == 0) { + stop("Length of worksheet is 0", call. = FALSE) + } + + ## read in sharedStrings + if (length(sharedStringsFile) > 0) { + sharedStrings <- + getSharedStringsFromFile(sharedStringsFile = sharedStringsFile, isFile = TRUE) + if (!is.null(na.strings)) { + sharedStrings[is.na(sharedStrings) | sharedStrings %in% na.strings] <- "openxlsx_na_vlu" + } + } else { + sharedStrings <- "" + } + + if (is.character(startRow)) { + startRowStr <- startRow + startRow <- 1 + } else { + startRowStr <- NULL + } + + ## single function get all r, s (if detect dates is TRUE), t, v + cell_info <- getCellInfo( + xmlFile = worksheet, + sharedStrings = sharedStrings, + skipEmptyRows = skipEmptyRows, + startRow = startRow, + rows = rows, + getDates = detectDates + ) + + if (fillMergedCells & length(cell_info$cellMerge) > 0) { + # stop("Not implemented") + + merge_mapping <- mergeCell2mapping(cell_info$cellMerge) + + ## remove any elements from r, string_refs, b, s that existing in merge_mapping + ## insert all missing refs into r + + to_remove_inds <- cell_info$r %in% merge_mapping$ref + to_remove_elems <- cell_info$r[to_remove_inds] + + if (any(to_remove_inds)) { + cell_info$r <- cell_info$r[!to_remove_inds] + cell_info$s <- cell_info$s[!to_remove_inds] + cell_info$v <- cell_info$v[!to_remove_inds] + cell_info$string_refs <- + cell_info$string_refs[!cell_info$string_refs %in% to_remove_elems] + } + + ## Now insert + inds <- match(merge_mapping$anchor_cell, cell_info$r) + + ## String refs (must sort) + new_string_refs <- + merge_mapping$ref[merge_mapping$anchor_cell %in% cell_info$string_refs] + cell_info$string_refs <- + c(cell_info$string_refs, new_string_refs) + cell_info$string_refs <- + cell_info$string_refs[order( + as.integer(gsub("[A-Z]", "", cell_info$string_refs, perl = TRUE)), + nchar(cell_info$string_refs), + cell_info$string_refs + )] + + ## r + cell_info$r <- c(cell_info$r, merge_mapping$ref) + cell_info$v <- c(cell_info$v, cell_info$v[inds]) + + ord <- order( + as.integer(gsub("[A-Z]", "", cell_info$r, perl = TRUE)), + nchar(cell_info$r), + cell_info$r + ) + + cell_info$r <- cell_info$r[ord] + cell_info$v <- cell_info$v[ord] + + if (length(cell_info$s) > 0) { + cell_info$s <- c(cell_info$s, cell_info$s[inds])[ord] + } + + cell_info$nRows <- calc_number_rows(x = cell_info$r, skipEmptyRows = skipEmptyRows) + } + + cell_rows <- as.integer(gsub("[A-Z]", "", cell_info$r, perl = TRUE)) + cell_cols <- convert_from_excel_ref(x = cell_info$r) + + ## subsetting ---- + ## Remove cells where cell is NA (na.strings or empty sharedString '') + + if (length(cell_info$v) == 0) { + warning("No data found on worksheet.\n", call. = FALSE) + return(NULL) + } + + keep <- !is.na(cell_info$v) + if (!is.null(cols)) { + keep <- keep & (cell_cols %in% cols) + } + + ## End of subsetting + + ## Subset + cell_rows <- cell_rows[keep] + cell_cols <- cell_cols[keep] + + v <- cell_info$v[keep] + s <- cell_info$s[keep] + + string_refs <- match(cell_info$string_refs, cell_info$r[keep]) + string_refs <- string_refs[!is.na(string_refs)] + + if (skipEmptyRows) { + nRows <- length(unique(cell_rows)) + } else if (reading_named_region) { + ## keep region the correct size + nRows <- max(rows) - min(rows) + 1 + } else { + nRows <- max(cell_rows) - min(cell_rows) + 1 + } + + if (nRows == 0 | length(cell_rows) == 0) { + warning("No data found on worksheet.", call. = FALSE) + return(NULL) + } + + Encoding(v) <- "UTF-8" ## only works if length(v) > 0 + + if (!is.null(startRowStr)) { + stop("startRowStr not implemented") + ind <- grep(startRowStr, v, ignore.case = TRUE) + if (length(ind) > 0) { + startRow <- as.numeric(gsub("[A-Z]", "", r[ind[[1]]])) + toKeep <- grep(sprintf("[A-Z]%s$", startRow), r)[[1]] + if (toKeep > 1) { + toRemove <- 1:(toKeep - 1) + string_refs <- string_refs[!string_refs %in% r[toRemove]] + v <- v[-toRemove] + r <- r[-toRemove] + nRows <- + calc_number_rows(x = r, skipEmptyRows = skipEmptyRows) + } + } + } + + ## Determine date cells (if required) + origin <- 25569L + if (detectDates) { + ## get date origin + if (grepl('date1904="1"|date1904="true"', workbook, ignore.case = TRUE)) { + origin <- 24107L + } + + stylesXML <- grep("styles.xml", xmlFiles, value = TRUE) + styles <- readUTF8(stylesXML) + styles <- removeHeadTag(styles) + + ## Number formats + numFmts <- getChildlessNode(xml = styles, tag = "numFmt") + + dateIds <- NULL + if (length(numFmts) > 0) { + numFmtsIds <- sapply(numFmts, getAttr, tag = 'numFmtId="', USE.NAMES = FALSE) + formatCodes <- sapply(numFmts, getAttr, tag = 'formatCode="', USE.NAMES = FALSE) + formatCodes <- gsub(".*(?<=\\])|@", "", formatCodes, perl = TRUE) + + ## this regex defines what "looks" like a date + dateIds <- numFmtsIds[!grepl("[^mdyhsapAMP[:punct:] ]", formatCodes) & + nchar(formatCodes > 3)] + } + + dateIds <- c(dateIds, 14) + + ## which styles are using these dateIds + cellXfs <- getNodes(xml = styles, tagIn = " 0) { ## writing over existing data - - rows <<- rows[-inds] - cols <<- cols[-inds] - t <<- t[-inds] - v <<- v[-inds] - f <<- f[-inds] - - n_elements <<- as.integer(length(rows)) - - if (n_elements == 0) { - data_count <<- 0L - } - } -}) - - - -Sheet_Data$methods(write = function(rows_in, cols_in, t_in, v_in, f_in, any_functions = TRUE) { - if (length(rows_in) == 0 | length(cols_in) == 0) { - return(invisible(0)) - } - - - possible_overlap <- FALSE - if (n_elements > 0) { - possible_overlap <- (min(cols_in, na.rm = TRUE) <= max(cols, na.rm = TRUE)) & - (max(cols_in, na.rm = TRUE) >= min(cols, na.rm = TRUE)) & - (min(rows_in, na.rm = TRUE) <= max(rows, na.rm = TRUE)) & - (max(rows_in, na.rm = TRUE) >= min(rows, na.rm = TRUE)) - } - - n <- length(cols_in) - cols_in <- rep.int(cols_in, times = length(rows_in)) - rows_in <- rep(rows_in, each = n) - - if (any_functions) { - if (any(!is.na(f_in))) { - v_in[!is.na(f_in)] <- as.character(NA) - t_in[!is.na(f_in)] <- 3L ## "str" - } - } - - inds <- integer(0) - if (possible_overlap) { - inds <- which(paste(rows, cols, sep = ",") %in% paste(rows_in, cols_in, sep = ",")) - } - - if (length(inds) > 0) { - rows <<- c(rows[-inds], rows_in) - cols <<- c(cols[-inds], cols_in) - t <<- c(t[-inds], t_in) - v <<- c(v[-inds], v_in) - f <<- c(f[-inds], f_in) - } else { - rows <<- c(rows, rows_in) - cols <<- c(cols, cols_in) - t <<- c(t, t_in) - v <<- c(v, v_in) - f <<- c(f, f_in) - } - - n_elements <<- as.integer(length(rows)) - data_count <<- data_count + 1L -}) + + +#' @include class_definitions.R + +Sheet_Data$methods(initialize = function() { + rows <<- integer(0) + cols <<- integer(0) + + t <<- integer(0) + v <<- character(0) + f <<- character(0) + + style_id <<- character(0) + + data_count <<- 0L + n_elements <<- 0L +}) + + + +Sheet_Data$methods(delete = function(rows_in, cols_in, grid_expand) { + cols_in <- convertFromExcelRef(cols_in) + rows_in <- as.integer(rows_in) + + ## rows and cols need to be the same length + if (grid_expand) { + n <- length(rows_in) + rows_in <- rep.int(rows_in, times = length(cols_in)) + cols_in <- rep(cols_in, each = n) + } + + if (length(rows_in) != length(cols_in)) { + stop("Length of rows and cols must be equal.") + } + + inds <- which(paste(rows, cols, sep = ",") %in% paste(rows_in, cols_in, sep = ",")) + + if (length(inds) > 0) { ## writing over existing data + + rows <<- rows[-inds] + cols <<- cols[-inds] + t <<- t[-inds] + v <<- v[-inds] + f <<- f[-inds] + + n_elements <<- as.integer(length(rows)) + + if (n_elements == 0) { + data_count <<- 0L + } + } +}) + + + +Sheet_Data$methods(write = function(rows_in, cols_in, t_in, v_in, f_in, any_functions = TRUE) { + if (length(rows_in) == 0 | length(cols_in) == 0) { + return(invisible(0)) + } + + + possible_overlap <- FALSE + if (n_elements > 0) { + possible_overlap <- (min(cols_in, na.rm = TRUE) <= max(cols, na.rm = TRUE)) & + (max(cols_in, na.rm = TRUE) >= min(cols, na.rm = TRUE)) & + (min(rows_in, na.rm = TRUE) <= max(rows, na.rm = TRUE)) & + (max(rows_in, na.rm = TRUE) >= min(rows, na.rm = TRUE)) + } + + n <- length(cols_in) + cols_in <- rep.int(cols_in, times = length(rows_in)) + rows_in <- rep(rows_in, each = n) + + if (any_functions) { + if (any(!is.na(f_in))) { + v_in[!is.na(f_in)] <- as.character(NA) + t_in[!is.na(f_in)] <- 3L ## "str" + } + } + + inds <- integer(0) + if (possible_overlap) { + inds <- which(paste(rows, cols, sep = ",") %in% paste(rows_in, cols_in, sep = ",")) + } + + if (length(inds) > 0) { + rows <<- c(rows[-inds], rows_in) + cols <<- c(cols[-inds], cols_in) + t <<- c(t[-inds], t_in) + v <<- c(v[-inds], v_in) + f <<- c(f[-inds], f_in) + } else { + rows <<- c(rows, rows_in) + cols <<- c(cols, cols_in) + t <<- c(t, t_in) + v <<- c(v, v_in) + f <<- c(f, f_in) + } + + n_elements <<- as.integer(length(rows)) + data_count <<- data_count + 1L +}) diff -Nru r-cran-openxlsx-4.2.4/R/StyleClass.R r-cran-openxlsx-4.2.5/R/StyleClass.R --- r-cran-openxlsx-4.2.4/R/StyleClass.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/StyleClass.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,293 +1,293 @@ - - - -#' @include class_definitions.R - - -Style$methods(initialize = function() { - fontName <<- NULL - fontColour <<- NULL - fontSize <<- NULL - fontFamily <<- NULL - fontScheme <<- NULL - fontDecoration <<- NULL - - borderTop <<- NULL - borderLeft <<- NULL - borderRight <<- NULL - borderBottom <<- NULL - borderTopColour <<- NULL - borderLeftColour <<- NULL - borderRightColour <<- NULL - borderBottomColour <<- NULL - borderDiagonal <<- NULL - borderDiagonalColour <<- NULL - borderDiagonalUp <<- FALSE - borderDiagonalDown <<- FALSE - - halign <<- NULL - valign <<- NULL - indent <<- NULL - textRotation <<- NULL - numFmt <<- NULL - fill <<- NULL - wrapText <<- NULL - hidden <<- NULL - locked <<- NULL - xfId <<- NULL -}) - - - -mergeStyle <- function(oldStyle, newStyle) { - - ## This function is used to merge an existing cell style with a new style to create a stacked style. - oldStyle <- oldStyle$copy() - - if (!is.null(newStyle$fontName)) { - oldStyle$fontName <- newStyle$fontName - } - - if (!is.null(newStyle$fontColour)) { - oldStyle$fontColour <- newStyle$fontColour - } - - if (!is.null(newStyle$fontSize)) { - oldStyle$fontSize <- newStyle$fontSize - } - - if (!is.null(newStyle$fontFamily)) { - oldStyle$fontFamily <- newStyle$fontFamily - } - - if (!is.null(newStyle$fontScheme)) { - oldStyle$fontScheme <- newStyle$fontScheme - } - - if (length(newStyle$fontDecoration) > 0) { - if (length(oldStyle$fontDecoration) == 0) { - oldStyle$fontDecoration <- newStyle$fontDecoration - } else { - oldStyle$fontDecoration <- c(oldStyle$fontDecoration, newStyle$fontDecoration) - } - } - - - ## borders - if (!is.null(newStyle$borderTop)) { - oldStyle$borderTop <- newStyle$borderTop - } - - if (!is.null(newStyle$borderLeft)) { - oldStyle$borderLeft <- newStyle$borderLeft - } - - if (!is.null(newStyle$borderRight)) { - oldStyle$borderRight <- newStyle$borderRight - } - - if (!is.null(newStyle$borderBottom)) { - oldStyle$borderBottom <- newStyle$borderBottom - } - - if (!is.null(newStyle$borderDiagonal)) { - oldStyle$borderDiagonal <- newStyle$borderDiagonal - } - - oldStyle$borderDiagonalUp <- newStyle$borderDiagonalUp - oldStyle$borderDiagonalDown <- newStyle$borderDiagonalDown - - - if (!is.null(newStyle$borderTopColour)) { - oldStyle$borderTopColour <- newStyle$borderTopColour - } - - if (!is.null(newStyle$borderLeftColour)) { - oldStyle$borderLeftColour <- newStyle$borderLeftColour - } - - if (!is.null(newStyle$borderRightColour)) { - oldStyle$borderRightColour <- newStyle$borderRightColour - } - - if (!is.null(newStyle$borderBottomColour)) { - oldStyle$borderBottomColour <- newStyle$borderBottomColour - } - - - - ## other - if (!is.null(newStyle$halign)) { - oldStyle$halign <- newStyle$halign - } - - if (!is.null(newStyle$valign)) { - oldStyle$valign <- newStyle$valign - } - - if (!is.null(newStyle$indent)) { - oldStyle$indent <- newStyle$indent - } - - if (!is.null(newStyle$textRotation)) { - oldStyle$textRotation <- newStyle$textRotation - } - - if (!is.null(newStyle$numFmt)) { - oldStyle$numFmt <- newStyle$numFmt - } - - if (!is.null(newStyle$fill)) { - oldStyle$fill <- newStyle$fill - } - - if (!is.null(newStyle$wrapText)) { - oldStyle$wrapText <- newStyle$wrapText - } - - if (!is.null(newStyle$locked)) { - oldStyle$locked <- newStyle$locked - } - - if (!is.null(newStyle$hidden)) { - oldStyle$hidden <- newStyle$hidden - } - - if (!is.null(newStyle$xfId)) { - oldStyle$xfId <- newStyle$xfId - } - - return(oldStyle) -} - - - - - -Style$methods(show = function(print = TRUE) { - numFmtMapping <- list( - list("numFmtId" = 0), - list("numFmtId" = 2), - list("numFmtId" = 164), - list("numFmtId" = 44), - list("numFmtId" = 14), - list("numFmtId" = 167), - list("numFmtId" = 10), - list("numFmtId" = 11), - list("numFmtId" = 49) - ) - - validNumFmt <- c("GENERAL", "NUMBER", "CURRENCY", "ACCOUNTING", "DATE", "TIME", "PERCENTAGE", "SCIENTIFIC", "TEXT") - - if (!is.null(numFmt)) { - if (as.integer(numFmt$numFmtId) %in% unlist(numFmtMapping)) { - numFmtStr <- validNumFmt[unlist(numFmtMapping) == as.integer(numFmt$numFmtId)] - } else { - numFmtStr <- sprintf('"%s"', numFmt$formatCode) - } - } else { - numFmtStr <- "GENERAL" - } - - borders <- c(sprintf("Top: %s", borderTop), sprintf("Bottom: %s", borderBottom), sprintf("Left: %s", borderLeft), sprintf("Right: %s", borderRight)) - borderColours <- gsub("^FF", "#", c(borderTopColour, borderBottomColour, borderLeftColour, borderRightColour)) - - fgFill <- fill$fillFg - bgFill <- fill$fillBg - - styleShow <- "A custom cell style. \n\n" - - styleShow <- append(styleShow, sprintf("Cell formatting: %s \n", numFmtStr)) ## numFmt - styleShow <- append(styleShow, sprintf("Font name: %s \n", fontName[[1]])) ## Font name - styleShow <- append(styleShow, sprintf("Font size: %s \n", fontSize[[1]])) ## Font size - styleShow <- append(styleShow, sprintf("Font colour: %s \n", gsub("^FF", "#", fontColour[[1]]))) ## Font colour - - ## Font decoration - if (length(fontDecoration) > 0) { - styleShow <- append(styleShow, sprintf("Font decoration: %s \n", paste(fontDecoration, collapse = ", "))) - } - - if (length(borders) > 0) { - styleShow <- append(styleShow, sprintf("Cell borders: %s \n", paste(borders, collapse = ", "))) ## Cell borders - styleShow <- append(styleShow, sprintf("Cell border colours: %s \n", paste(borderColours, collapse = ", "))) ## Cell borders - } - - if (!is.null(halign)) { - styleShow <- append(styleShow, sprintf("Cell horz. align: %s \n", halign)) - } ## Cell horizontal alignment - - if (!is.null(valign)) { - styleShow <- append(styleShow, sprintf("Cell vert. align: %s \n", valign)) - } ## Cell vertical alignment - - if (!is.null(indent)) { - styleShow <- append(styleShow, sprintf("Cell indent: %s \n", indent)) - } ## Cell indent - - if (!is.null(textRotation)) { - styleShow <- append(styleShow, sprintf("Cell text rotation: %s \n", textRotation)) - } ## Cell text rotation - - ## Cell fill colour - if (length(fgFill) > 0) { - styleShow <- append(styleShow, sprintf("Cell fill foreground: %s \n", paste(paste0(names(fgFill), ": ", sub("^FF", "#", fgFill)), collapse = ", "))) - } - - if (length(bgFill) > 0) { - styleShow <- append(styleShow, sprintf("Cell fill background: %s \n", paste(paste0(names(bgFill), ": ", sub("^FF", "#", bgFill)), collapse = ", "))) - } - - if (!is.null(locked)) { - styleShow <- append(styleShow, sprintf("Cell protection: %s \n", locked)) - } ## Cell protection - if (!is.null(hidden)) { - styleShow <- append(styleShow, sprintf("Cell formula hidden: %s \n", hidden)) - } ## Cell formula hidden - - styleShow <- append(styleShow, sprintf("wraptext: %s", wrapText)) ## wrap text - - styleShow <- c(styleShow, "\n\n") - - if (print) { - cat(styleShow) - } - - return(invisible(styleShow)) -}) - - - - -Style$methods(as.list = function() { - l <- list( - "fontName" = fontName, - "fontColour" = fontColour, - "fontSize" = fontSize, - "fontFamily" = fontFamily, - "fontScheme" = fontScheme, - "fontDecoration" = fontDecoration, - - "borderTop" = borderTop, - "borderLeft" = borderLeft, - "borderRight" = borderRight, - "borderBottom" = borderBottom, - "borderTopColour" = borderTopColour, - "borderLeftColour" = borderLeftColour, - "borderRightColour" = borderRightColour, - "borderBottomColour" = borderBottomColour, - - "halign" = halign, - "valign" = valign, - "indent" = indent, - "textRotation" = textRotation, - "numFmt" = numFmt, - "fillFg" = fill$fillFg, - "fillBg" = fill$fillBg, - "wrapText" = wrapText, - "locked" = locked, - "hidden" = hidden, - "xfId" = xfId - ) - - l[sapply(l, length) > 0] -}) + + + +#' @include class_definitions.R + + +Style$methods(initialize = function() { + fontName <<- NULL + fontColour <<- NULL + fontSize <<- NULL + fontFamily <<- NULL + fontScheme <<- NULL + fontDecoration <<- NULL + + borderTop <<- NULL + borderLeft <<- NULL + borderRight <<- NULL + borderBottom <<- NULL + borderTopColour <<- NULL + borderLeftColour <<- NULL + borderRightColour <<- NULL + borderBottomColour <<- NULL + borderDiagonal <<- NULL + borderDiagonalColour <<- NULL + borderDiagonalUp <<- FALSE + borderDiagonalDown <<- FALSE + + halign <<- NULL + valign <<- NULL + indent <<- NULL + textRotation <<- NULL + numFmt <<- NULL + fill <<- NULL + wrapText <<- NULL + hidden <<- NULL + locked <<- NULL + xfId <<- NULL +}) + + + +mergeStyle <- function(oldStyle, newStyle) { + + ## This function is used to merge an existing cell style with a new style to create a stacked style. + oldStyle <- oldStyle$copy() + + if (!is.null(newStyle$fontName)) { + oldStyle$fontName <- newStyle$fontName + } + + if (!is.null(newStyle$fontColour)) { + oldStyle$fontColour <- newStyle$fontColour + } + + if (!is.null(newStyle$fontSize)) { + oldStyle$fontSize <- newStyle$fontSize + } + + if (!is.null(newStyle$fontFamily)) { + oldStyle$fontFamily <- newStyle$fontFamily + } + + if (!is.null(newStyle$fontScheme)) { + oldStyle$fontScheme <- newStyle$fontScheme + } + + if (length(newStyle$fontDecoration) > 0) { + if (length(oldStyle$fontDecoration) == 0) { + oldStyle$fontDecoration <- newStyle$fontDecoration + } else { + oldStyle$fontDecoration <- c(oldStyle$fontDecoration, newStyle$fontDecoration) + } + } + + + ## borders + if (!is.null(newStyle$borderTop)) { + oldStyle$borderTop <- newStyle$borderTop + } + + if (!is.null(newStyle$borderLeft)) { + oldStyle$borderLeft <- newStyle$borderLeft + } + + if (!is.null(newStyle$borderRight)) { + oldStyle$borderRight <- newStyle$borderRight + } + + if (!is.null(newStyle$borderBottom)) { + oldStyle$borderBottom <- newStyle$borderBottom + } + + if (!is.null(newStyle$borderDiagonal)) { + oldStyle$borderDiagonal <- newStyle$borderDiagonal + } + + oldStyle$borderDiagonalUp <- newStyle$borderDiagonalUp + oldStyle$borderDiagonalDown <- newStyle$borderDiagonalDown + + + if (!is.null(newStyle$borderTopColour)) { + oldStyle$borderTopColour <- newStyle$borderTopColour + } + + if (!is.null(newStyle$borderLeftColour)) { + oldStyle$borderLeftColour <- newStyle$borderLeftColour + } + + if (!is.null(newStyle$borderRightColour)) { + oldStyle$borderRightColour <- newStyle$borderRightColour + } + + if (!is.null(newStyle$borderBottomColour)) { + oldStyle$borderBottomColour <- newStyle$borderBottomColour + } + + + + ## other + if (!is.null(newStyle$halign)) { + oldStyle$halign <- newStyle$halign + } + + if (!is.null(newStyle$valign)) { + oldStyle$valign <- newStyle$valign + } + + if (!is.null(newStyle$indent)) { + oldStyle$indent <- newStyle$indent + } + + if (!is.null(newStyle$textRotation)) { + oldStyle$textRotation <- newStyle$textRotation + } + + if (!is.null(newStyle$numFmt)) { + oldStyle$numFmt <- newStyle$numFmt + } + + if (!is.null(newStyle$fill)) { + oldStyle$fill <- newStyle$fill + } + + if (!is.null(newStyle$wrapText)) { + oldStyle$wrapText <- newStyle$wrapText + } + + if (!is.null(newStyle$locked)) { + oldStyle$locked <- newStyle$locked + } + + if (!is.null(newStyle$hidden)) { + oldStyle$hidden <- newStyle$hidden + } + + if (!is.null(newStyle$xfId)) { + oldStyle$xfId <- newStyle$xfId + } + + return(oldStyle) +} + + + + + +Style$methods(show = function(print = TRUE) { + numFmtMapping <- list( + list("numFmtId" = 0), + list("numFmtId" = 2), + list("numFmtId" = 164), + list("numFmtId" = 44), + list("numFmtId" = 14), + list("numFmtId" = 167), + list("numFmtId" = 10), + list("numFmtId" = 11), + list("numFmtId" = 49) + ) + + validNumFmt <- c("GENERAL", "NUMBER", "CURRENCY", "ACCOUNTING", "DATE", "TIME", "PERCENTAGE", "SCIENTIFIC", "TEXT") + + if (!is.null(numFmt)) { + if (as.integer(numFmt$numFmtId) %in% unlist(numFmtMapping)) { + numFmtStr <- validNumFmt[unlist(numFmtMapping) == as.integer(numFmt$numFmtId)] + } else { + numFmtStr <- sprintf('"%s"', numFmt$formatCode) + } + } else { + numFmtStr <- "GENERAL" + } + + borders <- c(sprintf("Top: %s", borderTop), sprintf("Bottom: %s", borderBottom), sprintf("Left: %s", borderLeft), sprintf("Right: %s", borderRight)) + borderColours <- gsub("^FF", "#", c(borderTopColour, borderBottomColour, borderLeftColour, borderRightColour)) + + fgFill <- fill$fillFg + bgFill <- fill$fillBg + + styleShow <- "A custom cell style. \n\n" + + styleShow <- append(styleShow, sprintf("Cell formatting: %s \n", numFmtStr)) ## numFmt + styleShow <- append(styleShow, sprintf("Font name: %s \n", fontName[[1]])) ## Font name + styleShow <- append(styleShow, sprintf("Font size: %s \n", fontSize[[1]])) ## Font size + styleShow <- append(styleShow, sprintf("Font colour: %s \n", gsub("^FF", "#", fontColour[[1]]))) ## Font colour + + ## Font decoration + if (length(fontDecoration) > 0) { + styleShow <- append(styleShow, sprintf("Font decoration: %s \n", paste(fontDecoration, collapse = ", "))) + } + + if (length(borders) > 0) { + styleShow <- append(styleShow, sprintf("Cell borders: %s \n", paste(borders, collapse = ", "))) ## Cell borders + styleShow <- append(styleShow, sprintf("Cell border colours: %s \n", paste(borderColours, collapse = ", "))) ## Cell borders + } + + if (!is.null(halign)) { + styleShow <- append(styleShow, sprintf("Cell horz. align: %s \n", halign)) + } ## Cell horizontal alignment + + if (!is.null(valign)) { + styleShow <- append(styleShow, sprintf("Cell vert. align: %s \n", valign)) + } ## Cell vertical alignment + + if (!is.null(indent)) { + styleShow <- append(styleShow, sprintf("Cell indent: %s \n", indent)) + } ## Cell indent + + if (!is.null(textRotation)) { + styleShow <- append(styleShow, sprintf("Cell text rotation: %s \n", textRotation)) + } ## Cell text rotation + + ## Cell fill colour + if (length(fgFill) > 0) { + styleShow <- append(styleShow, sprintf("Cell fill foreground: %s \n", paste(paste0(names(fgFill), ": ", sub("^FF", "#", fgFill)), collapse = ", "))) + } + + if (length(bgFill) > 0) { + styleShow <- append(styleShow, sprintf("Cell fill background: %s \n", paste(paste0(names(bgFill), ": ", sub("^FF", "#", bgFill)), collapse = ", "))) + } + + if (!is.null(locked)) { + styleShow <- append(styleShow, sprintf("Cell protection: %s \n", locked)) + } ## Cell protection + if (!is.null(hidden)) { + styleShow <- append(styleShow, sprintf("Cell formula hidden: %s \n", hidden)) + } ## Cell formula hidden + + styleShow <- append(styleShow, sprintf("wraptext: %s", wrapText)) ## wrap text + + styleShow <- c(styleShow, "\n\n") + + if (print) { + cat(styleShow) + } + + return(invisible(styleShow)) +}) + + + + +Style$methods(as.list = function() { + l <- list( + "fontName" = fontName, + "fontColour" = fontColour, + "fontSize" = fontSize, + "fontFamily" = fontFamily, + "fontScheme" = fontScheme, + "fontDecoration" = fontDecoration, + + "borderTop" = borderTop, + "borderLeft" = borderLeft, + "borderRight" = borderRight, + "borderBottom" = borderBottom, + "borderTopColour" = borderTopColour, + "borderLeftColour" = borderLeftColour, + "borderRightColour" = borderRightColour, + "borderBottomColour" = borderBottomColour, + + "halign" = halign, + "valign" = valign, + "indent" = indent, + "textRotation" = textRotation, + "numFmt" = numFmt, + "fillFg" = fill$fillFg, + "fillBg" = fill$fillBg, + "wrapText" = wrapText, + "locked" = locked, + "hidden" = hidden, + "xfId" = xfId + ) + + l[sapply(l, length) > 0] +}) diff -Nru r-cran-openxlsx-4.2.4/R/utils.R r-cran-openxlsx-4.2.5/R/utils.R --- r-cran-openxlsx-4.2.4/R/utils.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/utils.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,54 +1,56 @@ -#' If NULL then ... -#' -#' Replace NULL -#' -#' @param x A value to check -#' @param y A value to substitute if x is null -#' @examples -#' \dontrun{ -#' x <- NULL -#' x <- x %||% "none" -#' x <- x %||% NA -#' } -#' -#' @name if_null_then -`%||%` <- function(x, y) if (is.null(x)) y else x - -is_not_class <- function(x, class) { - !(inherits(x, class) | is.null(x)) -} - -is_true_false <- function(x) { - is.logical(x) && length(x) == 1L && !is.na(x) -} - -do_call_params <- function(fun, params, ..., .map = FALSE) { - fun <- match.fun(fun) - call_params <- c(list(...), params[names(params) %in% names(formals(fun))]) - call_params <- lapply(call_params, function(x) if (is.object(x)) list(x) else x) - - call_fun <- if (.map) { - function(...) mapply(fun, ..., MoreArgs = NULL, SIMPLIFY = FALSE, USE.NAMES = FALSE) - } else { - fun - } - - do.call(call_fun, call_params) -} - -# sets temporary options -# returns the current options to decrease line use -get_set_options <- function() { - op <- options() - options( - # increase scipen to avoid writing in scientific - scipen = 200, - OutDec = ".", - digits = 22 - ) - op -} - -temp_xlsx <- function(name = "temp_xlsx") { - tempfile(pattern = paste0(name, "_"), fileext = ".xlsx") -} +#' If NULL then ... +#' +#' Replace NULL +#' +#' @param x A value to check +#' @param y A value to substitute if x is null +#' @examples +#' \dontrun{ +#' x <- NULL +#' x <- x %||% "none" +#' x <- x %||% NA +#' } +#' +#' @name if_null_then +`%||%` <- function(x, y) if (is.null(x)) y else x + +is_not_class <- function(x, class) { + !(inherits(x, class) | is.null(x)) +} + +is_true_false <- function(x) { + is.logical(x) && length(x) == 1L && !is.na(x) +} + +do_call_params <- function(fun, params, ..., .map = FALSE) { + fun <- match.fun(fun) + call_params <- c(list(...), params[names(params) %in% names(formals(fun))]) + call_params <- lapply(call_params, function(x) if (is.object(x)) list(x) else x) + + call_fun <- if (.map) { + function(...) mapply(fun, ..., MoreArgs = NULL, SIMPLIFY = FALSE, USE.NAMES = FALSE) + } else { + fun + } + + do.call(call_fun, call_params) +} + +# sets temporary options +# option() returns the original values +get_set_options <- function() { + options( + # increase scipen to avoid writing in scientific + scipen = 200, + OutDec = ".", + digits = 22 + ) +} + + +#' helper function to create tempory directory for testing purpose +#' @param name for the temp file +#' @export +temp_xlsx <- function(name = "temp_xlsx") { + tempfile(pattern = paste0(name, "_"), fileext = ".xlsx") +} diff -Nru r-cran-openxlsx-4.2.4/R/WorkbookClass.R r-cran-openxlsx-4.2.5/R/WorkbookClass.R --- r-cran-openxlsx-4.2.4/R/WorkbookClass.R 2021-06-08 08:11:46.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/WorkbookClass.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,4347 +1,4366 @@ - - -#' @include class_definitions.R -#' @import stringi - -Workbook$methods( - initialize = function(creator = openxlsx_getOp("creator"), - title = NULL, - subject = NULL, - category = NULL) { - charts <<- list() - isChartSheet <<- logical(0) - - colWidths <<- list() - colOutlineLevels <<- list() - attr(colOutlineLevels, "hidden") <<- NULL - connections <<- NULL - Content_Types <<- genBaseContent_Type() - core <<- - genBaseCore( - creator = creator, - title = title, - subject = subject, - category = category - ) - comments <<- list() - threadComments <<- list() - - - drawings <<- list() - drawings_rels <<- list() - - embeddings <<- NULL - externalLinks <<- NULL - externalLinksRels <<- NULL - - headFoot <<- NULL - - media <<- list() - - persons <<- NULL - - pivotTables <<- NULL - pivotTables.xml.rels <<- NULL - pivotDefinitions <<- NULL - pivotRecords <<- NULL - pivotDefinitionsRels <<- NULL - - queryTables <<- NULL - rowHeights <<- list() - outlineLevels <<- list() - attr(outlineLevels, "hidden") <<- NULL - - slicers <<- NULL - slicerCaches <<- NULL - - sheet_names <<- character(0) - sheetOrder <<- integer(0) - - sharedStrings <<- list() - attr(sharedStrings, "uniqueCount") <<- 0 - - styles <<- genBaseStyleSheet() - styleObjects <<- list() - - - tables <<- NULL - tables.xml.rels <<- NULL - theme <<- NULL - - - vbaProject <<- NULL - vml <<- list() - vml_rels <<- list() - - workbook <<- genBaseWorkbook() - workbook.xml.rels <<- genBaseWorkbook.xml.rels() - - worksheets <<- list() - worksheets_rels <<- list() - ActiveSheet <<- integer(0) - } -) - -Workbook$methods( - addWorksheet = function( - sheetName, - showGridLines = openxlsx_getOp("showGridLines"), - tabColour = openxlsx_getOp("tabColour"), - zoom = 100, - oddHeader = openxlsx_getOp("oddHeader"), - oddFooter = openxlsx_getOp("oddFooter"), - evenHeader = openxlsx_getOp("evenHeader"), - evenFooter = openxlsx_getOp("evenFooter"), - firstHeader = openxlsx_getOp("firstHeader"), - firstFooter = openxlsx_getOp("firstFooter"), - visible = TRUE, - paperSize = openxlsx_getOp("paperSize", 9), - orientation = openxlsx_getOp("orientation", "portrait"), - hdpi = openxlsx_getOp("hdpi", 300), - vdpi = openxlsx_getOp("vdpi", 300) - ) { - if (!missing(sheetName)) { - if (grepl(pattern = ":", x = sheetName)) { - stop("colon not allowed in sheet names in Excel") - } - } - newSheetIndex <- length(worksheets) + 1L - - if (newSheetIndex > 1) { - sheetId <- - max(as.integer(regmatches( - workbook$sheets, - regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE) - ))) + 1L - } else { - sheetId <- 1 - ActiveSheet <<- 1L - } - - - ## fix visible value - visible <- tolower(visible) - - if (visible == "true") { - visible <- "visible" - } else if (visible == "false") { - visible <- "hidden" - } else if (visible == "veryhidden") { - visible <- "veryHidden" - } - - ## Add sheet to workbook.xml - workbook$sheets <<- - c( - workbook$sheets, - sprintf( - '', - sheetName, - sheetId, - visible, - newSheetIndex - ) - ) - - ## append to worksheets list - worksheets <<- - append( - worksheets, - WorkSheet$new( - showGridLines = showGridLines, - tabSelected = newSheetIndex == 1, - tabColour = tabColour, - zoom = zoom, - oddHeader = oddHeader, - oddFooter = oddFooter, - evenHeader = evenHeader, - evenFooter = evenFooter, - firstHeader = firstHeader, - firstFooter = firstFooter, - paperSize = paperSize, - orientation = orientation, - hdpi = hdpi, - vdpi = vdpi - ) - ) - - - ## update content_tyes - ## add a drawing.xml for the worksheet - Content_Types <<- - c( - Content_Types, - sprintf( - '', - newSheetIndex - ), - sprintf( - '', - newSheetIndex - ) - ) - - ## Update xl/rels - workbook.xml.rels <<- c( - workbook.xml.rels, - sprintf( - '', - newSheetIndex - ) - ) - - - ## create sheet.rels to simplify id assignment - worksheets_rels[[newSheetIndex]] <<- - genBaseSheetRels(newSheetIndex) - drawings_rels[[newSheetIndex]] <<- list() - drawings[[newSheetIndex]] <<- list() - - vml_rels[[newSheetIndex]] <<- list() - vml[[newSheetIndex]] <<- list() - - isChartSheet[[newSheetIndex]] <<- FALSE - comments[[newSheetIndex]] <<- list() - threadComments[[newSheetIndex]] <<- list() - - rowHeights[[newSheetIndex]] <<- list() - colWidths[[newSheetIndex]] <<- list() - colOutlineLevels[[newSheetIndex]] <<- list() - outlineLevels[[newSheetIndex]] <<- list() - - sheetOrder <<- c(sheetOrder, as.integer(newSheetIndex)) - sheet_names <<- c(sheet_names, sheetName) - - invisible(newSheetIndex) - } -) - -Workbook$methods( - cloneWorksheet = function(sheetName, clonedSheet) { - clonedSheet <- validateSheet(clonedSheet) - if (!missing(sheetName)) { - if (grepl(pattern = ":", x = sheetName)) { - stop("colon not allowed in sheet names in Excel") - } - } - newSheetIndex <- length(worksheets) + 1L - if (newSheetIndex > 1) { - sheetId <- - max(as.integer(regmatches( - workbook$sheets, - regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE) - ))) + 1L - } else { - sheetId <- 1 - } - - - ## copy visibility from cloned sheet! - visible <- - regmatches( - workbook$sheets[[clonedSheet]], - regexpr('(?<=state=")[^"]+', workbook$sheets[[clonedSheet]], perl = TRUE) - ) - - ## Add sheet to workbook.xml - workbook$sheets <<- - c( - workbook$sheets, - sprintf( - '', - sheetName, - sheetId, - visible, - newSheetIndex - ) - ) - - ## append to worksheets list - worksheets <<- - append(worksheets, worksheets[[clonedSheet]]$copy()) - - - ## update content_tyes - ## add a drawing.xml for the worksheet - Content_Types <<- - c( - Content_Types, - sprintf( - '', - newSheetIndex - ), - sprintf( - '', - newSheetIndex - ) - ) - - ## Update xl/rels - workbook.xml.rels <<- c( - workbook.xml.rels, - sprintf( - '', - newSheetIndex - ) - ) - - ## create sheet.rels to simplify id assignment - worksheets_rels[[newSheetIndex]] <<- - genBaseSheetRels(newSheetIndex) - drawings_rels[[newSheetIndex]] <<- drawings_rels[[clonedSheet]] - - # give each chart its own filename (images can re-use the same file, but charts can't) - drawings_rels[[newSheetIndex]] <<- - sapply(drawings_rels[[newSheetIndex]], function(rl) { - chartfiles <- - regmatches( - rl, - gregexpr("(?<=charts/)chart[0-9]+\\.xml", rl, perl = TRUE) - )[[1]] - for (cf in chartfiles) { - chartid <- length(charts) + 1 - newname <- stri_join("chart", chartid, ".xml") - fl <- charts[cf] - - # Read the chartfile and adjust all formulas to point to the new - # sheet name instead of the clone source - # The result is saved to a new chart xml file - newfl <- file.path(dirname(fl), newname) - charts[newname] <<- newfl - chart <- readUTF8(fl) - chart <- - gsub( - stri_join("(?<=')", sheet_names[[clonedSheet]], "(?='!)"), - stri_join("'", sheetName, "'"), - chart, - perl = TRUE - ) - chart <- - gsub( - stri_join("(?<=[^A-Za-z0-9])", sheet_names[[clonedSheet]], "(?=!)"), - stri_join("'", sheetName, "'"), - chart, - perl = TRUE - ) - writeLines(chart, newfl) - # file.copy(fl, newfl) - Content_Types <<- - c( - Content_Types, - sprintf( - '', - newname - ) - ) - rl <- gsub(stri_join("(?<=charts/)", cf), newname, rl, perl = TRUE) - } - rl - }, USE.NAMES = FALSE) - # The IDs in the drawings array are sheet-specific, so within the new cloned sheet - # the same IDs can be used => no need to modify drawings - drawings[[newSheetIndex]] <<- drawings[[clonedSheet]] - - vml_rels[[newSheetIndex]] <<- vml_rels[[clonedSheet]] - vml[[newSheetIndex]] <<- vml[[clonedSheet]] - - isChartSheet[[newSheetIndex]] <<- isChartSheet[[clonedSheet]] - comments[[newSheetIndex]] <<- comments[[clonedSheet]] - threadComments[[newSheetIndex]] <<- threadComments[[clonedSheet]] - - rowHeights[[newSheetIndex]] <<- rowHeights[[clonedSheet]] - colWidths[[newSheetIndex]] <<- colWidths[[clonedSheet]] - - colOutlineLevels[[newSheetIndex]] <<- colOutlineLevels[[clonedSheet]] - outlineLevels[[newSheetIndex]] <<- outlineLevels[[clonedSheet]] - - sheetOrder <<- c(sheetOrder, as.integer(newSheetIndex)) - sheet_names <<- c(sheet_names, sheetName) - - - ############################ - ## STYLE - ## ... objects are stored in a global list, so we need to get all styles - ## assigned to the cloned sheet and duplicate them - sheetStyles <- Filter(function(s) { - s$sheet == sheet_names[[clonedSheet]] - }, styleObjects) - styleObjects <<- c( - styleObjects, - Map(function(s) { - s$sheet <- sheetName - s - }, sheetStyles) - ) - - - ############################ - ## TABLES - ## ... are stored in the $tables list, with the name and sheet as attr - ## and in the worksheets[]$tableParts list. We also need to adjust the - ## worksheets_rels and set the content type for the new table - - tbls <- tables[attr(tables, "sheet") == clonedSheet] - for (t in tbls) { - # Extract table name, displayName and ID from the xml - oldname <- regmatches(t, regexpr('(?<= name=")[^"]+', t, perl = TRUE)) - olddispname <- regmatches(t, regexpr('(?<= displayName=")[^"]+', t, perl = TRUE)) - oldid <- regmatches(t, regexpr('(?<= id=")[^"]+', t, perl = TRUE)) - ref <- regmatches(t, regexpr('(?<= ref=")[^"]+', t, perl = TRUE)) - - # Find new, unused table names by appending _n, where n=1,2,... - n <- 0 - while (stri_join(oldname, "_", n) %in% attr(tables, "tableName")) { - n <- n + 1 - } - newname <- stri_join(oldname, "_", n) - newdispname <- stri_join(olddispname, "_", n) - newid <- as.character(length(tables) + 3L) - - # Use the table definition from the cloned sheet and simply replace the names - newt <- t - newt <- - gsub( - stri_join(" name=\"", oldname, "\""), - stri_join(" name=\"", newname, "\""), - newt - ) - newt <- - gsub( - stri_join(" displayName=\"", olddispname, "\""), - stri_join(" displayName=\"", newdispname, "\""), - newt - ) - newt <- - gsub( - stri_join("(', newid)) - attr(worksheets[[newSheetIndex]]$tableParts, "tableName") <<- - c(attr(oldparts, "tableName"), newname) - names(attr(worksheets[[newSheetIndex]]$tableParts, "tableName")) <<- - c(names(attr(oldparts, "tableName")), ref) - - Content_Types <<- - c( - Content_Types, - sprintf( - '', - newid - ) - ) - tables.xml.rels <<- append(tables.xml.rels, "") - - worksheets_rels[[newSheetIndex]] <<- - c( - worksheets_rels[[newSheetIndex]], - sprintf( - '', - newid, - newid - ) - ) - } - - # TODO: The following items are currently NOT copied/duplicated for the cloned sheet: - # - Comments - # - Pivot tables - - invisible(newSheetIndex) - } -) - -Workbook$methods( - addChartSheet = function(sheetName, - tabColour = NULL, - zoom = 100) { - newSheetIndex <- length(worksheets) + 1L - - if (newSheetIndex > 1) { - sheetId <- - max(as.integer(regmatches( - workbook$sheets, - regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE) - ))) + 1L - } else { - sheetId <- 1 - } - - ## Add sheet to workbook.xml - workbook$sheets <<- - c( - workbook$sheets, - sprintf( - '', - sheetName, - sheetId, - newSheetIndex - ) - ) - - ## append to worksheets list - worksheets <<- - append( - worksheets, - ChartSheet$new( - tabSelected = newSheetIndex == 1, - tabColour = tabColour, - zoom = zoom - ) - ) - sheet_names <<- c(sheet_names, sheetName) - - ## update content_tyes - Content_Types <<- - c( - Content_Types, - sprintf( - '', - newSheetIndex - ) - ) - - ## Update xl/rels - workbook.xml.rels <<- c( - workbook.xml.rels, - sprintf( - '', - newSheetIndex - ) - ) - - ## add a drawing.xml for the worksheet - Content_Types <<- - c( - Content_Types, - sprintf( - '', - newSheetIndex - ) - ) - - ## create sheet.rels to simplify id assignment - worksheets_rels[[newSheetIndex]] <<- - genBaseSheetRels(newSheetIndex) - drawings_rels[[newSheetIndex]] <<- list() - drawings[[newSheetIndex]] <<- list() - - isChartSheet[[newSheetIndex]] <<- TRUE - - rowHeights[[newSheetIndex]] <<- list() - colWidths[[newSheetIndex]] <<- list() - - colOutlineLevels[[newSheetIndex]] <<- list() - outlineLevels[[newSheetIndex]] <<- list() - - vml_rels[[newSheetIndex]] <<- list() - vml[[newSheetIndex]] <<- list() - - sheetOrder <<- c(sheetOrder, newSheetIndex) - - invisible(newSheetIndex) - } -) - - - -Workbook$methods( - saveWorkbook = function() { - ## temp directory to save XML files prior to compressing - tmpDir <- file.path(tempfile(pattern = "workbookTemp_")) - - if (file.exists(tmpDir)) { - unlink(tmpDir, recursive = TRUE, force = TRUE) - } - - success <- dir.create(path = tmpDir, recursive = TRUE) - if (!success) { - stop(sprintf("Failed to create temporary directory '%s'", tmpDir)) - } - - .self$preSaveCleanUp() - - nSheets <- length(worksheets) - nThemes <- length(theme) - nPivots <- length(pivotDefinitions) - nSlicers <- length(slicers) - nComments <- sum(sapply(comments, length) > 0) - nThreadComments <- sum(sapply(threadComments, length) > 0) - nPersons <- length(persons) - nVML <- sum(sapply(vml, length) > 0) - - relsDir <- file.path(tmpDir, "_rels") - dir.create(path = relsDir, recursive = TRUE) - - docPropsDir <- file.path(tmpDir, "docProps") - dir.create(path = docPropsDir, recursive = TRUE) - - xlDir <- file.path(tmpDir, "xl") - dir.create(path = xlDir, recursive = TRUE) - - xlrelsDir <- file.path(tmpDir, "xl", "_rels") - dir.create(path = xlrelsDir, recursive = TRUE) - - xlTablesDir <- file.path(tmpDir, "xl", "tables") - dir.create(path = xlTablesDir, recursive = TRUE) - - xlTablesRelsDir <- file.path(xlTablesDir, "_rels") - dir.create(path = xlTablesRelsDir, recursive = TRUE) - - if (length(media) > 0) { - xlmediaDir <- file.path(tmpDir, "xl", "media") - dir.create(path = xlmediaDir, recursive = TRUE) - } - - - ## will always have a theme - xlthemeDir <- file.path(tmpDir, "xl", "theme") - dir.create(path = xlthemeDir, recursive = TRUE) - - if (is.null(theme)) { - con <- file(file.path(xlthemeDir, "theme1.xml"), open = "wb") - writeBin(charToRaw(genBaseTheme()), con) - close(con) - } else { - lapply(1:nThemes, function(i) { - con <- - file(file.path(xlthemeDir, stri_join("theme", i, ".xml")), open = "wb") - writeBin(charToRaw(pxml(theme[[i]])), con) - close(con) - }) - } - - ## will always have drawings - xlworksheetsDir <- file.path(tmpDir, "xl", "worksheets") - dir.create(path = xlworksheetsDir, recursive = TRUE) - - xlworksheetsRelsDir <- - file.path(tmpDir, "xl", "worksheets", "_rels") - dir.create(path = xlworksheetsRelsDir, recursive = TRUE) - - xldrawingsDir <- file.path(tmpDir, "xl", "drawings") - dir.create(path = xldrawingsDir, recursive = TRUE) - - xldrawingsRelsDir <- file.path(tmpDir, "xl", "drawings", "_rels") - dir.create(path = xldrawingsRelsDir, recursive = TRUE) - - ## charts - if (length(charts) > 0) { - file.copy( - from = dirname(charts[1]), - to = file.path(tmpDir, "xl"), - recursive = TRUE - ) - } - - - ## xl/comments.xml - if (nComments > 0 | nVML > 0) { - for (i in 1:nSheets) { - if (length(comments[[i]]) > 0) { - fn <- sprintf("comments%s.xml", i) - - Content_Types <<- c( - Content_Types, - sprintf( - '', - fn - ) - ) - - worksheets_rels[[i]] <<- unique(c( - worksheets_rels[[i]], - sprintf( - '', - fn - ) - )) - - writeCommentXML( - comment_list = comments[[i]], - file_name = file.path(tmpDir, "xl", fn) - ) - } - } - - .self$writeDrawingVML(xldrawingsDir) - } - - ## Threaded Comments xl/threadedComments/threadedComment.xml - if (nThreadComments > 0){ - xlThreadComments <- file.path(tmpDir, "xl", "threadedComments") - dir.create(path = xlThreadComments, recursive = TRUE) - - for (i in seq_len(nSheets)) { - if (length(threadComments[[i]]) > 0) { - fl <- threadComments[[i]] - file.copy( - from = fl, - to = file.path(xlThreadComments, basename(fl)), - overwrite = TRUE, - copy.date = TRUE - ) - - worksheets_rels[[i]] <<- unique(c( - worksheets_rels[[i]], - sprintf( - '', - basename(fl) - ) - )) - } - } - } - - ## xl/persons/person.xml - if (nPersons > 0){ - personDir <- file.path(tmpDir, "xl", "persons") - dir.create(path = personDir, recursive = TRUE) - file.copy( - from = persons, - to = personDir, - overwrite = TRUE - ) - - } - - - if (length(embeddings) > 0) { - embeddingsDir <- file.path(tmpDir, "xl", "embeddings") - dir.create(path = embeddingsDir, recursive = TRUE) - for (fl in embeddings) { - file.copy( - from = fl, - to = embeddingsDir, - overwrite = TRUE - ) - } - } - - - if (nPivots > 0) { - pivotTablesDir <- file.path(tmpDir, "xl", "pivotTables") - dir.create(path = pivotTablesDir, recursive = TRUE) - - pivotTablesRelsDir <- - file.path(tmpDir, "xl", "pivotTables", "_rels") - dir.create(path = pivotTablesRelsDir, recursive = TRUE) - - pivotCacheDir <- file.path(tmpDir, "xl", "pivotCache") - dir.create(path = pivotCacheDir, recursive = TRUE) - - pivotCacheRelsDir <- - file.path(tmpDir, "xl", "pivotCache", "_rels") - dir.create(path = pivotCacheRelsDir, recursive = TRUE) - - for (i in seq_along(pivotTables)) { - file.copy( - from = pivotTables[i], - to = file.path(pivotTablesDir, sprintf("pivotTable%s.xml", i)), - overwrite = TRUE, - copy.date = TRUE - ) - } - - for (i in seq_along(pivotDefinitions)) { - file.copy( - from = pivotDefinitions[i], - to = file.path(pivotCacheDir, sprintf("pivotCacheDefinition%s.xml", i)), - overwrite = TRUE, - copy.date = TRUE - ) - } - - for (i in seq_along(pivotRecords)) { - file.copy( - from = pivotRecords[i], - to = file.path(pivotCacheDir, sprintf("pivotCacheRecords%s.xml", i)), - overwrite = TRUE, - copy.date = TRUE - ) - } - - for (i in seq_along(pivotDefinitionsRels)) { - file.copy( - from = pivotDefinitionsRels[i], - to = file.path( - pivotCacheRelsDir, - sprintf("pivotCacheDefinition%s.xml.rels", i) - ), - overwrite = TRUE, - copy.date = TRUE - ) - } - - for (i in seq_along(pivotTables.xml.rels)) { - write_file( - body = pivotTables.xml.rels[[i]], - fl = file.path(pivotTablesRelsDir, sprintf("pivotTable%s.xml.rels", i)) - ) - } - } - - ## slicers - if (nSlicers > 0) { - slicersDir <- file.path(tmpDir, "xl", "slicers") - dir.create(path = slicersDir, recursive = TRUE) - - slicerCachesDir <- file.path(tmpDir, "xl", "slicerCaches") - dir.create(path = slicerCachesDir, recursive = TRUE) - - for (i in seq_along(slicers)) { - if (nchar(slicers[i]) > 0) { - file.copy(from = slicers[i], to = file.path(slicersDir, sprintf("slicer%s.xml", i))) - } - } - - - - for (i in seq_along(slicerCaches)) { - write_file( - body = slicerCaches[[i]], - fl = file.path(slicerCachesDir, sprintf("slicerCache%s.xml", i)) - ) - } - } - - - ## Write content - - ## write .rels - write_file( - head = '\n', - body = '', - tail = "", - fl = file.path(relsDir, ".rels") - ) - - - ## write app.xml - write_file( - head = '', - body = "Microsoft Excel", - tail = "", - fl = file.path(docPropsDir, "app.xml") - ) - - ## write core.xml - write_file( - head = "", - body = pxml(core), - tail = "", - fl = file.path(docPropsDir, "core.xml") - ) - - ## write workbook.xml.rels - write_file( - head = '', - body = pxml(workbook.xml.rels), - tail = "", - fl = file.path(xlrelsDir, "workbook.xml.rels") - ) - - ## write tables - if (length(unlist(tables, use.names = FALSE)) > 0) { - for (i in seq_along(unlist(tables, use.names = FALSE))) { - if (!grepl("openxlsx_deleted", attr(tables, "tableName")[i], fixed = TRUE)) { - write_file( - body = pxml(unlist(tables, use.names = FALSE)[[i]]), - fl = file.path(xlTablesDir, sprintf("table%s.xml", i + 2)) - ) - if (tables.xml.rels[[i]] != "") { - write_file( - body = tables.xml.rels[[i]], - fl = file.path(xlTablesRelsDir, sprintf("table%s.xml.rels", i + 2)) - ) - } - } - } - } - - - ## write query tables - if (length(queryTables) > 0) { - xlqueryTablesDir <- file.path(tmpDir, "xl", "queryTables") - dir.create(path = xlqueryTablesDir, recursive = TRUE) - - for (i in seq_along(queryTables)) { - write_file( - body = queryTables[[i]], - fl = file.path(xlqueryTablesDir, sprintf("queryTable%s.xml", i)) - ) - } - } - - ## connections - if (length(connections) > 0) { - write_file(body = connections, fl = file.path(xlDir, "connections.xml")) - } - - ## externalLinks - if (length(externalLinks)) { - externalLinksDir <- file.path(tmpDir, "xl", "externalLinks") - dir.create(path = externalLinksDir, recursive = TRUE) - - for (i in seq_along(externalLinks)) { - write_file( - body = externalLinks[[i]], - fl = file.path(externalLinksDir, sprintf("externalLink%s.xml", i)) - ) - } - } - - ## externalLinks rels - if (length(externalLinksRels)) { - externalLinksRelsDir <- - file.path(tmpDir, "xl", "externalLinks", "_rels") - dir.create(path = externalLinksRelsDir, recursive = TRUE) - - for (i in seq_along(externalLinksRels)) { - write_file( - body = externalLinksRels[[i]], - fl = file.path( - externalLinksRelsDir, - sprintf("externalLink%s.xml.rels", i) - ) - ) - } - } - - # printerSettings - printDir <- file.path(tmpDir, "xl", "printerSettings") - dir.create(path = printDir, recursive = TRUE) - for (i in 1:nSheets) { - writeLines(genPrinterSettings(), file.path(printDir, sprintf("printerSettings%s.bin", i))) - } - - ## media (copy file from origin to destination) - for (x in media) { - file.copy(x, file.path(xlmediaDir, names(media)[which(media == x)])) - } - - ## VBA Macro - if (!is.null(vbaProject)) { - file.copy(vbaProject, xlDir) - } - - ## write worksheet, worksheet_rels, drawings, drawing_rels - .self$writeSheetDataXML( - xldrawingsDir, - xldrawingsRelsDir, - xlworksheetsDir, - xlworksheetsRelsDir - ) - - ## write sharedStrings.xml - ct <- Content_Types - if (length(sharedStrings) > 0) { - write_file( - head = sprintf( - '', - length(sharedStrings), - attr(sharedStrings, "uniqueCount") - ), - body = stri_join(sharedStrings, collapse = "", sep = " "), - tail = "", - fl = file.path(xlDir, "sharedStrings.xml") - ) - } else { - ## Remove relationship to sharedStrings - ct <- ct[!grepl("sharedStrings", ct)] - } - - if (nComments > 0) { - ct <- - c( - ct, - '' - ) - } - - ## write [Content_type] - write_file( - head = '', - body = pxml(ct), - tail = "", - fl = file.path(tmpDir, "[Content_Types].xml") - ) - - - styleXML <- styles - styleXML$numFmts <- - stri_join( - sprintf('', length(styles$numFmts)), - pxml(styles$numFmts), - "" - ) - styleXML$fonts <- - stri_join( - sprintf('', length(styles$fonts)), - pxml(styles$fonts), - "" - ) - styleXML$fills <- - stri_join( - sprintf('', length(styles$fills)), - pxml(styles$fills), - "" - ) - styleXML$borders <- - stri_join( - sprintf('', length(styles$borders)), - pxml(styles$borders), - "" - ) - styleXML$cellStyleXfs <- - c( - sprintf('', length(styles$cellStyleXfs)), - pxml(styles$cellStyleXfs), - "" - ) - styleXML$cellXfs <- - stri_join( - sprintf('', length(styles$cellXfs)), - pxml(styles$cellXfs), - "" - ) - styleXML$cellStyles <- - stri_join( - sprintf('', length(styles$cellStyles)), - pxml(styles$cellStyles), - "" - ) - styleXML$dxfs <- - ifelse( - length(styles$dxfs) == 0, - '', - stri_join( - sprintf('', length(styles$dxfs)), - stri_join(unlist(styles$dxfs), sep = " ", collapse = ""), - "" - ) - ) - ## write styles.xml - write_file( - head = '', - body = pxml(styleXML), - tail = "", - fl = file.path(xlDir, "styles.xml") - ) - - ## write workbook.xml - workbookXML <- workbook - workbookXML$sheets <- - stri_join("", pxml(workbookXML$sheets), "") - if (length(workbookXML$definedNames) > 0) { - workbookXML$definedNames <- - stri_join( - "", - pxml(workbookXML$definedNames), - "" - ) - } - - write_file( - head = '', - body = pxml(workbookXML), - tail = "", - fl = file.path(xlDir, "workbook.xml") - ) - workbook$sheets <<- - workbook$sheets[order(sheetOrder)] ## Need to reset sheet order to allow multiple savings - - ## compress to xlsx - wd <- getwd() - tmpFile <- - basename(tempfile(fileext = ifelse(is.null(vbaProject), ".xlsx", ".xlsm"))) - on.exit(expr = setwd(wd), add = TRUE) - - ## zip it - setwd(dir = tmpDir) - cl <- - ifelse( - !is.null(getOption("openxlsx.compresssionLevel")), - getOption("openxlsx.compresssionLevel"), - getOption("openxlsx.compresssionevel", 6) - ) - zipr( - zipfile = tmpFile, include_directories = FALSE, - files = list.files(path = tmpDir, all.files = FALSE), - recurse = TRUE, - compression_level = cl - ) - - ## reset styles - maintain any changes to base font - baseFont <- styles$fonts[[1]] - styles <<- - genBaseStyleSheet(styles$dxfs, - tableStyles = styles$tableStyles, - extLst = styles$extLst - ) - styles$fonts[[1]] <<- baseFont - - - return(file.path(tmpDir, tmpFile)) - } -) - - - -Workbook$methods( - updateSharedStrings = function(uNewStr) { - ## Function will return named list of references to new strings - uStr <- uNewStr[which(!uNewStr %in% sharedStrings)] - uCount <- attr(sharedStrings, "uniqueCount") - sharedStrings <<- append(sharedStrings, uStr) - - attr(sharedStrings, "uniqueCount") <<- uCount + length(uStr) - } -) - -Workbook$methods( - validateSheet = function(sheetName) { - if (!is.numeric(sheetName)) { - if (is.null(sheet_names)) { - stop("Workbook does not contain any worksheets.", call. = FALSE) - } - } - - if (is.numeric(sheetName)) { - if (sheetName > length(sheet_names)) { - stop("This Workbook only has ", length(sheet_names), - " sheets, ", sheetName, " is not valid", - call. = FALSE - ) - } - return(sheetName) - } else if (!sheetName %in% replaceXMLEntities(sheet_names)) { - stop(sprintf("Sheet '%s' does not exist.", replaceXMLEntities(sheetName)), - call. = FALSE) - } - - which(replaceXMLEntities(sheet_names) == sheetName) - } -) - - -Workbook$methods( - getSheetName = function(sheetIndex) { - if (any(length(sheet_names) < sheetIndex)) { - stop(sprintf("Workbook only contains %s sheet(s).", length(sheet_names))) - } - - sheet_names[sheetIndex] - } -) - -Workbook$methods( - buildTable = function(sheet, - colNames, - ref, - showColNames, - tableStyle, - tableName, - withFilter, - totalsRowCount = 0, - showFirstColumn = 0, - showLastColumn = 0, - showRowStripes = 1, - showColumnStripes = 0) { - ## id will start at 3 and drawing will always be 1, printer Settings at 2 (printer settings has been removed) - id <- as.character(length(tables) + 3L) - sheet <- validateSheet(sheet) - - ## build table XML and save to tables field - table <- - sprintf( - '
', - tableStyle, - as.integer(showFirstColumn), - as.integer(showLastColumn), - as.integer(showRowStripes), - as.integer(showColumnStripes) - ) - - - tables <<- - c( - tables, - build_table_xml( - table = table, - tableStyleXML = tableStyleXML, - ref = ref, - colNames = gsub("\n|\r", "_x000a_", colNames), - showColNames = showColNames, - withFilter = withFilter - ) - ) - names(tables) <<- c(nms, ref) - attr(tables, "sheet") <<- c(tSheets, sheet) - attr(tables, "tableName") <<- c(tNames, tableName) - - worksheets[[sheet]]$tableParts <<- - append( - worksheets[[sheet]]$tableParts, - sprintf('', id) - ) - attr(worksheets[[sheet]]$tableParts, "tableName") <<- - c(tNames[tSheets == sheet & - !grepl("openxlsx_deleted", tNames, fixed = TRUE)], tableName) - - - - ## update Content_Types - Content_Types <<- - c( - Content_Types, - sprintf( - '', - id - ) - ) - - ## create a table.xml.rels - tables.xml.rels <<- append(tables.xml.rels, "") - - ## update worksheets_rels - worksheets_rels[[sheet]] <<- c( - worksheets_rels[[sheet]], - sprintf( - '', - id, - id - ) - ) - } -) - - - - - - - - - -Workbook$methods( - writeDrawingVML = function(dir) { - for (i in seq_along(comments)) { - id <- 1025 - - cd <- unlist(lapply(comments[[i]], "[[", "clientData")) - nComments <- length(cd) - - ## write head - if (nComments > 0 | length(vml[[i]]) > 0) { - write( - x = stri_join( - ' - - - - - - - ' - ), - file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), - sep = " " - ) - } - - if (nComments > 0) { - for (j in 1:nComments) { - id <- id + 1L - write( - x = genBaseShapeVML(cd[j], id), - file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), - append = TRUE - ) - } - } - - if (length(vml[[i]]) > 0) { - write( - x = vml[[i]], - file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), - append = TRUE - ) - } - - if (nComments > 0 | length(vml[[i]]) > 0) { - write( - x = "", - file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), - append = TRUE - ) - worksheets[[i]]$legacyDrawing <<- - '' - } - } - } -) - - - -Workbook$methods( - updateStyles = function(style) { - ## Updates styles.xml - xfNode <- list( - numFmtId = 0, - fontId = 0, - fillId = 0, - borderId = 0, - xfId = 0 - ) - - - alignmentFlag <- FALSE - - ## Font - if (!is.null(style$fontName) | - !is.null(style$fontSize) | - !is.null(style$fontColour) | - !is.null(style$fontDecoration) | - !is.null(style$fontFamily) | - !is.null(style$fontScheme)) { - fontNode <- .self$createFontNode(style) - fontId <- which(styles$fonts == fontNode) - 1L - - if (length(fontId) == 0) { - fontId <- length(styles$fonts) - styles$fonts <<- append(styles[["fonts"]], fontNode) - } - - xfNode$fontId <- fontId - xfNode <- append(xfNode, list("applyFont" = "1")) - } - - - ## numFmt - if (!is.null(style$numFmt)) { - if (as.integer(style$numFmt$numFmtId) > 0) { - numFmtId <- style$numFmt$numFmtId - if (as.integer(numFmtId) > 163L) { - tmp <- style$numFmt$formatCode - - styles$numFmts <<- unique(c( - styles$numFmts, - sprintf( - '', - numFmtId, - tmp - ) - )) - } - - xfNode$numFmtId <- numFmtId - xfNode <- append(xfNode, list("applyNumberFormat" = "1")) - } - } - - ## Fill - if (!is.null(style$fill)) { - fillNode <- .self$createFillNode(style) - if (!is.null(fillNode)) { - fillId <- which(styles$fills == fillNode) - 1L - - if (length(fillId) == 0) { - fillId <- length(styles$fills) - styles$fills <<- c(styles$fills, fillNode) - } - xfNode$fillId <- fillId - xfNode <- append(xfNode, list("applyFill" = "1")) - } - } - - ## Border - if (any(!is.null( - c( - style$borderLeft, - style$borderRight, - style$borderTop, - style$borderBottom, - style$borderDiagonal - ) - ))) { - borderNode <- .self$createBorderNode(style) - borderId <- which(styles$borders == borderNode) - 1L - - if (length(borderId) == 0) { - borderId <- length(styles$borders) - styles$borders <<- c(styles$borders, borderNode) - } - - xfNode$borderId <- borderId - xfNode <- append(xfNode, list("applyBorder" = "1")) - } - - - # if(!is.null(style$xfId)) - # xfNode$xfId <- style$xfId - - childNodes <- "" - - ## Alignment - if (!is.null(style$halign) | - !is.null(style$valign) | - !is.null(style$wrapText) | - !is.null(style$textRotation) | !is.null(style$indent)) { - attrs <- list() - alignNode <- "") - - alignmentFlag <- TRUE - xfNode <- append(xfNode, list("applyAlignment" = "1")) - - childNodes <- stri_join(childNodes, alignNode) - } - - if (!is.null(style$hidden) | !is.null(style$locked)) { - xfNode <- append(xfNode, list("applyProtection" = "1")) - protectionNode <- "") - childNodes <- stri_join(childNodes, protectionNode) - } - - if (length(childNodes) > 0) { - xfNode <- - stri_join( - "", - childNodes, - "" - ) - } else { - xfNode <- - stri_join("") - } - - styleId <- which(styles$cellXfs == xfNode) - 1L - if (length(styleId) == 0) { - styleId <- length(styles$cellXfs) - styles$cellXfs <<- c(styles$cellXfs, xfNode) - } - - - return(as.integer(styleId)) - } -) - - - - - -Workbook$methods( - updateCellStyles = function() { - flag <- TRUE - for (style in cellStyleObjects) { - ## Updates styles.xml - xfNode <- list( - numFmtId = 0, - fontId = 0, - fillId = 0, - borderId = 0 - ) - - - alignmentFlag <- FALSE - - ## Font - if (!is.null(style$fontName) | - !is.null(style$fontSize) | - !is.null(style$fontColour) | - !is.null(style$fontDecoration) | - !is.null(style$fontFamily) | - !is.null(style$fontScheme)) { - fontNode <- .self$createFontNode(style) - fontId <- which(styles$font == fontNode) - 1L - - if (length(fontId) == 0) { - fontId <- length(styles$fonts) - styles$fonts <<- append(styles[["fonts"]], fontNode) - } - - xfNode$fontId <- fontId - xfNode <- append(xfNode, list("applyFont" = "1")) - } - - - ## numFmt - if (!is.null(style$numFmt)) { - if (as.integer(style$numFmt$numFmtId) > 0) { - numFmtId <- style$numFmt$numFmtId - if (as.integer(numFmtId) > 163L) { - tmp <- style$numFmt$formatCode - - styles$numFmts <<- unique(c( - styles$numFmts, - sprintf( - '', - numFmtId, - tmp - ) - )) - } - - xfNode$numFmtId <- numFmtId - xfNode <- append(xfNode, list("applyNumberFormat" = "1")) - } - } - - ## Fill - if (!is.null(style$fill)) { - fillNode <- .self$createFillNode(style) - if (!is.null(fillNode)) { - fillId <- which(styles$fills == fillNode) - 1L - - if (length(fillId) == 0) { - fillId <- length(styles$fills) - styles$fills <<- c(styles$fills, fillNode) - } - xfNode$fillId <- fillId - xfNode <- append(xfNode, list("applyFill" = "1")) - } - } - - ## Border - if (any(!is.null( - c( - style$borderLeft, - style$borderRight, - style$borderTop, - style$borderBottom, - style$borderDiagonal - ) - ))) { - borderNode <- .self$createBorderNode(style) - borderId <- which(styles$borders == borderNode) - 1L - - if (length(borderId) == 0) { - borderId <- length(styles$borders) - styles$borders <<- c(styles$borders, borderNode) - } - - xfNode$borderId <- borderId - xfNode <- append(xfNode, list("applyBorder" = "1")) - } - - xfNode <- - stri_join("") - - if (flag) { - styles$cellStyleXfs <<- xfNode - flag <- FALSE - } else { - styles$cellStyleXfs <<- c(styles$cellStyleXfs, xfNode) - } - } - } -) - - - - - - - - -Workbook$methods( - getBaseFont = function() { - baseFont <- styles$fonts[[1]] - - sz <- getAttrs(baseFont, "" - - ## size - if (is.null(style$fontSize[[1]])) { - fontNode <- - stri_join(fontNode, sprintf('', names(baseFont$size), baseFont$size)) - } else { - fontNode <- - stri_join(fontNode, sprintf('', names(style$fontSize), style$fontSize)) - } - - ## colour - if (is.null(style$fontColour[[1]])) { - fontNode <- - stri_join( - fontNode, - sprintf( - '', - names(baseFont$colour), - baseFont$colour - ) - ) - } else { - if (length(style$fontColour) > 1) { - fontNode <- stri_join(fontNode, sprintf( - "", - stri_join( - sapply(seq_along(style$fontColour), function(i) { - sprintf('%s="%s"', names(style$fontColour)[i], style$fontColour[i]) - }), - sep = " ", - collapse = " " - ) - )) - } else { - fontNode <- - stri_join( - fontNode, - sprintf( - '', - names(style$fontColour), - style$fontColour - ) - ) - } - } - - - ## name - if (is.null(style$fontName[[1]])) { - fontNode <- - stri_join( - fontNode, - sprintf('', names(baseFont$name), baseFont$name) - ) - } else { - fontNode <- - stri_join( - fontNode, - sprintf('', names(style$fontName), style$fontName) - ) - } - - ### Create new font and return Id - if (!is.null(style$fontFamily)) { - fontNode <- - stri_join(fontNode, sprintf('', style$fontFamily)) - } - - if (!is.null(style$fontScheme)) { - fontNode <- - stri_join(fontNode, sprintf('', style$fontScheme)) - } - - if ("BOLD" %in% style$fontDecoration) { - fontNode <- stri_join(fontNode, "") - } - - if ("ITALIC" %in% style$fontDecoration) { - fontNode <- stri_join(fontNode, "") - } - - if ("UNDERLINE" %in% style$fontDecoration) { - fontNode <- stri_join(fontNode, '') - } - - if ("UNDERLINE2" %in% style$fontDecoration) { - fontNode <- stri_join(fontNode, '') - } - - if ("STRIKEOUT" %in% style$fontDecoration) { - fontNode <- stri_join(fontNode, "") - } - - stri_join(fontNode, "") - } -) - - -Workbook$methods( - createBorderNode = function(style) { - borderNode <- "") - - if (!is.null(style$borderLeft)) { - borderNode <- - stri_join( - borderNode, - sprintf('', style$borderLeft), - sprintf( - '', - names(style$borderLeftColour), - style$borderLeftColour - ), - "" - ) - } - - if (!is.null(style$borderRight)) { - borderNode <- - stri_join( - borderNode, - sprintf('', style$borderRight), - sprintf( - '', - names(style$borderRightColour), - style$borderRightColour - ), - "" - ) - } - - if (!is.null(style$borderTop)) { - borderNode <- - stri_join( - borderNode, - sprintf('', style$borderTop), - sprintf( - '', - names(style$borderTopColour), - style$borderTopColour - ), - "" - ) - } - - if (!is.null(style$borderBottom)) { - borderNode <- - stri_join( - borderNode, - sprintf('', style$borderBottom), - sprintf( - '', - names(style$borderBottomColour), - style$borderBottomColour - ), - "" - ) - } - - if (!is.null(style$borderDiagonal)) { - borderNode <- - stri_join( - borderNode, - sprintf('', style$borderDiagonal), - sprintf( - '', - names(style$borderDiagonalColour), - style$borderDiagonalColour - ), - "" - ) - } - - stri_join(borderNode, "") - } -) - - -Workbook$methods( - createFillNode = function(style, patternType = "solid") { - fill <- style$fill - - ## gradientFill - if (any(grepl("gradientFill", fill))) { - fillNode <- fill # stri_join("", fill, "") - } else if (!is.null(fill$fillFg) | !is.null(fill$fillBg)) { - fillNode <- - stri_join( - "", - sprintf('', patternType) - ) - - if (!is.null(fill$fillFg)) { - fillNode <- - stri_join(fillNode, sprintf( - "", - stri_join( - stri_join(names(fill$fillFg), '="', fill$fillFg, '"'), - sep = " ", - collapse = " " - ) - )) - } - - if (!is.null(fill$fillBg)) { - fillNode <- - stri_join(fillNode, sprintf( - "", - stri_join( - stri_join(names(fill$fillBg), '="', fill$fillBg, '"'), - sep = " ", - collapse = " " - ) - )) - } - - fillNode <- stri_join(fillNode, "") - } else { - return(NULL) - } - - return(fillNode) - } -) - - - - - - - -Workbook$methods( - setSheetName = function(sheet, newSheetName) { - if (newSheetName %in% sheet_names) { - stop(sprintf("Sheet %s already exists!", newSheetName)) - } - - sheet <- validateSheet(sheet) - - oldName <- sheet_names[[sheet]] - sheet_names[[sheet]] <<- newSheetName - - ## Rename in workbook - sheetId <- - regmatches( - workbook$sheets[[sheet]], - regexpr('(?<=sheetId=")[0-9]+', workbook$sheets[[sheet]], perl = TRUE) - ) - rId <- - regmatches( - workbook$sheets[[sheet]], - regexpr('(?<= r:id="rId)[0-9]+', workbook$sheets[[sheet]], perl = TRUE) - ) - workbook$sheets[[sheet]] <<- - sprintf( - '', - newSheetName, - sheetId, - rId - ) - - ## rename styleObjects sheet component - if (length(styleObjects) > 0) { - styleObjects <<- lapply(styleObjects, function(x) { - if (x$sheet == oldName) { - x$sheet <- newSheetName - } - - return(x) - }) - } - - ## rename defined names - if (length(workbook$definedNames) > 0) { - belongTo <- getDefinedNamesSheet(workbook$definedNames) - toChange <- belongTo == oldName - if (any(toChange)) { - newSheetName <- sprintf("'%s'", newSheetName) - tmp <- - gsub(oldName, newSheetName, workbook$definedName[toChange], fixed = TRUE) - tmp <- gsub("'+", "'", tmp) - workbook$definedNames[toChange] <<- tmp - } - } - } -) - - -Workbook$methods( - writeSheetDataXML = function(xldrawingsDir, - xldrawingsRelsDir, - xlworksheetsDir, - xlworksheetsRelsDir) { - ## write worksheets - # nSheets <- length(worksheets) - - for (i in seq_along(worksheets)) { - ## Write drawing i (will always exist) skip those that are empty - if (any(drawings[[i]] != "")) { - write_file( - head = '', - body = pxml(drawings[[i]]), - tail = "", - fl = file.path(xldrawingsDir, stri_join("drawing", i, ".xml")) - ) - - write_file( - head = '', - body = pxml(drawings_rels[[i]]), - tail = "", - fl = file.path(xldrawingsRelsDir, stri_join("drawing", i, ".xml.rels")) - ) - } else { - worksheets[[i]]$drawing <<- character(0) - } - - ## vml drawing - if (length(vml_rels[[i]]) > 0) { - file.copy( - from = vml_rels[[i]], - to = file.path( - xldrawingsRelsDir, - stri_join("vmlDrawing", i, ".vml.rels") - ) - ) - } - - # outlineLevelRow in SheetformatPr - if ((length(outlineLevels[[i]]) > 0) && (!grepl("outlineLevelRow", worksheets[[i]]$sheetFormatPr))) { - worksheets[[i]]$sheetFormatPr <<- gsub("/>", ' outlineLevelRow="1"/>', worksheets[[i]]$sheetFormatPr) - } - - if (isChartSheet[i]) { - chartSheetDir <- file.path(dirname(xlworksheetsDir), "chartsheets") - chartSheetRelsDir <- - file.path(dirname(xlworksheetsDir), "chartsheets", "_rels") - - if (!file.exists(chartSheetDir)) { - dir.create(chartSheetDir, recursive = TRUE) - dir.create(chartSheetRelsDir, recursive = TRUE) - } - - write_file( - body = worksheets[[i]]$get_prior_sheet_data(), - fl = file.path(chartSheetDir, stri_join("sheet", i, ".xml")) - ) - - write_file( - head = '', - body = pxml(worksheets_rels[[i]]), - tail = "", - fl = file.path(chartSheetRelsDir, sprintf("sheet%s.xml.rels", i)) - ) - } else { - ## Write worksheets - ws <- worksheets[[i]] - hasHL <- - ifelse(length(worksheets[[i]]$hyperlinks) > 0, TRUE, FALSE) - - ## reorder sheet data - worksheets[[i]]$order_sheetdata() - - prior <- ws$get_prior_sheet_data() - post <- ws$get_post_sheet_data() - - worksheets[[i]]$sheet_data$style_id <<- - as.character(worksheets[[i]]$sheet_data$style_id) - - if ((length(rowHeights[[i]]) == 0) & (length(outlineLevels[[i]]) == 0)) { - write_worksheet_xml( - prior = prior, - post = post, - sheet_data = ws$sheet_data, - R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) - ) - } else if ((length(rowHeights[[i]]) == 0) & (length(outlineLevels[[i]]) > 0)) { - write_worksheet_xml_2( - prior = prior, - post = post, - sheet_data = ws$sheet_data, - row_heights_ = NULL, - outline_levels_ = unlist(outlineLevels[[i]]), - R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) - ) - } else if ((length(rowHeights[[i]]) > 0) & (length(outlineLevels[[i]]) == 0)) { - write_worksheet_xml_2( - prior = prior, - post = post, - sheet_data = ws$sheet_data, - row_heights_ = unlist(rowHeights[[i]]), - outline_levels_ = NULL, - R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) - ) - } else { - ## row heights will always be in order and all row heights are given rows in preSaveCleanup - write_worksheet_xml_2( - prior = prior, - post = post, - sheet_data = ws$sheet_data, - row_heights_ = unlist(rowHeights[[i]]), - outline_levels_ = unlist(outlineLevels[[i]]), - R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) - ) - } - - worksheets[[i]]$sheet_data$style_id <<- integer(0) - - - ## write worksheet rels - if (length(worksheets_rels[[i]]) > 0) { - ws_rels <- worksheets_rels[[i]] - if (hasHL) { - h_inds <- stri_join(seq_along(worksheets[[i]]$hyperlinks), "h") - ws_rels <- - c(ws_rels, unlist( - lapply(seq_along(h_inds), function(j) { - worksheets[[i]]$hyperlinks[[j]]$to_target_xml(h_inds[j]) - }) - )) - } - - ## Check if any tables were deleted - remove these from rels - if (length(tables) > 0) { - table_inds <- grep("tables/table[0-9].xml", ws_rels) - - if (length(table_inds) > 0) { - ids <- - regmatches( - ws_rels[table_inds], - regexpr( - '(?<=Relationship Id=")[0-9A-Za-z]+', - ws_rels[table_inds], - perl = TRUE - ) - ) - inds <- - as.integer(gsub("[^0-9]", "", ids, perl = TRUE)) - 2L - table_nms <- attr(tables, "tableName")[inds] - is_deleted <- - grepl("openxlsx_deleted", table_nms, fixed = TRUE) - if (any(is_deleted)) { - ws_rels <- ws_rels[-table_inds[is_deleted]] - } - } - } - - - - write_file( - head = '', - body = pxml(ws_rels), - tail = "", - fl = file.path(xlworksheetsRelsDir, sprintf("sheet%s.xml.rels", i)) - ) - } - } ## end of isChartSheet[i] - } ## end of loop through 1:nSheets - - invisible(0) - } -) - - - - - -Workbook$methods( - setRowHeights = function(sheet, rows, heights) { - sheet <- validateSheet(sheet) - - ## remove any conflicting heights - flag <- names(rowHeights[[sheet]]) %in% rows - if (any(flag)) { - rowHeights[[sheet]] <<- rowHeights[[sheet]][!flag] - } - - nms <- c(names(rowHeights[[sheet]]), rows) - allRowHeights <- unlist(c(rowHeights[[sheet]], heights)) - names(allRowHeights) <- nms - - allRowHeights <- - allRowHeights[order(as.integer(names(allRowHeights)))] - - rowHeights[[sheet]] <<- allRowHeights - } -) - -Workbook$methods( - groupColumns = function(sheet) { - sheet <- validateSheet(sheet) - - hidden <- attr(colOutlineLevels[[sheet]], "hidden", exact = TRUE) - cols <- names(colOutlineLevels[[sheet]]) - - if (!grepl("outlineLevelCol", worksheets[[sheet]]$sheetFormatPr)) { - worksheets[[sheet]]$sheetFormatPr <<- sub("/>", ' outlineLevelCol="1"/>', worksheets[[sheet]]$sheetFormatPr) - } - - # Check if column is already created (by `setColWidths()` or on import) - # Note that columns are initiated by `setColWidths` first (see: order of execution in `preSaveCleanUp()`) - if (any(cols %in% names(worksheets[[sheet]]$cols))) { - - for (i in intersect(cols, names(worksheets[[sheet]]$cols))) { - outline_hidden <- attr(colOutlineLevels[[sheet]], "hidden")[attr(colOutlineLevels[[sheet]], "names") == i] - - if (grepl("outlineLevel", worksheets[[sheet]]$cols[[i]], perl = TRUE)) { - worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w+)\")", paste0(outline_hidden, "\""), worksheets[[sheet]]$cols[[i]], perl = TRUE) - } else { - worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w+)\")", paste0(outline_hidden, "\" outlineLevel=\"1\""), worksheets[[sheet]]$cols[[i]], perl = TRUE) - } - } - - cols <- cols[!cols %in% names(worksheets[[sheet]]$cols)] - hidden <- attr(colOutlineLevels[[sheet]], "hidden")[attr(colOutlineLevels[[sheet]], "names") %in% cols] - } - - if (length(cols) > 0) { - colNodes <- sprintf('', cols, cols, hidden) - names(colNodes) <- cols - worksheets[[sheet]]$cols <<- append(worksheets[[sheet]]$cols, colNodes) - } - } -) - -Workbook$methods( - groupRows = function(sheet, rows, hidden, levels) { - sheet <- validateSheet(sheet) - - - flag <- names(outlineLevels[[sheet]]) %in% rows - if (any(flag)) { - outlineLevels[[sheet]] <<- outlineLevels[[sheet]][!flag] - } - - nms <- c(names(outlineLevels[[sheet]]), rows) - - allOutlineLevels <- unlist(c(outlineLevels[[sheet]], levels)) - names(allOutlineLevels) <- nms - - existing_hidden <- attr(outlineLevels[[sheet]], "hidden", exact = TRUE) - all_hidden <- c(existing_hidden, as.character(as.integer(hidden))) - - allOutlineLevels <- - allOutlineLevels[order(as.integer(names(allOutlineLevels)))] - - outlineLevels[[sheet]] <<- allOutlineLevels - - attr(outlineLevels[[sheet]], "hidden") <<- as.character(as.integer(all_hidden)) - - - if (!grepl("outlineLevelRow", worksheets[[sheet]]$sheetFormatPr)) { - worksheets[[sheet]]$sheetFormatPr <<- gsub("/>", ' outlineLevelRow="1"/>', worksheets[[sheet]]$sheetFormatPr) - } - } -) - - - -Workbook$methods( - deleteWorksheet = function(sheet) { - # To delete a worksheet - # Remove colwidths element - # Remove drawing partname from Content_Types (drawing(sheet).xml) - # Remove highest sheet from Content_Types - # Remove drawings element - # Remove drawings_rels element - - # Remove vml element - # Remove vml_rels element - - # Remove rowHeights element - # Remove styleObjects on sheet - # Remove last sheet element from workbook - # Remove last sheet element from workbook.xml.rels - # Remove element from worksheets - # Remove element from worksheets_rels - # Remove hyperlinks - # Reduce calcChain i attributes & remove calcs on sheet - # Remove sheet from sheetOrder - # Remove queryTable references from workbook$definedNames to worksheet - # remove tables - - sheet <- validateSheet(sheet) - sheetNames <- sheet_names - nSheets <- length(unlist(sheetNames, use.names = FALSE)) - sheetName <- sheetNames[[sheet]] - - colWidths[[sheet]] <<- NULL - sheet_names <<- sheet_names[-sheet] - - ## remove last drawings(sheet).xml from Content_Types - Content_Types <<- - Content_Types[!grepl(sprintf("drawing%s.xml", nSheets), Content_Types)] - - ## remove highest sheet - Content_Types <<- - Content_Types[!grepl(sprintf("sheet%s.xml", nSheets), Content_Types)] - - drawings[[sheet]] <<- NULL - drawings_rels[[sheet]] <<- NULL - - vml[[sheet]] <<- NULL - vml_rels[[sheet]] <<- NULL - - rowHeights[[sheet]] <<- NULL - colOutlineLevels[[sheet]] <<- NULL - outlineLevels[[sheet]] <<- NULL - comments[[sheet]] <<- NULL - threadComments[[sheet]] <<- NULL - isChartSheet <<- isChartSheet[-sheet] - - ## sheetOrder - toRemove <- which(sheetOrder == sheet) - sheetOrder[sheetOrder > sheet] <<- - sheetOrder[sheetOrder > sheet] - 1L - sheetOrder <<- sheetOrder[-toRemove] - - - ## remove styleObjects - if (length(styleObjects) > 0) { - styleObjects <<- - styleObjects[unlist(lapply(styleObjects, "[[", "sheet"), use.names = FALSE) != sheetName] - } - - ## Need to remove reference from workbook.xml.rels to pivotCache - removeRels <- grep("pivotTables", worksheets_rels[[sheet]], value = TRUE) - if (length(removeRels) > 0) { - ## sheet rels links to a pivotTable file, the corresponding pivotTable_rels file links to the cacheDefn which is listing in workbook.xml.rels - ## remove reference to this file from the workbook.xml.rels - fileNo <- - as.integer(unlist(regmatches( - removeRels, - gregexpr("(?<=pivotTable)[0-9]+(?=\\.xml)", removeRels, perl = TRUE) - ))) - toRemove <- - stri_join( - sprintf("(pivotCacheDefinition%s\\.xml)", fileNo), - sep = " ", - collapse = "|" - ) - - fileNo <- grep(toRemove, pivotTables.xml.rels) - toRemove <- - stri_join( - sprintf("(pivotCacheDefinition%s\\.xml)", fileNo), - sep = " ", - collapse = "|" - ) - - ## remove reference to file from workbook.xml.res - workbook.xml.rels <<- - workbook.xml.rels[!grepl(toRemove, workbook.xml.rels)] - } - - ## As above for slicers - ## Need to remove reference from workbook.xml.rels to pivotCache - removeRels <- grepl("slicers", worksheets_rels[[sheet]]) - if (any(removeRels)) { - workbook.xml.rels <<- - workbook.xml.rels[!grepl(sprintf("(slicerCache%s\\.xml)", sheet), workbook.xml.rels)] - } - - ## wont't remove tables and then won't need to reassign table r:id's but will rename them! - worksheets[[sheet]] <<- NULL - worksheets_rels[[sheet]] <<- NULL - - if (length(tables) > 0) { - tableSheets <- attr(tables, "sheet") - tableNames <- attr(tables, "tableName") - - inds <- - tableSheets %in% sheet & - !grepl("openxlsx_deleted", attr(tables, "tableName"), fixed = TRUE) - tableSheets[tableSheets > sheet] <- - tableSheets[tableSheets > sheet] - 1L - - ## Need to flag a table as deleted - if (any(inds)) { - tableSheets[inds] <- 0 - tableNames[inds] <- - stri_join(tableNames[inds], "_openxlsx_deleted") - } - attr(tables, "tableName") <<- tableNames - attr(tables, "sheet") <<- tableSheets - } - - - ## drawing will always be the first relationship and printerSettings second - if (nSheets > 1) { - for (i in 1:(nSheets - 1L)) { - worksheets_rels[[i]][1:3] <<- genBaseSheetRels(i) - } - } else { - worksheets_rels <<- list() - } - - - ## remove sheet - sn <- - unlist(lapply(workbook$sheets, function(x) { - regmatches( - x, regexpr('(?<= name=")[^"]+', x, perl = TRUE) - ) - })) - workbook$sheets <<- workbook$sheets[!sn %in% sheetName] - - ## Reset rIds - if (nSheets > 1) { - for (i in (sheet + 1L):nSheets) { - workbook$sheets <<- - gsub(stri_join("rId", i), - stri_join("rId", i - 1L), - workbook$sheets, - fixed = TRUE - ) - } - } else { - workbook$sheets <<- NULL - } - - ## Can remove highest sheet - workbook.xml.rels <<- - workbook.xml.rels[!grepl(sprintf("sheet%s.xml", nSheets), workbook.xml.rels)] - - ## definedNames - if (length(workbook$definedNames) > 0) { - belongTo <- getDefinedNamesSheet(workbook$definedNames) - workbook$definedNames <<- - workbook$definedNames[!belongTo %in% sheetName] - } - - invisible(1) - } -) - - -Workbook$methods( - addDXFS = function(style) { - dxf <- "" - dxf <- stri_join(dxf, createFontNode(style)) - fillNode <- NULL - - if (!is.null(style$fill$fillFg) | !is.null(style$fill$fillBg)) { - dxf <- stri_join(dxf, createFillNode(style)) - } - - if (any(!is.null( - c( - style$borderLeft, - style$borderRight, - style$borderTop, - style$borderBottom, - style$borderDiagonal - ) - ))) { - dxf <- stri_join(dxf, createBorderNode(style)) - } - - dxf <- stri_join(dxf, "", sep = " ") - if (dxf %in% styles$dxfs) { - return(which(styles$dxfs == dxf) - 1L) - } - - dxfId <- length(styles$dxfs) - styles$dxfs <<- c(styles$dxfs, dxf) - - return(dxfId) - } -) - - - -Workbook$methods( - dataValidation = function(sheet, - startRow, - endRow, - startCol, - endCol, - type, - operator, - value, - allowBlank, - showInputMsg, - showErrorMsg) { - sheet <- validateSheet(sheet) - sqref <- - stri_join(getCellRefs(data.frame( - "x" = c(startRow, endRow), - "y" = c(startCol, endCol) - )), - sep = " ", - collapse = ":" - ) - - header <- - sprintf( - '', - type, - operator, - allowBlank, - showInputMsg, - showErrorMsg, - sqref - ) - - - if (type == "date") { - origin <- 25569L - if (grepl( - 'date1904="1"|date1904="true"', - stri_join(unlist(workbook), sep = " ", collapse = ""), - ignore.case = TRUE - )) { - origin <- 24107L - } - - value <- as.integer(value) + origin - } - - if (type == "time") { - origin <- 25569L - if (grepl( - 'date1904="1"|date1904="true"', - stri_join(unlist(workbook), sep = " ", collapse = ""), - ignore.case = TRUE - )) { - origin <- 24107L - } - - t <- format(value[1], "%z") - offSet <- - suppressWarnings(ifelse(substr(t, 1, 1) == "+", 1L, -1L) * (as.integer(substr(t, 2, 3)) + as.integer(substr(t, 4, 5)) / 60) / 24) - if (is.na(offSet)) { - offSet[i] <- 0 - } - - value <- as.numeric(as.POSIXct(value)) / 86400 + origin + offSet - } - - form <- - sapply(seq_along(value), function(i) { - sprintf("%s", i, value[i], i) - }) - worksheets[[sheet]]$dataValidations <<- - c( - worksheets[[sheet]]$dataValidations, - stri_join(header, stri_join(form, collapse = ""), "") - ) - - invisible(0) - } -) - - - -Workbook$methods( - dataValidation_list = function(sheet, - startRow, - endRow, - startCol, - endCol, - value, - allowBlank, - showInputMsg, - showErrorMsg) { - sheet <- validateSheet(sheet) - sqref <- - stri_join(getCellRefs(data.frame( - "x" = c(startRow, endRow), - "y" = c(startCol, endCol) - )), - sep = " ", - collapse = ":" - ) - data_val <- - sprintf( - '', - allowBlank, - showInputMsg, - showErrorMsg, - sqref - ) - - formula <- - sprintf("%s", value) - sqref <- sprintf("%s", sqref) - - xmlData <- - stri_join(data_val, formula, sqref, "") - - worksheets[[sheet]]$dataValidationsLst <<- - c(worksheets[[sheet]]$dataValidationsLst, xmlData) - - invisible(0) - } -) - - - -Workbook$methods( - conditionalFormatting = function(sheet, - startRow, - endRow, - startCol, - endCol, - dxfId, - formula, - type, - values, - params) { - sheet <- validateSheet(sheet) - sqref <- - stri_join(getCellRefs(data.frame( - "x" = c(startRow, endRow), - "y" = c(startCol, endCol) - )), collapse = ":") - - - - ## Increment priority of conditional formatting rule - if (length(worksheets[[sheet]]$conditionalFormatting) > 0) { - for (i in rev(seq_along(worksheets[[sheet]]$conditionalFormatting))) { - priority <- - regmatches( - worksheets[[sheet]]$conditionalFormatting[[i]], - regexpr( - '(?<=priority=")[0-9]+', - worksheets[[sheet]]$conditionalFormatting[[i]], - perl = TRUE - ) - ) - priority_new <- as.integer(priority) + 1L - - priority_pattern <- sprintf('priority="%s"', priority) - priority_new <- sprintf('priority="%s"', priority_new) - - ## now replace - worksheets[[sheet]]$conditionalFormatting[[i]] <<- - gsub(priority_pattern, - priority_new, - worksheets[[sheet]]$conditionalFormatting[[i]], - fixed = TRUE - ) - } - } - - nms <- c(names(worksheets[[sheet]]$conditionalFormatting), sqref) - - if (type == "colorScale") { - ## formula contains the colours - ## values contains numerics or is NULL - ## dxfId is ignored - - if (is.null(values)) { - if (length(formula) == 2L) { - cfRule <- - sprintf( - ' - - - ', - formula[[1]], - formula[[2]] - ) - } else { - cfRule <- - sprintf( - ' - - - ', - formula[[1]], - formula[[2]], - formula[[3]] - ) - } - } else { - if (length(formula) == 2L) { - cfRule <- - sprintf( - ' - - - ', - values[[1]], - values[[2]], - formula[[1]], - formula[[2]] - ) - } else { - cfRule <- - sprintf( - ' - - - ', - values[[1]], - values[[2]], - values[[3]], - formula[[1]], - formula[[2]], - formula[[3]] - ) - } - } - } else if (type == "dataBar") { - # forumula is a vector of colours of length 1 or 2 - # values is NULL or a numeric vector of equal length as formula - - if (length(formula) == 2L) { - negColour <- formula[[1]] - posColour <- formula[[2]] - } else { - posColour <- formula - negColour <- "FFFF0000" - } - - guid <- - stri_join( - "F7189283-14F7-4DE0-9601-54DE9DB", - 40000L + length(worksheets[[sheet]]$extLst) - ) - - showValue <- 1 - if ("showValue" %in% names(params)) { - showValue <- as.integer(params$showValue) - } - - gradient <- 1 - if ("gradient" %in% names(params)) { - gradient <- as.integer(params$gradient) - } - - border <- 1 - if ("border" %in% names(params)) { - border <- as.integer(params$border) - } - - if (is.null(values)) { - cfRule <- - sprintf( - ' - - - - {%s} - ', - showValue, - posColour, - guid - ) - } else { - cfRule <- - sprintf( - ' - - - - - {%s}', - showValue, - values[[1]], - values[[2]], - posColour, - guid - ) - } - - worksheets[[sheet]]$extLst <<- - c( - worksheets[[sheet]]$extLst, - gen_databar_extlst( - guid = guid, - sqref = sqref, - posColour = posColour, - negColour = negColour, - values = values, - border = border, - gradient = gradient - ) - ) - } else if (type == "expression") { - cfRule <- - sprintf( - '%s', - dxfId, - formula - ) - } else if (type == "duplicatedValues") { - cfRule <- - sprintf( - '', - dxfId - ) - } else if (type == "containsText") { - cfRule <- - sprintf( - ' - NOT(ISERROR(SEARCH("%s", %s))) - ', - dxfId, - values, - values, - unlist(strsplit(sqref, split = ":"))[[1]] - ) - } else if (type == "notContainsText") { - cfRule <- - sprintf( - ' - ISERROR(SEARCH("%s", %s)) - ', - dxfId, - values, - values, - unlist(strsplit(sqref, split = ":"))[[1]] - ) - } else if (type == "beginsWith") { - cfRule <- - sprintf( - ' - LEFT(%s,LEN("%s"))="%s" - ', - dxfId, - values, - - unlist(strsplit(sqref, split = ":"))[[1]], - values, - values - ) - } else if (type == "endsWith") { - cfRule <- - sprintf( - ' - RIGHT(%s,LEN("%s"))="%s" - ', - dxfId, - values, - - unlist(strsplit(sqref, split = ":"))[[1]], - values, - values - ) - } else if (type == "between") { - cfRule <- - sprintf( - '%s%s', - dxfId, - formula[1], - formula[2] - ) - } else if (type == "topN") { - cfRule <- - sprintf( - '', - dxfId, - values[1], - values[2] - ) - } else if (type == "bottomN") { - cfRule <- - sprintf( - '', - dxfId, - values[1], - values[2] - ) - } - - worksheets[[sheet]]$conditionalFormatting <<- - append(worksheets[[sheet]]$conditionalFormatting, cfRule) - - names(worksheets[[sheet]]$conditionalFormatting) <<- nms - - invisible(0) - } -) - - - - -Workbook$methods( - mergeCells = function(sheet, startRow, endRow, startCol, endCol) { - sheet <- validateSheet(sheetName = sheet) - - sqref <- - getCellRefs(data.frame( - "x" = c(startRow, endRow), - "y" = c(startCol, endCol) - )) - exMerges <- - regmatches( - worksheets[[sheet]]$mergeCells, - regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells) - ) - - if (!is.null(exMerges)) { - comps <- - lapply(exMerges, function(rectCoords) { - unlist(strsplit(rectCoords, split = ":")) - }) - exMergedCells <- build_cell_merges(comps = comps) - newMerge <- unlist(build_cell_merges(comps = list(sqref))) - - ## Error if merge intersects - mergeIntersections <- - sapply(exMergedCells, function(x) { - any(x %in% newMerge) - }) - if (any(mergeIntersections)) { - stop( - sprintf( - "Merge intersects with existing merged cells: \n\t\t%s.\nRemove existing merge first.", - stri_join(exMerges[mergeIntersections], collapse = "\n\t\t") - ) - ) - } - } - - worksheets[[sheet]]$mergeCells <<- - c( - worksheets[[sheet]]$mergeCells, - sprintf( - '', - stri_join(sqref, - collapse = ":", sep = - " " - ) - ) - ) - } -) - - - -Workbook$methods( - removeCellMerge = function(sheet, startRow, endRow, startCol, endCol) { - sheet <- validateSheet(sheet) - - sqref <- - getCellRefs(data.frame( - "x" = c(startRow, endRow), - "y" = c(startCol, endCol) - )) - exMerges <- - regmatches( - worksheets[[sheet]]$mergeCells, - regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells) - ) - - if (!is.null(exMerges)) { - comps <- - lapply(exMerges, function(x) { - unlist(strsplit(x, split = ":")) - }) - exMergedCells <- build_cell_merges(comps = comps) - newMerge <- unlist(build_cell_merges(comps = list(sqref))) - - ## Error if merge intersects - mergeIntersections <- - sapply(exMergedCells, function(x) { - any(x %in% newMerge) - }) - } - - ## Remove intersection - worksheets[[sheet]]$mergeCells <<- - worksheets[[sheet]]$mergeCells[!mergeIntersections] - } -) - - - - - -Workbook$methods( - freezePanes = function(sheet, - firstActiveRow = NULL, - firstActiveCol = NULL, - firstRow = FALSE, - firstCol = FALSE) { - sheet <- validateSheet(sheet) - paneNode <- NULL - - if (firstRow) { - paneNode <- - '' - } else if (firstCol) { - paneNode <- - '' - } - - - if (is.null(paneNode)) { - if (firstActiveRow == 1 & firstActiveCol == 1) { - ## nothing to do - return(NULL) - } - - if (firstActiveRow > 1 & firstActiveCol == 1) { - attrs <- sprintf('ySplit="%s"', firstActiveRow - 1L) - activePane <- "bottomLeft" - } - - if (firstActiveRow == 1 & firstActiveCol > 1) { - attrs <- sprintf('xSplit="%s"', firstActiveCol - 1L) - activePane <- "topRight" - } - - if (firstActiveRow > 1 & firstActiveCol > 1) { - attrs <- - sprintf( - 'ySplit="%s" xSplit="%s"', - firstActiveRow - 1L, - firstActiveCol - 1L - ) - activePane <- "bottomRight" - } - - topLeftCell <- - getCellRefs(data.frame(firstActiveRow, firstActiveCol)) - - paneNode <- - sprintf( - '', - stri_join(attrs, collapse = " ", sep = " "), - topLeftCell, - activePane, - activePane - ) - } - - worksheets[[sheet]]$freezePane <<- paneNode - } -) - - - -Workbook$methods( - insertImage = function(sheet, - file, - startRow, - startCol, - width, - height, - rowOffset = 0, - colOffset = 0) { - ## within the sheet the drawing node's Id refernce an id in the sheetRels - ## sheet rels reference the drawingi.xml file - ## drawingi.xml refernece drawingRels - ## drawing rels reference an image in the media folder - ## worksheetRels(sheet(i)) references drawings(j) - - sheet <- validateSheet(sheet) - - imageType <- regmatches(file, gregexpr("\\.[a-zA-Z]*$", file)) - imageType <- gsub("^\\.", "", imageType) - - imageNo <- length((drawings[[sheet]])) + 1L - mediaNo <- length(media) + 1L - - startCol <- convertFromExcelRef(startCol) - - ## update Content_Types - if (!any(grepl(stri_join("image/", imageType), Content_Types))) { - Content_Types <<- - unique(c( - sprintf( - '', - imageType, - imageType - ), - Content_Types - )) - } - - ## drawings rels (Reference from drawings.xml to image file in media folder) - drawings_rels[[sheet]] <<- c( - drawings_rels[[sheet]], - sprintf( - '', - imageNo, - mediaNo, - imageType - ) - ) - - ## write file path to media slot to copy across on save - tmp <- file - names(tmp) <- stri_join("image", mediaNo, ".", imageType) - media <<- append(media, tmp) - - ## create drawing.xml - anchor <- - '' - - from <- sprintf( - ' - %s - %s - %s - %s - ', - startCol - 1L, - colOffset, - startRow - 1L, - rowOffset - ) - - drawingsXML <- stri_join( - anchor, - from, - sprintf( - '', - width, - height - ), - genBasePic(imageNo), - "", - "" - ) - - - ## append to workbook drawing - drawings[[sheet]] <<- c(drawings[[sheet]], drawingsXML) - } -) - - - -Workbook$methods( - preSaveCleanUp = function() { - ## Steps - # Order workbook.xml.rels: - # sheets -> style -> theme -> sharedStrings -> persons -> tables -> calcChain - # Assign workbook.xml.rels children rIds, seq_along(workbook.xml.rels) - # Assign workbook$sheets rIds 1:nSheets - # - ## drawings will always be r:id1 on worksheet - ## tables will always have r:id equal to table xml file number tables/table(i).xml - - ## Every worksheet has a drawingXML as r:id 1 - ## Every worksheet has a printerSettings as r:id 2 - ## Tables from r:id 3 to nTables+3 - 1 - ## HyperLinks from nTables+3 to nTables+3+nHyperLinks-1 - ## vmlDrawing to have rId - - sheetRIds <- - as.integer(unlist(regmatches( - workbook$sheets, - gregexpr('(?<=r:id="rId)[0-9]+', workbook$sheets, perl = TRUE) - ))) - - nSheets <- length(sheetRIds) - nExtRefs <- length(externalLinks) - nPivots <- length(pivotDefinitions) - - ## add a worksheet if none added - if (nSheets == 0) { - warning("Workbook does not contain any worksheets. A worksheet will be added.", - call. = FALSE - ) - .self$addWorksheet("Sheet 1") - nSheets <- 1L - } - - ## get index of each child element for ordering - sheetInds <- grep("(worksheets|chartsheets)/sheet[0-9]+\\.xml", workbook.xml.rels) - stylesInd <- grep("styles\\.xml", workbook.xml.rels) - themeInd <- grep("theme/theme[0-9]+.xml", workbook.xml.rels) - connectionsInd <- grep("connections.xml", workbook.xml.rels) - extRefInds <- grep("externalLinks/externalLink[0-9]+.xml", workbook.xml.rels) - sharedStringsInd <- grep("sharedStrings.xml", workbook.xml.rels) - tableInds <- grep("table[0-9]+.xml", workbook.xml.rels) - personInds <- grep("person.xml", workbook.xml.rels) - - - ## Reordering of workbook.xml.rels - ## don't want to re-assign rIds for pivot tables or slicer caches - pivotNode <- grep("pivotCache/pivotCacheDefinition[0-9].xml", workbook.xml.rels, value = TRUE) - slicerNode <- grep("slicerCache[0-9]+.xml", workbook.xml.rels, value = TRUE) - - ## Reorder children of workbook.xml.rels - workbook.xml.rels <<- - workbook.xml.rels[c( - sheetInds, - extRefInds, - themeInd, - connectionsInd, - stylesInd, - sharedStringsInd, - tableInds, - personInds - )] - - ## Re assign rIds to children of workbook.xml.rels - workbook.xml.rels <<- - unlist(lapply(seq_along(workbook.xml.rels), function(i) { - gsub('(?<=Relationship Id="rId)[0-9]+', - i, - workbook.xml.rels[[i]], - perl = TRUE - ) - })) - - workbook.xml.rels <<- c(workbook.xml.rels, pivotNode, slicerNode) - - - - if (!is.null(vbaProject)) { - workbook.xml.rels <<- - c( - workbook.xml.rels, - sprintf( - '', - 1L + length(workbook.xml.rels) - ) - ) - } - - ## Reassign rId to workbook sheet elements, (order sheets by sheetId first) - workbook$sheets <<- - unlist(lapply(seq_along(workbook$sheets), function(i) { - gsub('(?<= r:id="rId)[0-9]+', i, workbook$sheets[[i]], perl = TRUE) - })) - - ## re-order worksheets if need to - if (any(sheetOrder != seq_len(nSheets))) { - workbook$sheets <<- workbook$sheets[sheetOrder] - } - - - - ## re-assign tabSelected - state <- rep.int("visible", nSheets) - state[grepl("hidden", workbook$sheets)] <- "hidden" - visible_sheet_index <- which(state %in% "visible")[[1]] - visible_sheets <- which(state %in% "visible") - workbook$bookViews <<- - sprintf( - '', - visible_sheet_index - 1L, - ActiveSheet - 1L - ) - - for(i in seq_len(nSheets)) { - worksheets[[i]]$sheetViews <<- - sub( - ' tabSelected="(1|true|false|0)"', - ifelse( - sheetOrder[ActiveSheet] == i, - ' tabSelected="true"', - ' tabSelected="false"' - ), - worksheets[[i]]$sheetViews, - ignore.case = TRUE - ) - } - # worksheets[[visible_sheet_index]]$sheetViews - - # worksheets[[visible_sheet_index]]$sheetViews <<- - # sub( - # '( tabSelected="0")|( tabSelected="false")', - # ' tabSelected="1"', - # worksheets[[visible_sheet_index]]$sheetViews, - # ignore.case = TRUE - # ) - # if (nSheets > 1) { - # for (i in (1:nSheets)[!(1:nSheets) %in% visible_sheet_index]) { - # worksheets[[i]]$sheetViews <<- - # sub( - # ' tabSelected="(1|true|false|0)"', - # ' tabSelected="false"', - # worksheets[[i]]$sheetViews, - # ignore.case = TRUE - # ) - # } - # } - - - - - - if (length(workbook$definedNames) > 0) { - sheetNames <- sheet_names[sheetOrder] - - belongTo <- getDefinedNamesSheet(workbook$definedNames) - - ## sheetNames is in re-ordered order (order it will be displayed) - newId <- match(belongTo, sheetNames) - 1L - oldId <- - as.numeric(regmatches( - workbook$definedNames, - regexpr( - '(?<= localSheetId=")[0-9]+', - workbook$definedNames, - perl = TRUE - ) - )) - - for (i in seq_along(workbook$definedNames)) { - if (!is.na(newId[i])) { - workbook$definedNames[[i]] <<- - gsub( - sprintf('localSheetId=\"%s\"', oldId[i]), - sprintf('localSheetId=\"%s\"', newId[i]), - workbook$definedNames[[i]], - fixed = TRUE - ) - } - } - } - - - - - ## update workbook r:id to match reordered workbook.xml.rels externalLink element - if (length(extRefInds) > 0) { - newInds <- as.integer(seq_along(extRefInds) + length(sheetInds)) - workbook$externalReferences <<- - stri_join( - "", - stri_join( - sprintf('', newInds), - collapse = "" - ), - "" - ) - } - - ## styles - numFmtIds <- 50000L - for (i in which(!isChartSheet)) { - worksheets[[i]]$sheet_data$style_id <<- - rep.int(x = as.integer(NA), times = worksheets[[i]]$sheet_data$n_elements) - } - - - for (x in styleObjects) { - if (length(x$rows) > 0 & length(x$cols) > 0) { - this.sty <- x$style$copy() - - if (!is.null(this.sty$numFmt)) { - if (this.sty$numFmt$numFmtId == 9999) { - this.sty$numFmt$numFmtId <- numFmtIds - numFmtIds <- numFmtIds + 1L - } - } - - - ## convert sheet name to index - sheet <- which(sheet_names == x$sheet) - sId <- - .self$updateStyles(this.sty) ## this creates the XML for styles.XML - - cells_to_style <- stri_join(x$rows, x$cols, sep = ",") - existing_cells <- - stri_join(worksheets[[sheet]]$sheet_data$rows, - worksheets[[sheet]]$sheet_data$cols, - sep = "," - ) - - ## In here we create any style_ids that don't yet exist in sheet_data - worksheets[[sheet]]$sheet_data$style_id[existing_cells %in% cells_to_style] <<- - sId - - - new_cells_to_append <- - which(!cells_to_style %in% existing_cells) - if (length(new_cells_to_append) > 0) { - worksheets[[sheet]]$sheet_data$style_id <<- - c( - worksheets[[sheet]]$sheet_data$style_id, - rep.int(x = sId, times = length(new_cells_to_append)) - ) - - worksheets[[sheet]]$sheet_data$rows <<- - c(worksheets[[sheet]]$sheet_data$rows, x$rows[new_cells_to_append]) - worksheets[[sheet]]$sheet_data$cols <<- - c(worksheets[[sheet]]$sheet_data$cols, x$cols[new_cells_to_append]) - worksheets[[sheet]]$sheet_data$t <<- - c(worksheets[[sheet]]$sheet_data$t, rep(as.integer(NA), length(new_cells_to_append))) - worksheets[[sheet]]$sheet_data$v <<- - c( - worksheets[[sheet]]$sheet_data$v, - rep(as.character(NA), length(new_cells_to_append)) - ) - worksheets[[sheet]]$sheet_data$f <<- - c( - worksheets[[sheet]]$sheet_data$f, - rep(as.character(NA), length(new_cells_to_append)) - ) - worksheets[[sheet]]$sheet_data$data_count <<- - worksheets[[sheet]]$sheet_data$data_count + 1L - - worksheets[[sheet]]$sheet_data$n_elements <<- - as.integer(length(worksheets[[sheet]]$sheet_data$rows)) - } - } - } - - - ## Make sure all rowHeights have rows, if not append them! - for (i in seq_along(worksheets)) { - if (length(rowHeights[[i]]) > 0) { - rh <- as.integer(names(rowHeights[[i]])) - missing_rows <- rh[!rh %in% worksheets[[i]]$sheet_data$rows] - n <- length(missing_rows) - - if (n > 0) { - worksheets[[i]]$sheet_data$style_id <<- - c( - worksheets[[i]]$sheet_data$style_id, - rep.int(as.integer(NA), times = n) - ) - - worksheets[[i]]$sheet_data$rows <<- - c(worksheets[[i]]$sheet_data$rows, missing_rows) - worksheets[[i]]$sheet_data$cols <<- - c( - worksheets[[i]]$sheet_data$cols, - rep.int(as.integer(NA), times = n) - ) - - worksheets[[i]]$sheet_data$t <<- - c(worksheets[[i]]$sheet_data$t, rep(as.integer(NA), times = n)) - worksheets[[i]]$sheet_data$v <<- - c( - worksheets[[i]]$sheet_data$v, - rep(as.character(NA), times = n) - ) - worksheets[[i]]$sheet_data$f <<- - c( - worksheets[[i]]$sheet_data$f, - rep(as.character(NA), times = n) - ) - worksheets[[i]]$sheet_data$data_count <<- - worksheets[[i]]$sheet_data$data_count + 1L - - worksheets[[i]]$sheet_data$n_elements <<- - as.integer(length(worksheets[[i]]$sheet_data$rows)) - } - } - - ## write colwidth and coloutline XML - if (length(colWidths[[i]]) > 0) { - invisible(.self$setColWidths(i)) - } - - if (length(colOutlineLevels[[i]]) > 0) { - invisible(.self$groupColumns(i)) - } - - - if(ActiveSheet==i) { - worksheets[[sheetOrder[i]]]$sheetViews <<- - stri_replace_all_regex( - worksheets[[sheetOrder[i]]]$sheetViews, - "tabSelected=\"(1|true|false|0)\"", - paste0("tabSelected=\"true\"") - ) - } else { - worksheets[[sheetOrder[i]]]$sheetViews <<- - stri_replace_all_regex( - worksheets[[sheetOrder[i]]]$sheetViews, - "tabSelected=\"(1|true|false|0)\"", - paste0("tabSelected=\"false\"") - ) - } - } - } -) - - - -Workbook$methods( - addStyle = function(sheet, style, rows, cols, stack) { - sheet <- sheet_names[[sheet]] - - if (length(styleObjects) == 0) { - styleObjects <<- list(list( - style = style, - sheet = sheet, - rows = rows, - cols = cols - )) - } else if (stack) { - nStyles <- length(styleObjects) - - ## ********** Assume all styleObjects cells have one a single worksheet ********** - ## Loop through existing styleObjects - newInds <- seq_along(rows) - keepStyle <- rep(TRUE, nStyles) - for (i in 1:nStyles) { - if (sheet == styleObjects[[i]]$sheet) { - ## Now check rows and cols intersect - ## toRemove are the elements that the new style doesn't apply to, we remove these from the style object as it - ## is copied, merged with the new style and given the new data points - - ex_row_cols <- - stri_join(styleObjects[[i]]$rows, styleObjects[[i]]$cols, sep = "-") - new_row_cols <- stri_join(rows, cols, sep = "-") - - - ## mergeInds are the intersection of the two styles that will need to merge - mergeInds <- which(new_row_cols %in% ex_row_cols) - - ## newInds are inds that don't exist in the current - this cumulates until the end to see if any are new - newInds <- newInds[!newInds %in% mergeInds] - - - ## If the new style does not merge - if (length(mergeInds) > 0) { - to_remove_from_this_style_object <- - which(ex_row_cols %in% new_row_cols) - - ## the new style intersects with this styleObjects[[i]], we need to remove the intersecting rows and - ## columns from styleObjects[[i]] - if (length(to_remove_from_this_style_object) > 0) { - ## remove these from style object - styleObjects[[i]]$rows <<- - styleObjects[[i]]$rows[-to_remove_from_this_style_object] - styleObjects[[i]]$cols <<- - styleObjects[[i]]$cols[-to_remove_from_this_style_object] - - if (length(styleObjects[[i]]$rows) == 0 | - length(styleObjects[[i]]$cols) == 0) { - keepStyle[i] <- - FALSE - } ## this style applies to no rows or columns anymore - } - - ## append style object for intersecting cells - - ## we are appending a new style - keepStyle <- - c(keepStyle, TRUE) ## keepStyle is used to remove styles that apply to 0 rows OR 0 columns - - ## Merge Style and append to styleObjects - styleObjects <<- - append(styleObjects, list( - list( - style = mergeStyle(styleObjects[[i]]$style, newStyle = style), - sheet = sheet, - rows = rows[mergeInds], - cols = cols[mergeInds] - ) - )) - } - } ## if sheet == styleObjects[[i]]$sheet - } ## End of loop through styles - - ## remove any styles that no longer have any affect - if (!all(keepStyle)) { - styleObjects <<- styleObjects[keepStyle] - } - - ## append style object for non-intersecting cells - if (length(newInds) > 0) { - styleObjects <<- append(styleObjects, list(list( - style = style, - sheet = sheet, - rows = rows[newInds], - cols = cols[newInds] - ))) - } - } else { - ## else we are not stacking - - styleObjects <<- append(styleObjects, list(list( - style = style, - sheet = sheet, - rows = rows, - cols = cols - ))) - } ## End if(length(styleObjects) > 0) else if(stack) {} - } -) - - - -Workbook$methods( - createNamedRegion = function(ref1, ref2, name, sheet, localSheetId = NULL) { - name <- replaceIllegalCharacters(name) - - if (is.null(localSheetId)) { - workbook$definedNames <<- c( - workbook$definedNames, - sprintf( - '\'%s\'!%s:%s', - name, - sheet, - ref1, - ref2 - ) - ) - } else { - workbook$definedNames <<- c( - workbook$definedNames, - sprintf( - '\'%s\'!%s:%s', - name, - localSheetId, - sheet, - ref1, - ref2 - ) - ) - } - } -) - - -Workbook$methods( - validate_table_name = function(tableName) { - tableName <- - tolower(tableName) ## Excel forces named regions to lowercase - - if (nchar(tableName) > 255) { - stop("tableName must be less than 255 characters.") - } - - if (grepl("$", tableName, fixed = TRUE)) { - stop("'$' character cannot exist in a tableName") - } - - if (grepl(" ", tableName, fixed = TRUE)) { - stop("spaces cannot exist in a table name") - } - - # if(!grepl("^[A-Za-z_]", tableName, perl = TRUE)) - # stop("tableName must begin with a letter or an underscore") - - if (grepl("R[0-9]+C[0-9]+", - tableName, - perl = TRUE, - ignore.case = TRUE - )) { - stop("tableName cannot be the same as a cell reference, such as R1C1") - } - - if (grepl("^[A-Z]{1,3}[0-9]+$", tableName, ignore.case = TRUE)) { - stop("tableName cannot be the same as a cell reference") - } - - if (tableName %in% attr(tables, "tableName")) { - stop(sprintf("Table with name '%s' already exists!", tableName)) - } - - return(tableName) - } -) - - -Workbook$methods( - check_overwrite_tables = function(sheet, - new_rows, - new_cols, - error_msg = "Cannot overwrite existing table with another table.", - check_table_header_only = FALSE) { - ## check not overwriting another table - if (length(tables) > 0) { - tableSheets <- attr(tables, "sheet") - sheetNo <- validateSheet(sheet) - - to_check <- - which(tableSheets %in% sheetNo & - !grepl("openxlsx_deleted", attr(tables, "tableName"), fixed = TRUE)) - - if (length(to_check) > 0) { - ## only look at tables on this sheet - - exTable <- tables[to_check] - - rows <- - lapply(names(exTable), function(rectCoords) { - as.numeric(unlist(regmatches( - rectCoords, gregexpr("[0-9]+", rectCoords) - ))) - }) - cols <- - lapply(names(exTable), function(rectCoords) { - convertFromExcelRef(unlist(regmatches( - rectCoords, gregexpr("[A-Z]+", rectCoords) - ))) - }) - - if (check_table_header_only) { - rows <- lapply(rows, function(x) { - c(x[1], x[1]) - }) - } - - - ## loop through existing tables checking if any over lap with new table - for (i in seq_along(exTable)) { - existing_cols <- cols[[i]] - existing_rows <- rows[[i]] - - if ((min(new_cols) <= max(existing_cols)) & - (max(new_cols) >= min(existing_cols)) & - (min(new_rows) <= max(existing_rows)) & - (max(new_rows) >= min(existing_rows))) { - stop(error_msg) - } - } - } ## end if(sheet %in% tableSheets) - } ## end (length(tables) > 0) - - invisible(0) - } -) - - - - -Workbook$methods( - show = function() { - exSheets <- sheet_names - nSheets <- length(exSheets) - nImages <- length(media) - nCharts <- length(charts) - nStyles <- length(styleObjects) - aSheet <- ActiveSheet - exSheets <- replaceXMLEntities(exSheets) - showText <- "A Workbook object.\n" - - if (length(aSheet) == 0) { - aSheet <- 1 - } - - ## worksheets - if (nSheets > 0) { - showText <- c(showText, "\nWorksheets:\n") - - sheetTxt <- lapply(1:nSheets, function(i) { - tmpTxt <- sprintf('Sheet %s: "%s"\n', i, exSheets[[i]]) - - if (length(rowHeights[[i]]) > 0) { - tmpTxt <- - append( - tmpTxt, - c( - "\n\tCustom row heights (row: height)\n\t", - stri_join( - sprintf("%s: %s", names(rowHeights[[i]]), round(as.numeric( - rowHeights[[i]] - ), 2)), - collapse = ", ", - sep = " " - ) - ) - ) - } - - if (length(outlineLevels[[i]]) > 0) { - tmpTxt <- - append( - tmpTxt, - c( - "\n\tGrouped rows:\n\t", - stri_join( - sprintf("%s", names(outlineLevels[[i]])), - collapse = ", ", - sep = " " - ) - ) - ) - } - - if (length(colOutlineLevels[[i]]) > 0) { - tmpTxt <- - append( - tmpTxt, - c( - "\n\tGrouped columns:\n\t", - stri_join( - sprintf("%s", names(colOutlineLevels[[i]])), - collapse = ", ", - sep = " " - ) - ) - ) - } - - if (length(colWidths[[i]]) > 0) { - cols <- names(colWidths[[i]]) - widths <- unname(colWidths[[i]]) - - widths[widths != "auto"] <- - as.numeric(widths[widths != "auto"]) - tmpTxt <- - append( - tmpTxt, - c( - "\n\tCustom column widths (column: width)\n\t ", - stri_join( - sprintf("%s: %s", cols, substr(widths, 1, 5)), - sep = " ", - collapse = ", " - ) - ) - ) - tmpTxt <- c(tmpTxt, "\n") - } - c(tmpTxt, "\n\n") - }) - - showText <- c(showText, sheetTxt, "\n") - } else { - showText <- - c(showText, "\nWorksheets:\n", "No worksheets attached\n") - } - - ## images - if (nImages > 0) { - showText <- - c( - showText, - "\nImages:\n", - sprintf('Image %s: "%s"\n', 1:nImages, media) - ) - } - - if (nCharts > 0) { - showText <- - c( - showText, - "\nCharts:\n", - sprintf('Chart %s: "%s"\n', 1:nCharts, charts) - ) - } - - if (nSheets > 0) { - showText <- - c(showText, sprintf( - "Worksheet write order: %s\n", - stri_join(sheetOrder, sep = " ", collapse = ", ") - )) - } - - - - if (aSheet >= 1) { - showText <- - c( - showText, - sprintf( - 'Active Sheet %s: "%s" \n\tPosition: %s\n', - sheetOrder[aSheet], - exSheets[[sheetOrder[aSheet]]], - aSheet - ) - ) - } - - cat(unlist(showText)) - cat("\n") - } -) - -## TO BE DEPRECATED -Workbook$methods( - conditionalFormatCell = function(sheet, - startRow, - endRow, - startCol, - endCol, - dxfId, - formula, - type) { - sheet <- validateSheet(sheet) - sqref <- - stri_join(getCellRefs(data.frame( - "x" = c(startRow, endRow), - "y" = c(startCol, endCol) - )), collapse = ":") - - ## Increment priority of conditional formatting rule - if (length((worksheets[[sheet]]$conditionalFormatting)) > 0) { - for (i in rev(seq_along(worksheets[[sheet]]$conditionalFormatting))) { - worksheets[[sheet]]$conditionalFormatting[[i]] <<- - gsub('(?<=priority=")[0-9]+', - i + 1L, - worksheets[[sheet]]$conditionalFormatting[[i]], - perl = TRUE - ) - } - } - - nms <- c(names(worksheets[[sheet]]$conditionalFormatting), sqref) - - if (type == "expression") { - cfRule <- - sprintf( - '%s', - dxfId, - formula - ) - } else if (type == "dataBar") { - if (length(formula) == 2) { - negColour <- formula[[1]] - posColour <- formula[[2]] - } else { - posColour <- formula - negColour <- "FFFF0000" - } - - guid <- - stri_join( - "F7189283-14F7-4DE0-9601-54DE9DB", - 40000L + length(worksheets[[sheet]]$extLst) - ) - cfRule <- - sprintf( - '{%s}', - posColour, - guid - ) - } else if (length(formula) == 2L) { - cfRule <- - sprintf( - '', - formula[[1]], - formula[[2]] - ) - } else { - cfRule <- - sprintf( - '', - formula[[1]], - formula[[2]], - formula[[3]] - ) - } - - worksheets[[sheet]]$conditionalFormatting <<- - append(worksheets[[sheet]]$conditionalFormatting, cfRule) - - names(worksheets[[sheet]]$conditionalFormatting) <<- nms - - invisible(0) - } -) - - - - - - -Workbook$methods( - loadStyles = function(stylesXML) { - ## Build style objects from the styles XML - stylesTxt <- readUTF8(stylesXML) - stylesTxt <- removeHeadTag(stylesTxt) - - ## Indexed colours - vals <- getNodes(xml = stylesTxt, tagIn = "") - if (length(vals) > 0) { - styles$indexedColors <<- - stri_join("", vals, "") - } - - ## dxf (don't need these, I don't think) - dxf <- getNodes(xml = stylesTxt, tagIn = " 0) { - dxf <- getNodes(xml = dxf[[1]], tagIn = "") - if (length(dxf) > 0) { - styles$dxfs <<- dxf - } - } - - tableStyles <- getNodes(xml = stylesTxt, tagIn = " 0) { - styles$tableStyles <<- stri_join(tableStyles, ">") - } - - extLst <- getNodes(xml = stylesTxt, tagIn = "") - if (length(extLst) > 0) { - styles$extLst <<- extLst - } - - - ## Number formats - numFmts <- getChildlessNode(xml = stylesTxt, tag = "numFmt") - numFmtFlag <- FALSE - if (length(numFmts) > 0) { - numFmtsIds <- - sapply(numFmts, getAttr, tag = 'numFmtId="', USE.NAMES = FALSE) - formatCodes <- - sapply(numFmts, getAttr, tag = 'formatCode="', USE.NAMES = FALSE) - numFmts <- - lapply(seq_along(numFmts), function(i) { - list("numFmtId" = numFmtsIds[[i]], "formatCode" = formatCodes[[i]]) - }) - numFmtFlag <- TRUE - } - - ## fonts will maintain, sz, color, name, family scheme - if (grepl("", stylesTxt, fixed = TRUE)) { - ## empty font node - fonts <- getNodes(xml = stylesTxt, tagIn = "") - borders <- - substr( - borders, - start = regexpr("", borders)[1], - stop = regexpr("", borders) - 1L - ) - borders <- getNodes(xml = borders, tagIn = "", - stri_join( - names(attr), - '="', - attr, - '"', - collapse = " ", - sep = "" - ) - ) - } else { - workbook$workbookProtection <<- "" - } - } -) - - - - - - - -Workbook$methods( - addCreator = function(Creator = NULL) { - if (!is.null(Creator)) { - current_creator <- - stri_match(core, regex = "(.*?)")[1, 2] - core <<- - stri_replace_all_fixed( - core, - pattern = current_creator, - replacement = stri_c(current_creator, Creator, sep = ";") - ) - } - } -) - - - - - -Workbook$methods( - getCreators = function() { - current_creator <- - stri_match(core, regex = "(.*?)")[1, 2] - - current_creator_vec <- as.character(stri_split_fixed( - str = current_creator, - pattern = ";", - simplify = T - )) - - return(current_creator_vec) - } -) - - - -Workbook$methods( - changeLastModifiedBy = function(LastModifiedBy = NULL) { - if (!is.null(LastModifiedBy)) { - current_LastModifiedBy <- - stri_match(core, regex = "(.*?)")[1, 2] - core <<- - stri_replace_all_fixed( - core, - pattern = current_LastModifiedBy, - replacement = LastModifiedBy - ) - } - } -) - - - -Workbook$methods( - setactiveSheet = function(activeSheet = NULL) { - if (is.character(activeSheet)) { - if (activeSheet %in% sheet_names) { - ActiveSheet <<- which(sheet_names[sheetOrder] == activeSheet) - } else { - stop(paste(activeSheet, "doesn't exist as sheet name.")) - } - } - - if (is.integer(activeSheet)|is.numeric(activeSheet)) { - if (activeSheet %in% seq_along(sheet_names)) { - ActiveSheet <<- which(sheetOrder==activeSheet) - }else { - stop(paste(activeSheet, "doesn't exist as sheet index.")) - } - } - - for(i in seq_along(sheet_names)){ - worksheets[[i]]$sheetViews <<- stri_replace_all_regex(worksheets[[i]]$sheetViews, - "tabSelected=\"(1|true|false|0)\"", - paste0("tabSelected=\"", - ifelse(sheetOrder[ActiveSheet] == i,"true","false") - ,"\"")) - - - } - - - - } -) + + +#' @include class_definitions.R +#' @import stringi + +Workbook$methods( + initialize = function(creator = openxlsx_getOp("creator"), + title = NULL, + subject = NULL, + category = NULL) { + charts <<- list() + isChartSheet <<- logical(0) + + colWidths <<- list() + colOutlineLevels <<- list() + attr(colOutlineLevels, "hidden") <<- NULL + connections <<- NULL + Content_Types <<- genBaseContent_Type() + core <<- + genBaseCore( + creator = creator, + title = title, + subject = subject, + category = category + ) + comments <<- list() + threadComments <<- list() + + + drawings <<- list() + drawings_rels <<- list() + + embeddings <<- NULL + externalLinks <<- NULL + externalLinksRels <<- NULL + + headFoot <<- NULL + + media <<- list() + + persons <<- NULL + + pivotTables <<- NULL + pivotTables.xml.rels <<- NULL + pivotDefinitions <<- NULL + pivotRecords <<- NULL + pivotDefinitionsRels <<- NULL + + queryTables <<- NULL + rowHeights <<- list() + outlineLevels <<- list() + attr(outlineLevels, "hidden") <<- NULL + + slicers <<- NULL + slicerCaches <<- NULL + + sheet_names <<- character(0) + sheetOrder <<- integer(0) + + sharedStrings <<- list() + attr(sharedStrings, "uniqueCount") <<- 0 + + styles <<- genBaseStyleSheet() + styleObjects <<- list() + + + tables <<- NULL + tables.xml.rels <<- NULL + theme <<- NULL + + + vbaProject <<- NULL + vml <<- list() + vml_rels <<- list() + + workbook <<- genBaseWorkbook() + workbook.xml.rels <<- genBaseWorkbook.xml.rels() + + worksheets <<- list() + worksheets_rels <<- list() + ActiveSheet <<- integer(0) + } +) + +Workbook$methods( + addWorksheet = function( + sheetName, + showGridLines = openxlsx_getOp("showGridLines"), + tabColour = openxlsx_getOp("tabColour"), + zoom = 100, + oddHeader = openxlsx_getOp("oddHeader"), + oddFooter = openxlsx_getOp("oddFooter"), + evenHeader = openxlsx_getOp("evenHeader"), + evenFooter = openxlsx_getOp("evenFooter"), + firstHeader = openxlsx_getOp("firstHeader"), + firstFooter = openxlsx_getOp("firstFooter"), + visible = TRUE, + paperSize = openxlsx_getOp("paperSize", 9), + orientation = openxlsx_getOp("orientation", "portrait"), + hdpi = openxlsx_getOp("hdpi", 300), + vdpi = openxlsx_getOp("vdpi", 300) + ) { + if (!missing(sheetName)) { + if (grepl(pattern = ":", x = sheetName)) { + stop("colon not allowed in sheet names in Excel") + } + } + newSheetIndex <- length(worksheets) + 1L + + if (newSheetIndex > 1) { + sheetId <- + max(as.integer(regmatches( + workbook$sheets, + regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE) + ))) + 1L + } else { + sheetId <- 1 + ActiveSheet <<- 1L + } + + + ## fix visible value + visible <- tolower(visible) + + if (visible == "true") { + visible <- "visible" + } else if (visible == "false") { + visible <- "hidden" + } else if (visible == "veryhidden") { + visible <- "veryHidden" + } + + ## Add sheet to workbook.xml + workbook$sheets <<- + c( + workbook$sheets, + sprintf( + '', + sheetName, + sheetId, + visible, + newSheetIndex + ) + ) + + ## append to worksheets list + worksheets <<- + append( + worksheets, + WorkSheet$new( + showGridLines = showGridLines, + tabSelected = newSheetIndex == 1, + tabColour = tabColour, + zoom = zoom, + oddHeader = oddHeader, + oddFooter = oddFooter, + evenHeader = evenHeader, + evenFooter = evenFooter, + firstHeader = firstHeader, + firstFooter = firstFooter, + paperSize = paperSize, + orientation = orientation, + hdpi = hdpi, + vdpi = vdpi + ) + ) + + + ## update content_tyes + ## add a drawing.xml for the worksheet + Content_Types <<- + c( + Content_Types, + sprintf( + '', + newSheetIndex + ), + sprintf( + '', + newSheetIndex + ) + ) + + ## Update xl/rels + workbook.xml.rels <<- c( + workbook.xml.rels, + sprintf( + '', + newSheetIndex + ) + ) + + + ## create sheet.rels to simplify id assignment + worksheets_rels[[newSheetIndex]] <<- + genBaseSheetRels(newSheetIndex) + drawings_rels[[newSheetIndex]] <<- list() + drawings[[newSheetIndex]] <<- list() + + vml_rels[[newSheetIndex]] <<- list() + vml[[newSheetIndex]] <<- list() + + isChartSheet[[newSheetIndex]] <<- FALSE + comments[[newSheetIndex]] <<- list() + threadComments[[newSheetIndex]] <<- list() + + rowHeights[[newSheetIndex]] <<- list() + colWidths[[newSheetIndex]] <<- list() + colOutlineLevels[[newSheetIndex]] <<- list() + outlineLevels[[newSheetIndex]] <<- list() + + sheetOrder <<- c(sheetOrder, as.integer(newSheetIndex)) + sheet_names <<- c(sheet_names, sheetName) + + invisible(newSheetIndex) + } +) + +Workbook$methods( + cloneWorksheet = function(sheetName, clonedSheet) { + clonedSheet <- validateSheet(clonedSheet) + if (!missing(sheetName)) { + if (grepl(pattern = ":", x = sheetName)) { + stop("colon not allowed in sheet names in Excel") + } + } + newSheetIndex <- length(worksheets) + 1L + if (newSheetIndex > 1) { + sheetId <- + max(as.integer(regmatches( + workbook$sheets, + regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE) + ))) + 1L + } else { + sheetId <- 1 + } + + + ## copy visibility from cloned sheet! + visible <- + regmatches( + workbook$sheets[[clonedSheet]], + regexpr('(?<=state=")[^"]+', workbook$sheets[[clonedSheet]], perl = TRUE) + ) + + ## Add sheet to workbook.xml + workbook$sheets <<- + c( + workbook$sheets, + sprintf( + '', + sheetName, + sheetId, + visible, + newSheetIndex + ) + ) + + ## append to worksheets list + worksheets <<- + append(worksheets, worksheets[[clonedSheet]]$copy()) + + + ## update content_tyes + ## add a drawing.xml for the worksheet + Content_Types <<- + c( + Content_Types, + sprintf( + '', + newSheetIndex + ), + sprintf( + '', + newSheetIndex + ) + ) + + ## Update xl/rels + workbook.xml.rels <<- c( + workbook.xml.rels, + sprintf( + '', + newSheetIndex + ) + ) + + ## create sheet.rels to simplify id assignment + worksheets_rels[[newSheetIndex]] <<- + genBaseSheetRels(newSheetIndex) + drawings_rels[[newSheetIndex]] <<- drawings_rels[[clonedSheet]] + + # give each chart its own filename (images can re-use the same file, but charts can't) + drawings_rels[[newSheetIndex]] <<- + sapply(drawings_rels[[newSheetIndex]], function(rl) { + chartfiles <- + regmatches( + rl, + gregexpr("(?<=charts/)chart[0-9]+\\.xml", rl, perl = TRUE) + )[[1]] + for (cf in chartfiles) { + chartid <- length(charts) + 1 + newname <- stri_join("chart", chartid, ".xml") + fl <- charts[cf] + + # Read the chartfile and adjust all formulas to point to the new + # sheet name instead of the clone source + # The result is saved to a new chart xml file + newfl <- file.path(dirname(fl), newname) + charts[newname] <<- newfl + chart <- readUTF8(fl) + chart <- + gsub( + stri_join("(?<=')", sheet_names[[clonedSheet]], "(?='!)"), + stri_join("'", sheetName, "'"), + chart, + perl = TRUE + ) + chart <- + gsub( + stri_join("(?<=[^A-Za-z0-9])", sheet_names[[clonedSheet]], "(?=!)"), + stri_join("'", sheetName, "'"), + chart, + perl = TRUE + ) + writeLines(chart, newfl) + # file.copy(fl, newfl) + Content_Types <<- + c( + Content_Types, + sprintf( + '', + newname + ) + ) + rl <- gsub(stri_join("(?<=charts/)", cf), newname, rl, perl = TRUE) + } + rl + }, USE.NAMES = FALSE) + # The IDs in the drawings array are sheet-specific, so within the new cloned sheet + # the same IDs can be used => no need to modify drawings + drawings[[newSheetIndex]] <<- drawings[[clonedSheet]] + + vml_rels[[newSheetIndex]] <<- vml_rels[[clonedSheet]] + vml[[newSheetIndex]] <<- vml[[clonedSheet]] + + isChartSheet[[newSheetIndex]] <<- isChartSheet[[clonedSheet]] + comments[[newSheetIndex]] <<- comments[[clonedSheet]] + threadComments[[newSheetIndex]] <<- threadComments[[clonedSheet]] + + rowHeights[[newSheetIndex]] <<- rowHeights[[clonedSheet]] + colWidths[[newSheetIndex]] <<- colWidths[[clonedSheet]] + + colOutlineLevels[[newSheetIndex]] <<- colOutlineLevels[[clonedSheet]] + outlineLevels[[newSheetIndex]] <<- outlineLevels[[clonedSheet]] + + sheetOrder <<- c(sheetOrder, as.integer(newSheetIndex)) + sheet_names <<- c(sheet_names, sheetName) + + + ############################ + ## STYLE + ## ... objects are stored in a global list, so we need to get all styles + ## assigned to the cloned sheet and duplicate them + sheetStyles <- Filter(function(s) { + s$sheet == sheet_names[[clonedSheet]] + }, styleObjects) + styleObjects <<- c( + styleObjects, + Map(function(s) { + s$sheet <- sheetName + s + }, sheetStyles) + ) + + + ############################ + ## TABLES + ## ... are stored in the $tables list, with the name and sheet as attr + ## and in the worksheets[]$tableParts list. We also need to adjust the + ## worksheets_rels and set the content type for the new table + + tbls <- tables[attr(tables, "sheet") == clonedSheet] + for (t in tbls) { + # Extract table name, displayName and ID from the xml + oldname <- regmatches(t, regexpr('(?<= name=")[^"]+', t, perl = TRUE)) + olddispname <- regmatches(t, regexpr('(?<= displayName=")[^"]+', t, perl = TRUE)) + oldid <- regmatches(t, regexpr('(?<= id=")[^"]+', t, perl = TRUE)) + ref <- regmatches(t, regexpr('(?<= ref=")[^"]+', t, perl = TRUE)) + + # Find new, unused table names by appending _n, where n=1,2,... + n <- 0 + while (stri_join(oldname, "_", n) %in% attr(tables, "tableName")) { + n <- n + 1 + } + newname <- stri_join(oldname, "_", n) + newdispname <- stri_join(olddispname, "_", n) + newid <- as.character(length(tables) + 3L) + + # Use the table definition from the cloned sheet and simply replace the names + newt <- t + newt <- + gsub( + stri_join(" name=\"", oldname, "\""), + stri_join(" name=\"", newname, "\""), + newt + ) + newt <- + gsub( + stri_join(" displayName=\"", olddispname, "\""), + stri_join(" displayName=\"", newdispname, "\""), + newt + ) + newt <- + gsub( + stri_join("(
', newid)) + attr(worksheets[[newSheetIndex]]$tableParts, "tableName") <<- + c(attr(oldparts, "tableName"), newname) + names(attr(worksheets[[newSheetIndex]]$tableParts, "tableName")) <<- + c(names(attr(oldparts, "tableName")), ref) + + Content_Types <<- + c( + Content_Types, + sprintf( + '', + newid + ) + ) + tables.xml.rels <<- append(tables.xml.rels, "") + + worksheets_rels[[newSheetIndex]] <<- + c( + worksheets_rels[[newSheetIndex]], + sprintf( + '', + newid, + newid + ) + ) + } + + # TODO: The following items are currently NOT copied/duplicated for the cloned sheet: + # - Comments + # - Pivot tables + + invisible(newSheetIndex) + } +) + +Workbook$methods( + addChartSheet = function(sheetName, + tabColour = NULL, + zoom = 100) { + newSheetIndex <- length(worksheets) + 1L + + if (newSheetIndex > 1) { + sheetId <- + max(as.integer(regmatches( + workbook$sheets, + regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE) + ))) + 1L + } else { + sheetId <- 1 + } + + ## Add sheet to workbook.xml + workbook$sheets <<- + c( + workbook$sheets, + sprintf( + '', + sheetName, + sheetId, + newSheetIndex + ) + ) + + ## append to worksheets list + worksheets <<- + append( + worksheets, + ChartSheet$new( + tabSelected = newSheetIndex == 1, + tabColour = tabColour, + zoom = zoom + ) + ) + sheet_names <<- c(sheet_names, sheetName) + + ## update content_tyes + Content_Types <<- + c( + Content_Types, + sprintf( + '', + newSheetIndex + ) + ) + + ## Update xl/rels + workbook.xml.rels <<- c( + workbook.xml.rels, + sprintf( + '', + newSheetIndex + ) + ) + + ## add a drawing.xml for the worksheet + Content_Types <<- + c( + Content_Types, + sprintf( + '', + newSheetIndex + ) + ) + + ## create sheet.rels to simplify id assignment + worksheets_rels[[newSheetIndex]] <<- + genBaseSheetRels(newSheetIndex) + drawings_rels[[newSheetIndex]] <<- list() + drawings[[newSheetIndex]] <<- list() + + isChartSheet[[newSheetIndex]] <<- TRUE + + rowHeights[[newSheetIndex]] <<- list() + colWidths[[newSheetIndex]] <<- list() + + colOutlineLevels[[newSheetIndex]] <<- list() + outlineLevels[[newSheetIndex]] <<- list() + + vml_rels[[newSheetIndex]] <<- list() + vml[[newSheetIndex]] <<- list() + + sheetOrder <<- c(sheetOrder, newSheetIndex) + + invisible(newSheetIndex) + } +) + + + +Workbook$methods( + saveWorkbook = function() { + ## temp directory to save XML files prior to compressing + tmpDir <- file.path(tempfile(pattern = "workbookTemp_")) + + if (file.exists(tmpDir)) { + unlink(tmpDir, recursive = TRUE, force = TRUE) + } + + success <- dir.create(path = tmpDir, recursive = TRUE) + if (!success) { + stop(sprintf("Failed to create temporary directory '%s'", tmpDir)) + } + + .self$preSaveCleanUp() + + nSheets <- length(worksheets) + nThemes <- length(theme) + nPivots <- length(pivotDefinitions) + nSlicers <- length(slicers) + nComments <- sum(sapply(comments, length) > 0) + nThreadComments <- sum(sapply(threadComments, length) > 0) + nPersons <- length(persons) + nVML <- sum(sapply(vml, length) > 0) + + relsDir <- file.path(tmpDir, "_rels") + dir.create(path = relsDir, recursive = TRUE) + + docPropsDir <- file.path(tmpDir, "docProps") + dir.create(path = docPropsDir, recursive = TRUE) + + xlDir <- file.path(tmpDir, "xl") + dir.create(path = xlDir, recursive = TRUE) + + xlrelsDir <- file.path(tmpDir, "xl", "_rels") + dir.create(path = xlrelsDir, recursive = TRUE) + + xlTablesDir <- file.path(tmpDir, "xl", "tables") + dir.create(path = xlTablesDir, recursive = TRUE) + + xlTablesRelsDir <- file.path(xlTablesDir, "_rels") + dir.create(path = xlTablesRelsDir, recursive = TRUE) + + if (length(media) > 0) { + xlmediaDir <- file.path(tmpDir, "xl", "media") + dir.create(path = xlmediaDir, recursive = TRUE) + } + + + ## will always have a theme + xlthemeDir <- file.path(tmpDir, "xl", "theme") + dir.create(path = xlthemeDir, recursive = TRUE) + + if (is.null(theme)) { + con <- file(file.path(xlthemeDir, "theme1.xml"), open = "wb") + writeBin(charToRaw(genBaseTheme()), con) + close(con) + } else { + lapply(1:nThemes, function(i) { + con <- + file(file.path(xlthemeDir, stri_join("theme", i, ".xml")), open = "wb") + writeBin(charToRaw(pxml(theme[[i]])), con) + close(con) + }) + } + + ## will always have drawings + xlworksheetsDir <- file.path(tmpDir, "xl", "worksheets") + dir.create(path = xlworksheetsDir, recursive = TRUE) + + xlworksheetsRelsDir <- + file.path(tmpDir, "xl", "worksheets", "_rels") + dir.create(path = xlworksheetsRelsDir, recursive = TRUE) + + xldrawingsDir <- file.path(tmpDir, "xl", "drawings") + dir.create(path = xldrawingsDir, recursive = TRUE) + + xldrawingsRelsDir <- file.path(tmpDir, "xl", "drawings", "_rels") + dir.create(path = xldrawingsRelsDir, recursive = TRUE) + + ## charts + if (length(charts) > 0) { + file.copy( + from = dirname(charts[1]), + to = file.path(tmpDir, "xl"), + recursive = TRUE + ) + } + + + ## xl/comments.xml + if (nComments > 0 | nVML > 0) { + for (i in 1:nSheets) { + if (length(comments[[i]]) > 0) { + fn <- sprintf("comments%s.xml", i) + + Content_Types <<- c( + Content_Types, + sprintf( + '', + fn + ) + ) + + worksheets_rels[[i]] <<- unique(c( + worksheets_rels[[i]], + sprintf( + '', + fn + ) + )) + + writeCommentXML( + comment_list = comments[[i]], + file_name = file.path(tmpDir, "xl", fn) + ) + } + } + + .self$writeDrawingVML(xldrawingsDir) + } + + ## Threaded Comments xl/threadedComments/threadedComment.xml + if (nThreadComments > 0){ + xlThreadComments <- file.path(tmpDir, "xl", "threadedComments") + dir.create(path = xlThreadComments, recursive = TRUE) + + for (i in seq_len(nSheets)) { + if (length(threadComments[[i]]) > 0) { + fl <- threadComments[[i]] + file.copy( + from = fl, + to = file.path(xlThreadComments, basename(fl)), + overwrite = TRUE, + copy.date = TRUE + ) + + worksheets_rels[[i]] <<- unique(c( + worksheets_rels[[i]], + sprintf( + '', + basename(fl) + ) + )) + } + } + } + + ## xl/persons/person.xml + if (nPersons > 0){ + personDir <- file.path(tmpDir, "xl", "persons") + dir.create(path = personDir, recursive = TRUE) + file.copy( + from = persons, + to = personDir, + overwrite = TRUE + ) + + } + + + if (length(embeddings) > 0) { + embeddingsDir <- file.path(tmpDir, "xl", "embeddings") + dir.create(path = embeddingsDir, recursive = TRUE) + for (fl in embeddings) { + file.copy( + from = fl, + to = embeddingsDir, + overwrite = TRUE + ) + } + } + + + if (nPivots > 0) { + pivotTablesDir <- file.path(tmpDir, "xl", "pivotTables") + dir.create(path = pivotTablesDir, recursive = TRUE) + + pivotTablesRelsDir <- + file.path(tmpDir, "xl", "pivotTables", "_rels") + dir.create(path = pivotTablesRelsDir, recursive = TRUE) + + pivotCacheDir <- file.path(tmpDir, "xl", "pivotCache") + dir.create(path = pivotCacheDir, recursive = TRUE) + + pivotCacheRelsDir <- + file.path(tmpDir, "xl", "pivotCache", "_rels") + dir.create(path = pivotCacheRelsDir, recursive = TRUE) + + for (i in seq_along(pivotTables)) { + file.copy( + from = pivotTables[i], + to = file.path(pivotTablesDir, sprintf("pivotTable%s.xml", i)), + overwrite = TRUE, + copy.date = TRUE + ) + } + + for (i in seq_along(pivotDefinitions)) { + file.copy( + from = pivotDefinitions[i], + to = file.path(pivotCacheDir, sprintf("pivotCacheDefinition%s.xml", i)), + overwrite = TRUE, + copy.date = TRUE + ) + } + + for (i in seq_along(pivotRecords)) { + file.copy( + from = pivotRecords[i], + to = file.path(pivotCacheDir, sprintf("pivotCacheRecords%s.xml", i)), + overwrite = TRUE, + copy.date = TRUE + ) + } + + for (i in seq_along(pivotDefinitionsRels)) { + file.copy( + from = pivotDefinitionsRels[i], + to = file.path( + pivotCacheRelsDir, + sprintf("pivotCacheDefinition%s.xml.rels", i) + ), + overwrite = TRUE, + copy.date = TRUE + ) + } + + for (i in seq_along(pivotTables.xml.rels)) { + write_file( + body = pivotTables.xml.rels[[i]], + fl = file.path(pivotTablesRelsDir, sprintf("pivotTable%s.xml.rels", i)) + ) + } + } + + ## slicers + if (nSlicers > 0) { + slicersDir <- file.path(tmpDir, "xl", "slicers") + dir.create(path = slicersDir, recursive = TRUE) + + slicerCachesDir <- file.path(tmpDir, "xl", "slicerCaches") + dir.create(path = slicerCachesDir, recursive = TRUE) + + for (i in seq_along(slicers)) { + if (nchar(slicers[i]) > 0) { + file.copy(from = slicers[i], to = file.path(slicersDir, sprintf("slicer%s.xml", i))) + } + } + + + + for (i in seq_along(slicerCaches)) { + write_file( + body = slicerCaches[[i]], + fl = file.path(slicerCachesDir, sprintf("slicerCache%s.xml", i)) + ) + } + } + + + ## Write content + + ## write .rels + write_file( + head = '\n', + body = '', + tail = "", + fl = file.path(relsDir, ".rels") + ) + + app <- "Microsoft Excel" + # further protect argument (might be extended with: , , , , , , ) + if (!is.null(workbook$apps)) app <- paste0(app, workbook$apps) + + ## write app.xml + write_file( + head = '', + body = app, + tail = "", + fl = file.path(docPropsDir, "app.xml") + ) + + ## write core.xml + write_file( + head = "", + body = pxml(core), + tail = "", + fl = file.path(docPropsDir, "core.xml") + ) + + ## write workbook.xml.rels + write_file( + head = '', + body = pxml(workbook.xml.rels), + tail = "", + fl = file.path(xlrelsDir, "workbook.xml.rels") + ) + + ## write tables + if (length(unlist(tables, use.names = FALSE)) > 0) { + for (i in seq_along(unlist(tables, use.names = FALSE))) { + if (!grepl("openxlsx_deleted", attr(tables, "tableName")[i], fixed = TRUE)) { + write_file( + body = pxml(unlist(tables, use.names = FALSE)[[i]]), + fl = file.path(xlTablesDir, sprintf("table%s.xml", i + 2)) + ) + if (tables.xml.rels[[i]] != "") { + write_file( + body = tables.xml.rels[[i]], + fl = file.path(xlTablesRelsDir, sprintf("table%s.xml.rels", i + 2)) + ) + } + } + } + } + + + ## write query tables + if (length(queryTables) > 0) { + xlqueryTablesDir <- file.path(tmpDir, "xl", "queryTables") + dir.create(path = xlqueryTablesDir, recursive = TRUE) + + for (i in seq_along(queryTables)) { + write_file( + body = queryTables[[i]], + fl = file.path(xlqueryTablesDir, sprintf("queryTable%s.xml", i)) + ) + } + } + + ## connections + if (length(connections) > 0) { + write_file(body = connections, fl = file.path(xlDir, "connections.xml")) + } + + ## externalLinks + if (length(externalLinks)) { + externalLinksDir <- file.path(tmpDir, "xl", "externalLinks") + dir.create(path = externalLinksDir, recursive = TRUE) + + for (i in seq_along(externalLinks)) { + write_file( + body = externalLinks[[i]], + fl = file.path(externalLinksDir, sprintf("externalLink%s.xml", i)) + ) + } + } + + ## externalLinks rels + if (length(externalLinksRels)) { + externalLinksRelsDir <- + file.path(tmpDir, "xl", "externalLinks", "_rels") + dir.create(path = externalLinksRelsDir, recursive = TRUE) + + for (i in seq_along(externalLinksRels)) { + write_file( + body = externalLinksRels[[i]], + fl = file.path( + externalLinksRelsDir, + sprintf("externalLink%s.xml.rels", i) + ) + ) + } + } + + # printerSettings + printDir <- file.path(tmpDir, "xl", "printerSettings") + dir.create(path = printDir, recursive = TRUE) + for (i in 1:nSheets) { + writeLines(genPrinterSettings(), file.path(printDir, sprintf("printerSettings%s.bin", i))) + } + + ## media (copy file from origin to destination) + for (x in media) { + file.copy(x, file.path(xlmediaDir, names(media)[which(media == x)])) + } + + ## VBA Macro + if (!is.null(vbaProject)) { + file.copy(vbaProject, xlDir) + } + + ## write worksheet, worksheet_rels, drawings, drawing_rels + .self$writeSheetDataXML( + xldrawingsDir, + xldrawingsRelsDir, + xlworksheetsDir, + xlworksheetsRelsDir + ) + + ## write sharedStrings.xml + ct <- Content_Types + if (length(sharedStrings) > 0) { + write_file( + head = sprintf( + '', + length(sharedStrings), + attr(sharedStrings, "uniqueCount") + ), + body = stri_join(sharedStrings, collapse = "", sep = " "), + tail = "", + fl = file.path(xlDir, "sharedStrings.xml") + ) + } else { + ## Remove relationship to sharedStrings + ct <- ct[!grepl("sharedStrings", ct)] + } + + if (nComments > 0) { + ct <- + c( + ct, + '' + ) + } + + ## write [Content_type] + write_file( + head = '', + body = pxml(ct), + tail = "", + fl = file.path(tmpDir, "[Content_Types].xml") + ) + + + styleXML <- styles + styleXML$numFmts <- + stri_join( + sprintf('', length(styles$numFmts)), + pxml(styles$numFmts), + "" + ) + styleXML$fonts <- + stri_join( + sprintf('', length(styles$fonts)), + pxml(styles$fonts), + "" + ) + styleXML$fills <- + stri_join( + sprintf('', length(styles$fills)), + pxml(styles$fills), + "" + ) + styleXML$borders <- + stri_join( + sprintf('', length(styles$borders)), + pxml(styles$borders), + "" + ) + styleXML$cellStyleXfs <- + c( + sprintf('', length(styles$cellStyleXfs)), + pxml(styles$cellStyleXfs), + "" + ) + styleXML$cellXfs <- + stri_join( + sprintf('', length(styles$cellXfs)), + pxml(styles$cellXfs), + "" + ) + styleXML$cellStyles <- + stri_join( + sprintf('', length(styles$cellStyles)), + pxml(styles$cellStyles), + "" + ) + styleXML$dxfs <- + ifelse( + length(styles$dxfs) == 0, + '', + stri_join( + sprintf('', length(styles$dxfs)), + stri_join(unlist(styles$dxfs), sep = " ", collapse = ""), + "" + ) + ) + ## write styles.xml + write_file( + head = '', + body = pxml(styleXML), + tail = "", + fl = file.path(xlDir, "styles.xml") + ) + + ## write workbook.xml + workbookXML <- workbook + workbookXML$sheets <- + stri_join("", pxml(workbookXML$sheets), "") + if (length(workbookXML$definedNames) > 0) { + workbookXML$definedNames <- + stri_join( + "", + pxml(workbookXML$definedNames), + "" + ) + } + + write_file( + head = '', + body = pxml(workbookXML), + tail = "", + fl = file.path(xlDir, "workbook.xml") + ) + workbook$sheets <<- + workbook$sheets[order(sheetOrder)] ## Need to reset sheet order to allow multiple savings + + ## compress to xlsx + wd <- getwd() + tmpFile <- + basename(tempfile(fileext = ifelse(is.null(vbaProject), ".xlsx", ".xlsm"))) + on.exit(expr = setwd(wd), add = TRUE) + + ## zip it + setwd(dir = tmpDir) + cl <- + ifelse( + !is.null(getOption("openxlsx.compresssionLevel")), + getOption("openxlsx.compresssionLevel"), + getOption("openxlsx.compresssionevel", 6) + ) + zipr( + zipfile = tmpFile, include_directories = FALSE, + files = list.files(path = tmpDir, all.files = FALSE), + recurse = TRUE, + compression_level = cl + ) + + ## reset styles - maintain any changes to base font + baseFont <- styles$fonts[[1]] + styles <<- + genBaseStyleSheet(styles$dxfs, + tableStyles = styles$tableStyles, + extLst = styles$extLst + ) + styles$fonts[[1]] <<- baseFont + + + return(file.path(tmpDir, tmpFile)) + } +) + + + +Workbook$methods( + updateSharedStrings = function(uNewStr) { + ## Function will return named list of references to new strings + uStr <- uNewStr[which(!uNewStr %in% sharedStrings)] + uCount <- attr(sharedStrings, "uniqueCount") + sharedStrings <<- append(sharedStrings, uStr) + + attr(sharedStrings, "uniqueCount") <<- uCount + length(uStr) + } +) + +Workbook$methods( + validateSheet = function(sheetName) { + if (!is.numeric(sheetName)) { + if (is.null(sheet_names)) { + stop("Workbook does not contain any worksheets.", call. = FALSE) + } + } + + if (is.numeric(sheetName)) { + if (sheetName > length(sheet_names)) { + stop("This Workbook only has ", length(sheet_names), + " sheets, ", sheetName, " is not valid", + call. = FALSE + ) + } + return(sheetName) + } else if (!sheetName %in% replaceXMLEntities(sheet_names)) { + stop(sprintf("Sheet '%s' does not exist.", replaceXMLEntities(sheetName)), + call. = FALSE) + } + + which(replaceXMLEntities(sheet_names) == sheetName) + } +) + + +Workbook$methods( + getSheetName = function(sheetIndex) { + if (any(length(sheet_names) < sheetIndex)) { + stop(sprintf("Workbook only contains %s sheet(s).", length(sheet_names))) + } + + sheet_names[sheetIndex] + } +) + +Workbook$methods( + buildTable = function(sheet, + colNames, + ref, + showColNames, + tableStyle, + tableName, + withFilter, + totalsRowCount = 0, + showFirstColumn = 0, + showLastColumn = 0, + showRowStripes = 1, + showColumnStripes = 0) { + ## id will start at 3 and drawing will always be 1, printer Settings at 2 (printer settings has been removed) + id <- as.character(length(tables) + 3L) + sheet <- validateSheet(sheet) + + ## build table XML and save to tables field + table <- + sprintf( + '
', + tableStyle, + as.integer(showFirstColumn), + as.integer(showLastColumn), + as.integer(showRowStripes), + as.integer(showColumnStripes) + ) + + + tables <<- + c( + tables, + build_table_xml( + table = table, + tableStyleXML = tableStyleXML, + ref = ref, + colNames = gsub("\n|\r", "_x000a_", colNames), + showColNames = showColNames, + withFilter = withFilter + ) + ) + names(tables) <<- c(nms, ref) + attr(tables, "sheet") <<- c(tSheets, sheet) + attr(tables, "tableName") <<- c(tNames, tableName) + + worksheets[[sheet]]$tableParts <<- + append( + worksheets[[sheet]]$tableParts, + sprintf('', id) + ) + attr(worksheets[[sheet]]$tableParts, "tableName") <<- + c(tNames[tSheets == sheet & + !grepl("openxlsx_deleted", tNames, fixed = TRUE)], tableName) + + + + ## update Content_Types + Content_Types <<- + c( + Content_Types, + sprintf( + '', + id + ) + ) + + ## create a table.xml.rels + tables.xml.rels <<- append(tables.xml.rels, "") + + ## update worksheets_rels + worksheets_rels[[sheet]] <<- c( + worksheets_rels[[sheet]], + sprintf( + '', + id, + id + ) + ) + } +) + + + + + + + + + +Workbook$methods( + writeDrawingVML = function(dir) { + for (i in seq_along(comments)) { + id <- 1025 + + cd <- unlist(lapply(comments[[i]], "[[", "clientData")) + nComments <- length(cd) + + ## write head + if (nComments > 0 | length(vml[[i]]) > 0) { + write( + x = stri_join( + ' + + + + + + + ' + ), + file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), + sep = " " + ) + } + + if (nComments > 0) { + for (j in 1:nComments) { + id <- id + 1L + write( + x = genBaseShapeVML(cd[j], id), + file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), + append = TRUE + ) + } + } + + if (length(vml[[i]]) > 0) { + write( + x = vml[[i]], + file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), + append = TRUE + ) + } + + if (nComments > 0 | length(vml[[i]]) > 0) { + write( + x = "", + file = file.path(dir, sprintf("vmlDrawing%s.vml", i)), + append = TRUE + ) + worksheets[[i]]$legacyDrawing <<- + '' + } + } + } +) + + + +Workbook$methods( + updateStyles = function(style) { + ## Updates styles.xml + xfNode <- list( + numFmtId = 0, + fontId = 0, + fillId = 0, + borderId = 0, + xfId = 0 + ) + + + alignmentFlag <- FALSE + + ## Font + if (!is.null(style$fontName) | + !is.null(style$fontSize) | + !is.null(style$fontColour) | + !is.null(style$fontDecoration) | + !is.null(style$fontFamily) | + !is.null(style$fontScheme)) { + fontNode <- .self$createFontNode(style) + fontId <- which(styles$fonts == fontNode) - 1L + + if (length(fontId) == 0) { + fontId <- length(styles$fonts) + styles$fonts <<- append(styles[["fonts"]], fontNode) + } + + xfNode$fontId <- fontId + xfNode <- append(xfNode, list("applyFont" = "1")) + } + + + ## numFmt + if (!is.null(style$numFmt)) { + if (as.integer(style$numFmt$numFmtId) > 0) { + numFmtId <- style$numFmt$numFmtId + if (as.integer(numFmtId) > 163L) { + tmp <- style$numFmt$formatCode + + styles$numFmts <<- unique(c( + styles$numFmts, + sprintf( + '', + numFmtId, + tmp + ) + )) + } + + xfNode$numFmtId <- numFmtId + xfNode <- append(xfNode, list("applyNumberFormat" = "1")) + } + } + + ## Fill + if (!is.null(style$fill)) { + fillNode <- .self$createFillNode(style) + if (!is.null(fillNode)) { + fillId <- which(styles$fills == fillNode) - 1L + + if (length(fillId) == 0) { + fillId <- length(styles$fills) + styles$fills <<- c(styles$fills, fillNode) + } + xfNode$fillId <- fillId + xfNode <- append(xfNode, list("applyFill" = "1")) + } + } + + ## Border + if (any(!is.null( + c( + style$borderLeft, + style$borderRight, + style$borderTop, + style$borderBottom, + style$borderDiagonal + ) + ))) { + borderNode <- .self$createBorderNode(style) + borderId <- which(styles$borders == borderNode) - 1L + + if (length(borderId) == 0) { + borderId <- length(styles$borders) + styles$borders <<- c(styles$borders, borderNode) + } + + xfNode$borderId <- borderId + xfNode <- append(xfNode, list("applyBorder" = "1")) + } + + + # if(!is.null(style$xfId)) + # xfNode$xfId <- style$xfId + + childNodes <- "" + + ## Alignment + if (!is.null(style$halign) | + !is.null(style$valign) | + !is.null(style$wrapText) | + !is.null(style$textRotation) | !is.null(style$indent)) { + attrs <- list() + alignNode <- "") + + alignmentFlag <- TRUE + xfNode <- append(xfNode, list("applyAlignment" = "1")) + + childNodes <- stri_join(childNodes, alignNode) + } + + if (!is.null(style$hidden) | !is.null(style$locked)) { + xfNode <- append(xfNode, list("applyProtection" = "1")) + protectionNode <- "") + childNodes <- stri_join(childNodes, protectionNode) + } + + if (length(childNodes) > 0) { + xfNode <- + stri_join( + "", + childNodes, + "" + ) + } else { + xfNode <- + stri_join("") + } + + styleId <- which(styles$cellXfs == xfNode) - 1L + if (length(styleId) == 0) { + styleId <- length(styles$cellXfs) + styles$cellXfs <<- c(styles$cellXfs, xfNode) + } + + + return(as.integer(styleId)) + } +) + + + + + +Workbook$methods( + updateCellStyles = function() { + flag <- TRUE + for (style in cellStyleObjects) { + ## Updates styles.xml + xfNode <- list( + numFmtId = 0, + fontId = 0, + fillId = 0, + borderId = 0 + ) + + + alignmentFlag <- FALSE + + ## Font + if (!is.null(style$fontName) | + !is.null(style$fontSize) | + !is.null(style$fontColour) | + !is.null(style$fontDecoration) | + !is.null(style$fontFamily) | + !is.null(style$fontScheme)) { + fontNode <- .self$createFontNode(style) + fontId <- which(styles$font == fontNode) - 1L + + if (length(fontId) == 0) { + fontId <- length(styles$fonts) + styles$fonts <<- append(styles[["fonts"]], fontNode) + } + + xfNode$fontId <- fontId + xfNode <- append(xfNode, list("applyFont" = "1")) + } + + + ## numFmt + if (!is.null(style$numFmt)) { + if (as.integer(style$numFmt$numFmtId) > 0) { + numFmtId <- style$numFmt$numFmtId + if (as.integer(numFmtId) > 163L) { + tmp <- style$numFmt$formatCode + + styles$numFmts <<- unique(c( + styles$numFmts, + sprintf( + '', + numFmtId, + tmp + ) + )) + } + + xfNode$numFmtId <- numFmtId + xfNode <- append(xfNode, list("applyNumberFormat" = "1")) + } + } + + ## Fill + if (!is.null(style$fill)) { + fillNode <- .self$createFillNode(style) + if (!is.null(fillNode)) { + fillId <- which(styles$fills == fillNode) - 1L + + if (length(fillId) == 0) { + fillId <- length(styles$fills) + styles$fills <<- c(styles$fills, fillNode) + } + xfNode$fillId <- fillId + xfNode <- append(xfNode, list("applyFill" = "1")) + } + } + + ## Border + if (any(!is.null( + c( + style$borderLeft, + style$borderRight, + style$borderTop, + style$borderBottom, + style$borderDiagonal + ) + ))) { + borderNode <- .self$createBorderNode(style) + borderId <- which(styles$borders == borderNode) - 1L + + if (length(borderId) == 0) { + borderId <- length(styles$borders) + styles$borders <<- c(styles$borders, borderNode) + } + + xfNode$borderId <- borderId + xfNode <- append(xfNode, list("applyBorder" = "1")) + } + + xfNode <- + stri_join("") + + if (flag) { + styles$cellStyleXfs <<- xfNode + flag <- FALSE + } else { + styles$cellStyleXfs <<- c(styles$cellStyleXfs, xfNode) + } + } + } +) + + + + + + + + +Workbook$methods( + getBaseFont = function() { + baseFont <- styles$fonts[[1]] + + sz <- getAttrs(baseFont, "sz") + colour <- getAttrs(baseFont, "color") + name <- getAttrs(baseFont, "name") + + if (length(sz[[1]]) == 0) { + sz <- list("val" = "10") + } + + if (length(colour[[1]]) == 0) { + colour <- list("rgb" = "#000000") + } + + if (length(name[[1]]) == 0) { + name <- list("val" = "Calibri") + } + + list( + "size" = sz, + "colour" = colour, + "name" = name + ) + } +) + + + + +Workbook$methods( + createFontNode = function(style) { + baseFont <- .self$getBaseFont() + + fontNode <- "" + + ## size + if (is.null(style$fontSize[[1]])) { + fontNode <- + stri_join(fontNode, sprintf('', names(baseFont$size), baseFont$size)) + } else { + fontNode <- + stri_join(fontNode, sprintf('', names(style$fontSize), style$fontSize)) + } + + ## colour + if (is.null(style$fontColour[[1]])) { + fontNode <- + stri_join( + fontNode, + sprintf( + '', + names(baseFont$colour), + baseFont$colour + ) + ) + } else { + if (length(style$fontColour) > 1) { + fontNode <- stri_join(fontNode, sprintf( + "", + stri_join( + sapply(seq_along(style$fontColour), function(i) { + sprintf('%s="%s"', names(style$fontColour)[i], style$fontColour[i]) + }), + sep = " ", + collapse = " " + ) + )) + } else { + fontNode <- + stri_join( + fontNode, + sprintf( + '', + names(style$fontColour), + style$fontColour + ) + ) + } + } + + + ## name + if (is.null(style$fontName[[1]])) { + fontNode <- + stri_join( + fontNode, + sprintf('', names(baseFont$name), baseFont$name) + ) + } else { + fontNode <- + stri_join( + fontNode, + sprintf('', names(style$fontName), style$fontName) + ) + } + + ### Create new font and return Id + if (!is.null(style$fontFamily)) { + fontNode <- + stri_join(fontNode, sprintf('', style$fontFamily)) + } + + if (!is.null(style$fontScheme)) { + fontNode <- + stri_join(fontNode, sprintf('', style$fontScheme)) + } + + if ("BOLD" %in% style$fontDecoration) { + fontNode <- stri_join(fontNode, "") + } + + if ("ITALIC" %in% style$fontDecoration) { + fontNode <- stri_join(fontNode, "") + } + + if ("UNDERLINE" %in% style$fontDecoration) { + fontNode <- stri_join(fontNode, '') + } + + if ("UNDERLINE2" %in% style$fontDecoration) { + fontNode <- stri_join(fontNode, '') + } + + if ("ACCOUNTING" %in% style$fontDecoration) { + fontNode <- stri_join(fontNode, '') + } + + if ("ACCOUNTING2" %in% style$fontDecoration) { + fontNode <- stri_join(fontNode, '') + } + + if ("STRIKEOUT" %in% style$fontDecoration) { + fontNode <- stri_join(fontNode, "") + } + + stri_join(fontNode, "") + } +) + + +Workbook$methods( + createBorderNode = function(style) { + borderNode <- "") + + if (!is.null(style$borderLeft)) { + borderNode <- + stri_join( + borderNode, + sprintf('', style$borderLeft), + sprintf( + '', + names(style$borderLeftColour), + style$borderLeftColour + ), + "" + ) + } + + if (!is.null(style$borderRight)) { + borderNode <- + stri_join( + borderNode, + sprintf('', style$borderRight), + sprintf( + '', + names(style$borderRightColour), + style$borderRightColour + ), + "" + ) + } + + if (!is.null(style$borderTop)) { + borderNode <- + stri_join( + borderNode, + sprintf('', style$borderTop), + sprintf( + '', + names(style$borderTopColour), + style$borderTopColour + ), + "" + ) + } + + if (!is.null(style$borderBottom)) { + borderNode <- + stri_join( + borderNode, + sprintf('', style$borderBottom), + sprintf( + '', + names(style$borderBottomColour), + style$borderBottomColour + ), + "" + ) + } + + if (!is.null(style$borderDiagonal)) { + borderNode <- + stri_join( + borderNode, + sprintf('', style$borderDiagonal), + sprintf( + '', + names(style$borderDiagonalColour), + style$borderDiagonalColour + ), + "" + ) + } + + stri_join(borderNode, "") + } +) + + +Workbook$methods( + createFillNode = function(style, patternType = "solid") { + fill <- style$fill + + ## gradientFill + if (any(grepl("gradientFill", fill))) { + fillNode <- fill # stri_join("", fill, "") + } else if (!is.null(fill$fillFg) | !is.null(fill$fillBg)) { + fillNode <- + stri_join( + "", + sprintf('', patternType) + ) + + if (!is.null(fill$fillFg)) { + fillNode <- + stri_join(fillNode, sprintf( + "", + stri_join( + stri_join(names(fill$fillFg), '="', fill$fillFg, '"'), + sep = " ", + collapse = " " + ) + )) + } + + if (!is.null(fill$fillBg)) { + fillNode <- + stri_join(fillNode, sprintf( + "", + stri_join( + stri_join(names(fill$fillBg), '="', fill$fillBg, '"'), + sep = " ", + collapse = " " + ) + )) + } + + fillNode <- stri_join(fillNode, "") + } else { + return(NULL) + } + + return(fillNode) + } +) + + + + + + + +Workbook$methods( + setSheetName = function(sheet, newSheetName) { + if (newSheetName %in% sheet_names) { + stop(sprintf("Sheet %s already exists!", newSheetName)) + } + + sheet <- validateSheet(sheet) + + oldName <- sheet_names[[sheet]] + sheet_names[[sheet]] <<- newSheetName + + ## Rename in workbook + sheetId <- + regmatches( + workbook$sheets[[sheet]], + regexpr('(?<=sheetId=")[0-9]+', workbook$sheets[[sheet]], perl = TRUE) + ) + rId <- + regmatches( + workbook$sheets[[sheet]], + regexpr('(?<= r:id="rId)[0-9]+', workbook$sheets[[sheet]], perl = TRUE) + ) + workbook$sheets[[sheet]] <<- + sprintf( + '', + newSheetName, + sheetId, + rId + ) + + ## rename styleObjects sheet component + if (length(styleObjects) > 0) { + styleObjects <<- lapply(styleObjects, function(x) { + if (x$sheet == oldName) { + x$sheet <- newSheetName + } + + return(x) + }) + } + + ## rename defined names + if (length(workbook$definedNames) > 0) { + belongTo <- getDefinedNamesSheet(workbook$definedNames) + toChange <- belongTo == oldName + if (any(toChange)) { + newSheetName <- sprintf("'%s'", newSheetName) + tmp <- + gsub(oldName, newSheetName, workbook$definedName[toChange], fixed = TRUE) + tmp <- gsub("'+", "'", tmp) + workbook$definedNames[toChange] <<- tmp + } + } + } +) + + +Workbook$methods( + writeSheetDataXML = function(xldrawingsDir, + xldrawingsRelsDir, + xlworksheetsDir, + xlworksheetsRelsDir) { + ## write worksheets + # nSheets <- length(worksheets) + + for (i in seq_along(worksheets)) { + ## Write drawing i (will always exist) skip those that are empty + if (any(drawings[[i]] != "")) { + write_file( + head = '', + body = pxml(drawings[[i]]), + tail = "", + fl = file.path(xldrawingsDir, stri_join("drawing", i, ".xml")) + ) + + write_file( + head = '', + body = pxml(drawings_rels[[i]]), + tail = "", + fl = file.path(xldrawingsRelsDir, stri_join("drawing", i, ".xml.rels")) + ) + } else { + worksheets[[i]]$drawing <<- character(0) + } + + ## vml drawing + if (length(vml_rels[[i]]) > 0) { + file.copy( + from = vml_rels[[i]], + to = file.path( + xldrawingsRelsDir, + stri_join("vmlDrawing", i, ".vml.rels") + ) + ) + } + + # outlineLevelRow in SheetformatPr + if ((length(outlineLevels[[i]]) > 0) && (!grepl("outlineLevelRow", worksheets[[i]]$sheetFormatPr))) { + worksheets[[i]]$sheetFormatPr <<- gsub("/>", ' outlineLevelRow="1"/>', worksheets[[i]]$sheetFormatPr) + } + + if (isChartSheet[i]) { + chartSheetDir <- file.path(dirname(xlworksheetsDir), "chartsheets") + chartSheetRelsDir <- + file.path(dirname(xlworksheetsDir), "chartsheets", "_rels") + + if (!file.exists(chartSheetDir)) { + dir.create(chartSheetDir, recursive = TRUE) + dir.create(chartSheetRelsDir, recursive = TRUE) + } + + write_file( + body = worksheets[[i]]$get_prior_sheet_data(), + fl = file.path(chartSheetDir, stri_join("sheet", i, ".xml")) + ) + + write_file( + head = '', + body = pxml(worksheets_rels[[i]]), + tail = "", + fl = file.path(chartSheetRelsDir, sprintf("sheet%s.xml.rels", i)) + ) + } else { + ## Write worksheets + ws <- worksheets[[i]] + hasHL <- + ifelse(length(worksheets[[i]]$hyperlinks) > 0, TRUE, FALSE) + + ## reorder sheet data + worksheets[[i]]$order_sheetdata() + + prior <- ws$get_prior_sheet_data() + post <- ws$get_post_sheet_data() + + worksheets[[i]]$sheet_data$style_id <<- + as.character(worksheets[[i]]$sheet_data$style_id) + + if ((length(rowHeights[[i]]) == 0) & (length(outlineLevels[[i]]) == 0)) { + write_worksheet_xml( + prior = prior, + post = post, + sheet_data = ws$sheet_data, + R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) + ) + } else if ((length(rowHeights[[i]]) == 0) & (length(outlineLevels[[i]]) > 0)) { + write_worksheet_xml_2( + prior = prior, + post = post, + sheet_data = ws$sheet_data, + row_heights_ = NULL, + outline_levels_ = unlist(outlineLevels[[i]]), + R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) + ) + } else if ((length(rowHeights[[i]]) > 0) & (length(outlineLevels[[i]]) == 0)) { + write_worksheet_xml_2( + prior = prior, + post = post, + sheet_data = ws$sheet_data, + row_heights_ = unlist(rowHeights[[i]]), + outline_levels_ = NULL, + R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) + ) + } else { + ## row heights will always be in order and all row heights are given rows in preSaveCleanup + write_worksheet_xml_2( + prior = prior, + post = post, + sheet_data = ws$sheet_data, + row_heights_ = unlist(rowHeights[[i]]), + outline_levels_ = unlist(outlineLevels[[i]]), + R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) + ) + } + + worksheets[[i]]$sheet_data$style_id <<- integer(0) + + + ## write worksheet rels + if (length(worksheets_rels[[i]]) > 0) { + ws_rels <- worksheets_rels[[i]] + if (hasHL) { + h_inds <- stri_join(seq_along(worksheets[[i]]$hyperlinks), "h") + ws_rels <- + c(ws_rels, unlist( + lapply(seq_along(h_inds), function(j) { + worksheets[[i]]$hyperlinks[[j]]$to_target_xml(h_inds[j]) + }) + )) + } + + ## Check if any tables were deleted - remove these from rels + if (length(tables) > 0) { + table_inds <- grep("tables/table[0-9].xml", ws_rels) + + if (length(table_inds) > 0) { + ids <- + regmatches( + ws_rels[table_inds], + regexpr( + '(?<=Relationship Id=")[0-9A-Za-z]+', + ws_rels[table_inds], + perl = TRUE + ) + ) + inds <- + as.integer(gsub("[^0-9]", "", ids, perl = TRUE)) - 2L + table_nms <- attr(tables, "tableName")[inds] + is_deleted <- + grepl("openxlsx_deleted", table_nms, fixed = TRUE) + if (any(is_deleted)) { + ws_rels <- ws_rels[-table_inds[is_deleted]] + } + } + } + + + + write_file( + head = '', + body = pxml(ws_rels), + tail = "", + fl = file.path(xlworksheetsRelsDir, sprintf("sheet%s.xml.rels", i)) + ) + } + } ## end of isChartSheet[i] + } ## end of loop through 1:nSheets + + invisible(0) + } +) + + + + + +Workbook$methods( + setRowHeights = function(sheet, rows, heights) { + sheet <- validateSheet(sheet) + + ## remove any conflicting heights + flag <- names(rowHeights[[sheet]]) %in% rows + if (any(flag)) { + rowHeights[[sheet]] <<- rowHeights[[sheet]][!flag] + } + + nms <- c(names(rowHeights[[sheet]]), rows) + allRowHeights <- unlist(c(rowHeights[[sheet]], heights)) + names(allRowHeights) <- nms + + allRowHeights <- + allRowHeights[order(as.integer(names(allRowHeights)))] + + rowHeights[[sheet]] <<- allRowHeights + } +) + +Workbook$methods( + groupColumns = function(sheet) { + sheet <- validateSheet(sheet) + + hidden <- attr(colOutlineLevels[[sheet]], "hidden", exact = TRUE) + cols <- names(colOutlineLevels[[sheet]]) + + if (!grepl("outlineLevelCol", worksheets[[sheet]]$sheetFormatPr)) { + worksheets[[sheet]]$sheetFormatPr <<- sub("/>", ' outlineLevelCol="1"/>', worksheets[[sheet]]$sheetFormatPr) + } + + # Check if column is already created (by `setColWidths()` or on import) + # Note that columns are initiated by `setColWidths` first (see: order of execution in `preSaveCleanUp()`) + if (any(cols %in% names(worksheets[[sheet]]$cols))) { + + for (i in intersect(cols, names(worksheets[[sheet]]$cols))) { + outline_hidden <- attr(colOutlineLevels[[sheet]], "hidden")[attr(colOutlineLevels[[sheet]], "names") == i] + + if (grepl("outlineLevel", worksheets[[sheet]]$cols[[i]], perl = TRUE)) { + worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w+)\")", paste0(outline_hidden, "\""), worksheets[[sheet]]$cols[[i]], perl = TRUE) + } else { + worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w+)\")", paste0(outline_hidden, "\" outlineLevel=\"1\""), worksheets[[sheet]]$cols[[i]], perl = TRUE) + } + } + + cols <- cols[!cols %in% names(worksheets[[sheet]]$cols)] + hidden <- attr(colOutlineLevels[[sheet]], "hidden")[attr(colOutlineLevels[[sheet]], "names") %in% cols] + } + + if (length(cols) > 0) { + colNodes <- sprintf('', cols, cols, hidden) + names(colNodes) <- cols + worksheets[[sheet]]$cols <<- append(worksheets[[sheet]]$cols, colNodes) + } + } +) + +Workbook$methods( + groupRows = function(sheet, rows, hidden, levels) { + sheet <- validateSheet(sheet) + + + flag <- names(outlineLevels[[sheet]]) %in% rows + if (any(flag)) { + outlineLevels[[sheet]] <<- outlineLevels[[sheet]][!flag] + } + + nms <- c(names(outlineLevels[[sheet]]), rows) + + allOutlineLevels <- unlist(c(outlineLevels[[sheet]], levels)) + names(allOutlineLevels) <- nms + + existing_hidden <- attr(outlineLevels[[sheet]], "hidden", exact = TRUE) + all_hidden <- c(existing_hidden, as.character(as.integer(hidden))) + + allOutlineLevels <- + allOutlineLevels[order(as.integer(names(allOutlineLevels)))] + + outlineLevels[[sheet]] <<- allOutlineLevels + + attr(outlineLevels[[sheet]], "hidden") <<- as.character(as.integer(all_hidden)) + + + if (!grepl("outlineLevelRow", worksheets[[sheet]]$sheetFormatPr)) { + worksheets[[sheet]]$sheetFormatPr <<- gsub("/>", ' outlineLevelRow="1"/>', worksheets[[sheet]]$sheetFormatPr) + } + } +) + + + +Workbook$methods( + deleteWorksheet = function(sheet) { + # To delete a worksheet + # Remove colwidths element + # Remove drawing partname from Content_Types (drawing(sheet).xml) + # Remove highest sheet from Content_Types + # Remove drawings element + # Remove drawings_rels element + + # Remove vml element + # Remove vml_rels element + + # Remove rowHeights element + # Remove styleObjects on sheet + # Remove last sheet element from workbook + # Remove last sheet element from workbook.xml.rels + # Remove element from worksheets + # Remove element from worksheets_rels + # Remove hyperlinks + # Reduce calcChain i attributes & remove calcs on sheet + # Remove sheet from sheetOrder + # Remove queryTable references from workbook$definedNames to worksheet + # remove tables + + sheet <- validateSheet(sheet) + sheetNames <- sheet_names + nSheets <- length(unlist(sheetNames, use.names = FALSE)) + sheetName <- sheetNames[[sheet]] + + colWidths[[sheet]] <<- NULL + sheet_names <<- sheet_names[-sheet] + + ## remove last drawings(sheet).xml from Content_Types + Content_Types <<- + Content_Types[!grepl(sprintf("drawing%s.xml", nSheets), Content_Types)] + + ## remove highest sheet + Content_Types <<- + Content_Types[!grepl(sprintf("sheet%s.xml", nSheets), Content_Types)] + + drawings[[sheet]] <<- NULL + drawings_rels[[sheet]] <<- NULL + + vml[[sheet]] <<- NULL + vml_rels[[sheet]] <<- NULL + + rowHeights[[sheet]] <<- NULL + colOutlineLevels[[sheet]] <<- NULL + outlineLevels[[sheet]] <<- NULL + comments[[sheet]] <<- NULL + threadComments[[sheet]] <<- NULL + isChartSheet <<- isChartSheet[-sheet] + + ## sheetOrder + toRemove <- which(sheetOrder == sheet) + sheetOrder[sheetOrder > sheet] <<- + sheetOrder[sheetOrder > sheet] - 1L + sheetOrder <<- sheetOrder[-toRemove] + + + ## remove styleObjects + if (length(styleObjects) > 0) { + styleObjects <<- + styleObjects[unlist(lapply(styleObjects, "[[", "sheet"), use.names = FALSE) != sheetName] + } + + ## Need to remove reference from workbook.xml.rels to pivotCache + removeRels <- grep("pivotTables", worksheets_rels[[sheet]], value = TRUE) + if (length(removeRels) > 0) { + ## sheet rels links to a pivotTable file, the corresponding pivotTable_rels file links to the cacheDefn which is listing in workbook.xml.rels + ## remove reference to this file from the workbook.xml.rels + fileNo <- + as.integer(unlist(regmatches( + removeRels, + gregexpr("(?<=pivotTable)[0-9]+(?=\\.xml)", removeRels, perl = TRUE) + ))) + toRemove <- + stri_join( + sprintf("(pivotCacheDefinition%s\\.xml)", fileNo), + sep = " ", + collapse = "|" + ) + + fileNo <- grep(toRemove, pivotTables.xml.rels) + toRemove <- + stri_join( + sprintf("(pivotCacheDefinition%s\\.xml)", fileNo), + sep = " ", + collapse = "|" + ) + + ## remove reference to file from workbook.xml.res + workbook.xml.rels <<- + workbook.xml.rels[!grepl(toRemove, workbook.xml.rels)] + } + + ## As above for slicers + ## Need to remove reference from workbook.xml.rels to pivotCache + removeRels <- grepl("slicers", worksheets_rels[[sheet]]) + if (any(removeRels)) { + workbook.xml.rels <<- + workbook.xml.rels[!grepl(sprintf("(slicerCache%s\\.xml)", sheet), workbook.xml.rels)] + } + + ## wont't remove tables and then won't need to reassign table r:id's but will rename them! + worksheets[[sheet]] <<- NULL + worksheets_rels[[sheet]] <<- NULL + + if (length(tables) > 0) { + tableSheets <- attr(tables, "sheet") + tableNames <- attr(tables, "tableName") + + inds <- + tableSheets %in% sheet & + !grepl("openxlsx_deleted", attr(tables, "tableName"), fixed = TRUE) + tableSheets[tableSheets > sheet] <- + tableSheets[tableSheets > sheet] - 1L + + ## Need to flag a table as deleted + if (any(inds)) { + tableSheets[inds] <- 0 + tableNames[inds] <- + stri_join(tableNames[inds], "_openxlsx_deleted") + } + attr(tables, "tableName") <<- tableNames + attr(tables, "sheet") <<- tableSheets + } + + + ## drawing will always be the first relationship and printerSettings second + if (nSheets > 1) { + for (i in 1:(nSheets - 1L)) { + worksheets_rels[[i]][1:3] <<- genBaseSheetRels(i) + } + } else { + worksheets_rels <<- list() + } + + + ## remove sheet + sn <- + unlist(lapply(workbook$sheets, function(x) { + regmatches( + x, regexpr('(?<= name=")[^"]+', x, perl = TRUE) + ) + })) + workbook$sheets <<- workbook$sheets[!sn %in% sheetName] + + ## Reset rIds + if (nSheets > 1) { + for (i in (sheet + 1L):nSheets) { + workbook$sheets <<- + gsub(stri_join("rId", i), + stri_join("rId", i - 1L), + workbook$sheets, + fixed = TRUE + ) + } + } else { + workbook$sheets <<- NULL + } + + ## Can remove highest sheet + workbook.xml.rels <<- + workbook.xml.rels[!grepl(sprintf("sheet%s.xml", nSheets), workbook.xml.rels)] + + ## definedNames + if (length(workbook$definedNames) > 0) { + belongTo <- getDefinedNamesSheet(workbook$definedNames) + workbook$definedNames <<- + workbook$definedNames[!belongTo %in% sheetName] + } + + invisible(1) + } +) + + +Workbook$methods( + addDXFS = function(style) { + dxf <- "" + dxf <- stri_join(dxf, createFontNode(style)) + fillNode <- NULL + + if (!is.null(style$fill$fillFg) | !is.null(style$fill$fillBg)) { + dxf <- stri_join(dxf, createFillNode(style)) + } + + if (any(!is.null( + c( + style$borderLeft, + style$borderRight, + style$borderTop, + style$borderBottom, + style$borderDiagonal + ) + ))) { + dxf <- stri_join(dxf, createBorderNode(style)) + } + + dxf <- stri_join(dxf, "", sep = " ") + if (dxf %in% styles$dxfs) { + return(which(styles$dxfs == dxf) - 1L) + } + + dxfId <- length(styles$dxfs) + styles$dxfs <<- c(styles$dxfs, dxf) + + return(dxfId) + } +) + + + +Workbook$methods( + dataValidation = function(sheet, + startRow, + endRow, + startCol, + endCol, + type, + operator, + value, + allowBlank, + showInputMsg, + showErrorMsg) { + sheet <- validateSheet(sheet) + sqref <- + stri_join(getCellRefs(data.frame( + "x" = c(startRow, endRow), + "y" = c(startCol, endCol) + )), + sep = " ", + collapse = ":" + ) + + header <- + sprintf( + '', + type, + operator, + allowBlank, + showInputMsg, + showErrorMsg, + sqref + ) + + + if (type == "date") { + origin <- 25569L + if (grepl( + 'date1904="1"|date1904="true"', + stri_join(unlist(workbook), sep = " ", collapse = ""), + ignore.case = TRUE + )) { + origin <- 24107L + } + + value <- as.integer(value) + origin + } + + if (type == "time") { + origin <- 25569L + if (grepl( + 'date1904="1"|date1904="true"', + stri_join(unlist(workbook), sep = " ", collapse = ""), + ignore.case = TRUE + )) { + origin <- 24107L + } + + t <- format(value[1], "%z") + offSet <- + suppressWarnings(ifelse(substr(t, 1, 1) == "+", 1L, -1L) * (as.integer(substr(t, 2, 3)) + as.integer(substr(t, 4, 5)) / 60) / 24) + if (is.na(offSet)) { + offSet[i] <- 0 + } + + value <- as.numeric(as.POSIXct(value)) / 86400 + origin + offSet + } + + form <- + sapply(seq_along(value), function(i) { + sprintf("%s", i, value[i], i) + }) + worksheets[[sheet]]$dataValidations <<- + c( + worksheets[[sheet]]$dataValidations, + stri_join(header, stri_join(form, collapse = ""), "") + ) + + invisible(0) + } +) + + + +Workbook$methods( + dataValidation_list = function(sheet, + startRow, + endRow, + startCol, + endCol, + value, + allowBlank, + showInputMsg, + showErrorMsg) { + sheet <- validateSheet(sheet) + sqref <- + stri_join(getCellRefs(data.frame( + "x" = c(startRow, endRow), + "y" = c(startCol, endCol) + )), + sep = " ", + collapse = ":" + ) + data_val <- + sprintf( + '', + allowBlank, + showInputMsg, + showErrorMsg, + sqref + ) + + formula <- + sprintf("%s", value) + sqref <- sprintf("%s", sqref) + + xmlData <- + stri_join(data_val, formula, sqref, "") + + worksheets[[sheet]]$dataValidationsLst <<- + c(worksheets[[sheet]]$dataValidationsLst, xmlData) + + invisible(0) + } +) + + + +Workbook$methods( + conditionalFormatting = function(sheet, + startRow, + endRow, + startCol, + endCol, + dxfId, + formula, + type, + values, + params) { + sheet <- validateSheet(sheet) + sqref <- + stri_join(getCellRefs(data.frame( + "x" = c(startRow, endRow), + "y" = c(startCol, endCol) + )), collapse = ":") + + + + ## Increment priority of conditional formatting rule + if (length(worksheets[[sheet]]$conditionalFormatting) > 0) { + for (i in rev(seq_along(worksheets[[sheet]]$conditionalFormatting))) { + priority <- + regmatches( + worksheets[[sheet]]$conditionalFormatting[[i]], + regexpr( + '(?<=priority=")[0-9]+', + worksheets[[sheet]]$conditionalFormatting[[i]], + perl = TRUE + ) + ) + priority_new <- as.integer(priority) + 1L + + priority_pattern <- sprintf('priority="%s"', priority) + priority_new <- sprintf('priority="%s"', priority_new) + + ## now replace + worksheets[[sheet]]$conditionalFormatting[[i]] <<- + gsub(priority_pattern, + priority_new, + worksheets[[sheet]]$conditionalFormatting[[i]], + fixed = TRUE + ) + } + } + + nms <- c(names(worksheets[[sheet]]$conditionalFormatting), sqref) + + if (type == "colorScale") { + ## formula contains the colours + ## values contains numerics or is NULL + ## dxfId is ignored + + if (is.null(values)) { + if (length(formula) == 2L) { + cfRule <- + sprintf( + ' + + + ', + formula[[1]], + formula[[2]] + ) + } else { + cfRule <- + sprintf( + ' + + + ', + formula[[1]], + formula[[2]], + formula[[3]] + ) + } + } else { + if (length(formula) == 2L) { + cfRule <- + sprintf( + ' + + + ', + values[[1]], + values[[2]], + formula[[1]], + formula[[2]] + ) + } else { + cfRule <- + sprintf( + ' + + + ', + values[[1]], + values[[2]], + values[[3]], + formula[[1]], + formula[[2]], + formula[[3]] + ) + } + } + } else if (type == "dataBar") { + # forumula is a vector of colours of length 1 or 2 + # values is NULL or a numeric vector of equal length as formula + + if (length(formula) == 2L) { + negColour <- formula[[1]] + posColour <- formula[[2]] + } else { + posColour <- formula + negColour <- "FFFF0000" + } + + guid <- + stri_join( + "F7189283-14F7-4DE0-9601-54DE9DB", + 40000L + length(worksheets[[sheet]]$extLst) + ) + + showValue <- 1 + if ("showValue" %in% names(params)) { + showValue <- as.integer(params$showValue) + } + + gradient <- 1 + if ("gradient" %in% names(params)) { + gradient <- as.integer(params$gradient) + } + + border <- 1 + if ("border" %in% names(params)) { + border <- as.integer(params$border) + } + + if (is.null(values)) { + cfRule <- + sprintf( + ' + + + + {%s} + ', + showValue, + posColour, + guid + ) + } else { + cfRule <- + sprintf( + ' + + + + + {%s}', + showValue, + values[[1]], + values[[2]], + posColour, + guid + ) + } + + worksheets[[sheet]]$extLst <<- + c( + worksheets[[sheet]]$extLst, + gen_databar_extlst( + guid = guid, + sqref = sqref, + posColour = posColour, + negColour = negColour, + values = values, + border = border, + gradient = gradient + ) + ) + } else if (type == "expression") { + cfRule <- + sprintf( + '%s', + dxfId, + formula + ) + } else if (type == "duplicatedValues") { + cfRule <- + sprintf( + '', + dxfId + ) + } else if (type == "containsText") { + cfRule <- + sprintf( + ' + NOT(ISERROR(SEARCH("%s", %s))) + ', + dxfId, + values, + values, + unlist(strsplit(sqref, split = ":"))[[1]] + ) + } else if (type == "notContainsText") { + cfRule <- + sprintf( + ' + ISERROR(SEARCH("%s", %s)) + ', + dxfId, + values, + values, + unlist(strsplit(sqref, split = ":"))[[1]] + ) + } else if (type == "beginsWith") { + cfRule <- + sprintf( + ' + LEFT(%s,LEN("%s"))="%s" + ', + dxfId, + values, + + unlist(strsplit(sqref, split = ":"))[[1]], + values, + values + ) + } else if (type == "endsWith") { + cfRule <- + sprintf( + ' + RIGHT(%s,LEN("%s"))="%s" + ', + dxfId, + values, + + unlist(strsplit(sqref, split = ":"))[[1]], + values, + values + ) + } else if (type == "between") { + cfRule <- + sprintf( + '%s%s', + dxfId, + formula[1], + formula[2] + ) + } else if (type == "topN") { + cfRule <- + sprintf( + '', + dxfId, + values[1], + values[2] + ) + } else if (type == "bottomN") { + cfRule <- + sprintf( + '', + dxfId, + values[1], + values[2] + ) + } + + worksheets[[sheet]]$conditionalFormatting <<- + append(worksheets[[sheet]]$conditionalFormatting, cfRule) + + names(worksheets[[sheet]]$conditionalFormatting) <<- nms + + invisible(0) + } +) + + + + +Workbook$methods( + mergeCells = function(sheet, startRow, endRow, startCol, endCol) { + sheet <- validateSheet(sheetName = sheet) + + sqref <- + getCellRefs(data.frame( + "x" = c(startRow, endRow), + "y" = c(startCol, endCol) + )) + exMerges <- + regmatches( + worksheets[[sheet]]$mergeCells, + regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells) + ) + + if (!is.null(exMerges)) { + comps <- + lapply(exMerges, function(rectCoords) { + unlist(strsplit(rectCoords, split = ":")) + }) + exMergedCells <- build_cell_merges(comps = comps) + newMerge <- unlist(build_cell_merges(comps = list(sqref))) + + ## Error if merge intersects + mergeIntersections <- + sapply(exMergedCells, function(x) { + any(x %in% newMerge) + }) + if (any(mergeIntersections)) { + stop( + sprintf( + "Merge intersects with existing merged cells: \n\t\t%s.\nRemove existing merge first.", + stri_join(exMerges[mergeIntersections], collapse = "\n\t\t") + ) + ) + } + } + + worksheets[[sheet]]$mergeCells <<- + c( + worksheets[[sheet]]$mergeCells, + sprintf( + '', + stri_join(sqref, + collapse = ":", sep = + " " + ) + ) + ) + } +) + + + +Workbook$methods( + removeCellMerge = function(sheet, startRow, endRow, startCol, endCol) { + sheet <- validateSheet(sheet) + + sqref <- + getCellRefs(data.frame( + "x" = c(startRow, endRow), + "y" = c(startCol, endCol) + )) + exMerges <- + regmatches( + worksheets[[sheet]]$mergeCells, + regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells) + ) + + if (!is.null(exMerges)) { + comps <- + lapply(exMerges, function(x) { + unlist(strsplit(x, split = ":")) + }) + exMergedCells <- build_cell_merges(comps = comps) + newMerge <- unlist(build_cell_merges(comps = list(sqref))) + + ## Error if merge intersects + mergeIntersections <- + sapply(exMergedCells, function(x) { + any(x %in% newMerge) + }) + } + + ## Remove intersection + worksheets[[sheet]]$mergeCells <<- + worksheets[[sheet]]$mergeCells[!mergeIntersections] + } +) + + + + + +Workbook$methods( + freezePanes = function(sheet, + firstActiveRow = NULL, + firstActiveCol = NULL, + firstRow = FALSE, + firstCol = FALSE) { + sheet <- validateSheet(sheet) + paneNode <- NULL + + if (firstRow) { + paneNode <- + '' + } else if (firstCol) { + paneNode <- + '' + } + + + if (is.null(paneNode)) { + if (firstActiveRow == 1 & firstActiveCol == 1) { + ## nothing to do + return(NULL) + } + + if (firstActiveRow > 1 & firstActiveCol == 1) { + attrs <- sprintf('ySplit="%s"', firstActiveRow - 1L) + activePane <- "bottomLeft" + } + + if (firstActiveRow == 1 & firstActiveCol > 1) { + attrs <- sprintf('xSplit="%s"', firstActiveCol - 1L) + activePane <- "topRight" + } + + if (firstActiveRow > 1 & firstActiveCol > 1) { + attrs <- + sprintf( + 'ySplit="%s" xSplit="%s"', + firstActiveRow - 1L, + firstActiveCol - 1L + ) + activePane <- "bottomRight" + } + + topLeftCell <- + getCellRefs(data.frame(firstActiveRow, firstActiveCol)) + + paneNode <- + sprintf( + '', + stri_join(attrs, collapse = " ", sep = " "), + topLeftCell, + activePane, + activePane + ) + } + + worksheets[[sheet]]$freezePane <<- paneNode + } +) + + + +Workbook$methods( + insertImage = function(sheet, + file, + startRow, + startCol, + width, + height, + rowOffset = 0, + colOffset = 0) { + ## within the sheet the drawing node's Id refernce an id in the sheetRels + ## sheet rels reference the drawingi.xml file + ## drawingi.xml refernece drawingRels + ## drawing rels reference an image in the media folder + ## worksheetRels(sheet(i)) references drawings(j) + + sheet <- validateSheet(sheet) + + imageType <- regmatches(file, gregexpr("\\.[a-zA-Z]*$", file)) + imageType <- gsub("^\\.", "", imageType) + + imageNo <- length((drawings[[sheet]])) + 1L + mediaNo <- length(media) + 1L + + startCol <- convertFromExcelRef(startCol) + + ## update Content_Types + if (!any(grepl(stri_join("image/", imageType), Content_Types))) { + Content_Types <<- + unique(c( + sprintf( + '', + imageType, + imageType + ), + Content_Types + )) + } + + ## drawings rels (Reference from drawings.xml to image file in media folder) + drawings_rels[[sheet]] <<- c( + drawings_rels[[sheet]], + sprintf( + '', + imageNo, + mediaNo, + imageType + ) + ) + + ## write file path to media slot to copy across on save + tmp <- file + names(tmp) <- stri_join("image", mediaNo, ".", imageType) + media <<- append(media, tmp) + + ## create drawing.xml + anchor <- + '' + + from <- sprintf( + ' + %s + %s + %s + %s + ', + startCol - 1L, + colOffset, + startRow - 1L, + rowOffset + ) + + drawingsXML <- stri_join( + anchor, + from, + sprintf( + '', + width, + height + ), + genBasePic(imageNo), + "", + "" + ) + + + ## append to workbook drawing + drawings[[sheet]] <<- c(drawings[[sheet]], drawingsXML) + } +) + + + +Workbook$methods( + preSaveCleanUp = function() { + ## Steps + # Order workbook.xml.rels: + # sheets -> style -> theme -> sharedStrings -> persons -> tables -> calcChain + # Assign workbook.xml.rels children rIds, seq_along(workbook.xml.rels) + # Assign workbook$sheets rIds 1:nSheets + # + ## drawings will always be r:id1 on worksheet + ## tables will always have r:id equal to table xml file number tables/table(i).xml + + ## Every worksheet has a drawingXML as r:id 1 + ## Every worksheet has a printerSettings as r:id 2 + ## Tables from r:id 3 to nTables+3 - 1 + ## HyperLinks from nTables+3 to nTables+3+nHyperLinks-1 + ## vmlDrawing to have rId + + sheetRIds <- + as.integer(unlist(regmatches( + workbook$sheets, + gregexpr('(?<=r:id="rId)[0-9]+', workbook$sheets, perl = TRUE) + ))) + + nSheets <- length(sheetRIds) + nExtRefs <- length(externalLinks) + nPivots <- length(pivotDefinitions) + + ## add a worksheet if none added + if (nSheets == 0) { + warning("Workbook does not contain any worksheets. A worksheet will be added.", + call. = FALSE + ) + .self$addWorksheet("Sheet 1") + nSheets <- 1L + } + + ## get index of each child element for ordering + sheetInds <- grep("(worksheets|chartsheets)/sheet[0-9]+\\.xml", workbook.xml.rels) + stylesInd <- grep("styles\\.xml", workbook.xml.rels) + themeInd <- grep("theme/theme[0-9]+.xml", workbook.xml.rels) + connectionsInd <- grep("connections.xml", workbook.xml.rels) + extRefInds <- grep("externalLinks/externalLink[0-9]+.xml", workbook.xml.rels) + sharedStringsInd <- grep("sharedStrings.xml", workbook.xml.rels) + tableInds <- grep("table[0-9]+.xml", workbook.xml.rels) + personInds <- grep("person.xml", workbook.xml.rels) + + + ## Reordering of workbook.xml.rels + ## don't want to re-assign rIds for pivot tables or slicer caches + pivotNode <- grep("pivotCache/pivotCacheDefinition[0-9].xml", workbook.xml.rels, value = TRUE) + slicerNode <- grep("slicerCache[0-9]+.xml", workbook.xml.rels, value = TRUE) + + ## Reorder children of workbook.xml.rels + workbook.xml.rels <<- + workbook.xml.rels[c( + sheetInds, + extRefInds, + themeInd, + connectionsInd, + stylesInd, + sharedStringsInd, + tableInds, + personInds + )] + + ## Re assign rIds to children of workbook.xml.rels + workbook.xml.rels <<- + unlist(lapply(seq_along(workbook.xml.rels), function(i) { + gsub('(?<=Relationship Id="rId)[0-9]+', + i, + workbook.xml.rels[[i]], + perl = TRUE + ) + })) + + workbook.xml.rels <<- c(workbook.xml.rels, pivotNode, slicerNode) + + + + if (!is.null(vbaProject)) { + workbook.xml.rels <<- + c( + workbook.xml.rels, + sprintf( + '', + 1L + length(workbook.xml.rels) + ) + ) + } + + ## Reassign rId to workbook sheet elements, (order sheets by sheetId first) + workbook$sheets <<- + unlist(lapply(seq_along(workbook$sheets), function(i) { + gsub('(?<= r:id="rId)[0-9]+', i, workbook$sheets[[i]], perl = TRUE) + })) + + ## re-order worksheets if need to + if (any(sheetOrder != seq_len(nSheets))) { + workbook$sheets <<- workbook$sheets[sheetOrder] + } + + + + ## re-assign tabSelected + state <- rep.int("visible", nSheets) + state[grepl("hidden", workbook$sheets)] <- "hidden" + visible_sheet_index <- which(state %in% "visible")[[1]] + visible_sheets <- which(state %in% "visible") + workbook$bookViews <<- + sprintf( + '', + visible_sheet_index - 1L, + ActiveSheet - 1L + ) + + for(i in seq_len(nSheets)) { + worksheets[[i]]$sheetViews <<- + sub( + ' tabSelected="(1|true|false|0)"', + ifelse( + sheetOrder[ActiveSheet] == i, + ' tabSelected="true"', + ' tabSelected="false"' + ), + worksheets[[i]]$sheetViews, + ignore.case = TRUE + ) + } + # worksheets[[visible_sheet_index]]$sheetViews + + # worksheets[[visible_sheet_index]]$sheetViews <<- + # sub( + # '( tabSelected="0")|( tabSelected="false")', + # ' tabSelected="1"', + # worksheets[[visible_sheet_index]]$sheetViews, + # ignore.case = TRUE + # ) + # if (nSheets > 1) { + # for (i in (1:nSheets)[!(1:nSheets) %in% visible_sheet_index]) { + # worksheets[[i]]$sheetViews <<- + # sub( + # ' tabSelected="(1|true|false|0)"', + # ' tabSelected="false"', + # worksheets[[i]]$sheetViews, + # ignore.case = TRUE + # ) + # } + # } + + + + + + if (length(workbook$definedNames) > 0) { + sheetNames <- sheet_names[sheetOrder] + + belongTo <- getDefinedNamesSheet(workbook$definedNames) + + ## sheetNames is in re-ordered order (order it will be displayed) + newId <- match(belongTo, sheetNames) - 1L + oldId <- + as.numeric(regmatches( + workbook$definedNames, + regexpr( + '(?<= localSheetId=")[0-9]+', + workbook$definedNames, + perl = TRUE + ) + )) + + for (i in seq_along(workbook$definedNames)) { + if (!is.na(newId[i])) { + workbook$definedNames[[i]] <<- + gsub( + sprintf('localSheetId=\"%s\"', oldId[i]), + sprintf('localSheetId=\"%s\"', newId[i]), + workbook$definedNames[[i]], + fixed = TRUE + ) + } + } + } + + + + + ## update workbook r:id to match reordered workbook.xml.rels externalLink element + if (length(extRefInds) > 0) { + newInds <- as.integer(seq_along(extRefInds) + length(sheetInds)) + workbook$externalReferences <<- + stri_join( + "", + stri_join( + sprintf('', newInds), + collapse = "" + ), + "" + ) + } + + ## styles + numFmtIds <- 50000L + for (i in which(!isChartSheet)) { + worksheets[[i]]$sheet_data$style_id <<- + rep.int(x = as.integer(NA), times = worksheets[[i]]$sheet_data$n_elements) + } + + + for (x in styleObjects) { + if (length(x$rows) > 0 & length(x$cols) > 0) { + this.sty <- x$style$copy() + + if (!is.null(this.sty$numFmt)) { + if (this.sty$numFmt$numFmtId == 9999) { + this.sty$numFmt$numFmtId <- numFmtIds + numFmtIds <- numFmtIds + 1L + } + } + + + ## convert sheet name to index + sheet <- which(sheet_names == x$sheet) + sId <- + .self$updateStyles(this.sty) ## this creates the XML for styles.XML + + cells_to_style <- stri_join(x$rows, x$cols, sep = ",") + existing_cells <- + stri_join(worksheets[[sheet]]$sheet_data$rows, + worksheets[[sheet]]$sheet_data$cols, + sep = "," + ) + + ## In here we create any style_ids that don't yet exist in sheet_data + worksheets[[sheet]]$sheet_data$style_id[existing_cells %in% cells_to_style] <<- + sId + + + new_cells_to_append <- + which(!cells_to_style %in% existing_cells) + if (length(new_cells_to_append) > 0) { + worksheets[[sheet]]$sheet_data$style_id <<- + c( + worksheets[[sheet]]$sheet_data$style_id, + rep.int(x = sId, times = length(new_cells_to_append)) + ) + + worksheets[[sheet]]$sheet_data$rows <<- + c(worksheets[[sheet]]$sheet_data$rows, x$rows[new_cells_to_append]) + worksheets[[sheet]]$sheet_data$cols <<- + c(worksheets[[sheet]]$sheet_data$cols, x$cols[new_cells_to_append]) + worksheets[[sheet]]$sheet_data$t <<- + c(worksheets[[sheet]]$sheet_data$t, rep(as.integer(NA), length(new_cells_to_append))) + worksheets[[sheet]]$sheet_data$v <<- + c( + worksheets[[sheet]]$sheet_data$v, + rep(as.character(NA), length(new_cells_to_append)) + ) + worksheets[[sheet]]$sheet_data$f <<- + c( + worksheets[[sheet]]$sheet_data$f, + rep(as.character(NA), length(new_cells_to_append)) + ) + worksheets[[sheet]]$sheet_data$data_count <<- + worksheets[[sheet]]$sheet_data$data_count + 1L + + worksheets[[sheet]]$sheet_data$n_elements <<- + as.integer(length(worksheets[[sheet]]$sheet_data$rows)) + } + } + } + + + ## Make sure all rowHeights have rows, if not append them! + for (i in seq_along(worksheets)) { + if (length(rowHeights[[i]]) > 0) { + rh <- as.integer(names(rowHeights[[i]])) + missing_rows <- rh[!rh %in% worksheets[[i]]$sheet_data$rows] + n <- length(missing_rows) + + if (n > 0) { + worksheets[[i]]$sheet_data$style_id <<- + c( + worksheets[[i]]$sheet_data$style_id, + rep.int(as.integer(NA), times = n) + ) + + worksheets[[i]]$sheet_data$rows <<- + c(worksheets[[i]]$sheet_data$rows, missing_rows) + worksheets[[i]]$sheet_data$cols <<- + c( + worksheets[[i]]$sheet_data$cols, + rep.int(as.integer(NA), times = n) + ) + + worksheets[[i]]$sheet_data$t <<- + c(worksheets[[i]]$sheet_data$t, rep(as.integer(NA), times = n)) + worksheets[[i]]$sheet_data$v <<- + c( + worksheets[[i]]$sheet_data$v, + rep(as.character(NA), times = n) + ) + worksheets[[i]]$sheet_data$f <<- + c( + worksheets[[i]]$sheet_data$f, + rep(as.character(NA), times = n) + ) + worksheets[[i]]$sheet_data$data_count <<- + worksheets[[i]]$sheet_data$data_count + 1L + + worksheets[[i]]$sheet_data$n_elements <<- + as.integer(length(worksheets[[i]]$sheet_data$rows)) + } + } + + ## write colwidth and coloutline XML + if (length(colWidths[[i]]) > 0) { + invisible(.self$setColWidths(i)) + } + + if (length(colOutlineLevels[[i]]) > 0) { + invisible(.self$groupColumns(i)) + } + + + if(ActiveSheet==i) { + worksheets[[sheetOrder[i]]]$sheetViews <<- + stri_replace_all_regex( + worksheets[[sheetOrder[i]]]$sheetViews, + "tabSelected=\"(1|true|false|0)\"", + paste0("tabSelected=\"true\"") + ) + } else { + worksheets[[sheetOrder[i]]]$sheetViews <<- + stri_replace_all_regex( + worksheets[[sheetOrder[i]]]$sheetViews, + "tabSelected=\"(1|true|false|0)\"", + paste0("tabSelected=\"false\"") + ) + } + } + } +) + + + +Workbook$methods( + addStyle = function(sheet, style, rows, cols, stack) { + sheet <- sheet_names[[sheet]] + + if (length(styleObjects) == 0) { + styleObjects <<- list(list( + style = style, + sheet = sheet, + rows = rows, + cols = cols + )) + } else if (stack) { + nStyles <- length(styleObjects) + + ## ********** Assume all styleObjects cells have one a single worksheet ********** + ## Loop through existing styleObjects + newInds <- seq_along(rows) + keepStyle <- rep(TRUE, nStyles) + for (i in 1:nStyles) { + if (sheet == styleObjects[[i]]$sheet) { + ## Now check rows and cols intersect + ## toRemove are the elements that the new style doesn't apply to, we remove these from the style object as it + ## is copied, merged with the new style and given the new data points + + ex_row_cols <- + stri_join(styleObjects[[i]]$rows, styleObjects[[i]]$cols, sep = "-") + new_row_cols <- stri_join(rows, cols, sep = "-") + + + ## mergeInds are the intersection of the two styles that will need to merge + mergeInds <- which(new_row_cols %in% ex_row_cols) + + ## newInds are inds that don't exist in the current - this cumulates until the end to see if any are new + newInds <- newInds[!newInds %in% mergeInds] + + + ## If the new style does not merge + if (length(mergeInds) > 0) { + to_remove_from_this_style_object <- + which(ex_row_cols %in% new_row_cols) + + ## the new style intersects with this styleObjects[[i]], we need to remove the intersecting rows and + ## columns from styleObjects[[i]] + if (length(to_remove_from_this_style_object) > 0) { + ## remove these from style object + styleObjects[[i]]$rows <<- + styleObjects[[i]]$rows[-to_remove_from_this_style_object] + styleObjects[[i]]$cols <<- + styleObjects[[i]]$cols[-to_remove_from_this_style_object] + + if (length(styleObjects[[i]]$rows) == 0 | + length(styleObjects[[i]]$cols) == 0) { + keepStyle[i] <- + FALSE + } ## this style applies to no rows or columns anymore + } + + ## append style object for intersecting cells + + ## we are appending a new style + keepStyle <- + c(keepStyle, TRUE) ## keepStyle is used to remove styles that apply to 0 rows OR 0 columns + + ## Merge Style and append to styleObjects + styleObjects <<- + append(styleObjects, list( + list( + style = mergeStyle(styleObjects[[i]]$style, newStyle = style), + sheet = sheet, + rows = rows[mergeInds], + cols = cols[mergeInds] + ) + )) + } + } ## if sheet == styleObjects[[i]]$sheet + } ## End of loop through styles + + ## remove any styles that no longer have any affect + if (!all(keepStyle)) { + styleObjects <<- styleObjects[keepStyle] + } + + ## append style object for non-intersecting cells + if (length(newInds) > 0) { + styleObjects <<- append(styleObjects, list(list( + style = style, + sheet = sheet, + rows = rows[newInds], + cols = cols[newInds] + ))) + } + } else { + ## else we are not stacking + + styleObjects <<- append(styleObjects, list(list( + style = style, + sheet = sheet, + rows = rows, + cols = cols + ))) + } ## End if(length(styleObjects) > 0) else if(stack) {} + } +) + + + +Workbook$methods( + createNamedRegion = function(ref1, ref2, name, sheet, localSheetId = NULL) { + name <- replaceIllegalCharacters(name) + + if (is.null(localSheetId)) { + workbook$definedNames <<- c( + workbook$definedNames, + sprintf( + '\'%s\'!%s:%s', + name, + sheet, + ref1, + ref2 + ) + ) + } else { + workbook$definedNames <<- c( + workbook$definedNames, + sprintf( + '\'%s\'!%s:%s', + name, + localSheetId, + sheet, + ref1, + ref2 + ) + ) + } + } +) + + +Workbook$methods( + validate_table_name = function(tableName) { + tableName <- + tolower(tableName) ## Excel forces named regions to lowercase + + if (nchar(tableName) > 255) { + stop("tableName must be less than 255 characters.") + } + + if (grepl("$", tableName, fixed = TRUE)) { + stop("'$' character cannot exist in a tableName") + } + + if (grepl(" ", tableName, fixed = TRUE)) { + stop("spaces cannot exist in a table name") + } + + # if(!grepl("^[A-Za-z_]", tableName, perl = TRUE)) + # stop("tableName must begin with a letter or an underscore") + + if (grepl("R[0-9]+C[0-9]+", + tableName, + perl = TRUE, + ignore.case = TRUE + )) { + stop("tableName cannot be the same as a cell reference, such as R1C1") + } + + if (grepl("^[A-Z]{1,3}[0-9]+$", tableName, ignore.case = TRUE)) { + stop("tableName cannot be the same as a cell reference") + } + + if (tableName %in% attr(tables, "tableName")) { + stop(sprintf("Table with name '%s' already exists!", tableName)) + } + + return(tableName) + } +) + + +Workbook$methods( + check_overwrite_tables = function(sheet, + new_rows, + new_cols, + error_msg = "Cannot overwrite existing table with another table.", + check_table_header_only = FALSE) { + ## check not overwriting another table + if (length(tables) > 0) { + tableSheets <- attr(tables, "sheet") + sheetNo <- validateSheet(sheet) + + to_check <- + which(tableSheets %in% sheetNo & + !grepl("openxlsx_deleted", attr(tables, "tableName"), fixed = TRUE)) + + if (length(to_check) > 0) { + ## only look at tables on this sheet + + exTable <- tables[to_check] + + rows <- + lapply(names(exTable), function(rectCoords) { + as.numeric(unlist(regmatches( + rectCoords, gregexpr("[0-9]+", rectCoords) + ))) + }) + cols <- + lapply(names(exTable), function(rectCoords) { + convertFromExcelRef(unlist(regmatches( + rectCoords, gregexpr("[A-Z]+", rectCoords) + ))) + }) + + if (check_table_header_only) { + rows <- lapply(rows, function(x) { + c(x[1], x[1]) + }) + } + + + ## loop through existing tables checking if any over lap with new table + for (i in seq_along(exTable)) { + existing_cols <- cols[[i]] + existing_rows <- rows[[i]] + + if ((min(new_cols) <= max(existing_cols)) & + (max(new_cols) >= min(existing_cols)) & + (min(new_rows) <= max(existing_rows)) & + (max(new_rows) >= min(existing_rows))) { + stop(error_msg) + } + } + } ## end if(sheet %in% tableSheets) + } ## end (length(tables) > 0) + + invisible(0) + } +) + + + + +Workbook$methods( + show = function() { + exSheets <- sheet_names + nSheets <- length(exSheets) + nImages <- length(media) + nCharts <- length(charts) + nStyles <- length(styleObjects) + aSheet <- ActiveSheet + exSheets <- replaceXMLEntities(exSheets) + showText <- "A Workbook object.\n" + + if (length(aSheet) == 0) { + aSheet <- 1 + } + + ## worksheets + if (nSheets > 0) { + showText <- c(showText, "\nWorksheets:\n") + + sheetTxt <- lapply(1:nSheets, function(i) { + tmpTxt <- sprintf('Sheet %s: "%s"\n', i, exSheets[[i]]) + + if (length(rowHeights[[i]]) > 0) { + tmpTxt <- + append( + tmpTxt, + c( + "\n\tCustom row heights (row: height)\n\t", + stri_join( + sprintf("%s: %s", names(rowHeights[[i]]), round(as.numeric( + rowHeights[[i]] + ), 2)), + collapse = ", ", + sep = " " + ) + ) + ) + } + + if (length(outlineLevels[[i]]) > 0) { + tmpTxt <- + append( + tmpTxt, + c( + "\n\tGrouped rows:\n\t", + stri_join( + sprintf("%s", names(outlineLevels[[i]])), + collapse = ", ", + sep = " " + ) + ) + ) + } + + if (length(colOutlineLevels[[i]]) > 0) { + tmpTxt <- + append( + tmpTxt, + c( + "\n\tGrouped columns:\n\t", + stri_join( + sprintf("%s", names(colOutlineLevels[[i]])), + collapse = ", ", + sep = " " + ) + ) + ) + } + + if (length(colWidths[[i]]) > 0) { + cols <- names(colWidths[[i]]) + widths <- unname(colWidths[[i]]) + + widths[widths != "auto"] <- + as.numeric(widths[widths != "auto"]) + tmpTxt <- + append( + tmpTxt, + c( + "\n\tCustom column widths (column: width)\n\t ", + stri_join( + sprintf("%s: %s", cols, substr(widths, 1, 5)), + sep = " ", + collapse = ", " + ) + ) + ) + tmpTxt <- c(tmpTxt, "\n") + } + c(tmpTxt, "\n\n") + }) + + showText <- c(showText, sheetTxt, "\n") + } else { + showText <- + c(showText, "\nWorksheets:\n", "No worksheets attached\n") + } + + ## images + if (nImages > 0) { + showText <- + c( + showText, + "\nImages:\n", + sprintf('Image %s: "%s"\n', 1:nImages, media) + ) + } + + if (nCharts > 0) { + showText <- + c( + showText, + "\nCharts:\n", + sprintf('Chart %s: "%s"\n', 1:nCharts, charts) + ) + } + + if (nSheets > 0) { + showText <- + c(showText, sprintf( + "Worksheet write order: %s\n", + stri_join(sheetOrder, sep = " ", collapse = ", ") + )) + } + + + + if (aSheet >= 1 & nSheets > 0) { + showText <- + c( + showText, + sprintf( + 'Active Sheet %s: "%s" \n\tPosition: %s\n', + sheetOrder[aSheet], + exSheets[[sheetOrder[aSheet]]], + aSheet + ) + ) + } + + cat(unlist(showText)) + cat("\n") + } +) + +## TO BE DEPRECATED +Workbook$methods( + conditionalFormatCell = function(sheet, + startRow, + endRow, + startCol, + endCol, + dxfId, + formula, + type) { + sheet <- validateSheet(sheet) + sqref <- + stri_join(getCellRefs(data.frame( + "x" = c(startRow, endRow), + "y" = c(startCol, endCol) + )), collapse = ":") + + ## Increment priority of conditional formatting rule + if (length((worksheets[[sheet]]$conditionalFormatting)) > 0) { + for (i in rev(seq_along(worksheets[[sheet]]$conditionalFormatting))) { + worksheets[[sheet]]$conditionalFormatting[[i]] <<- + gsub('(?<=priority=")[0-9]+', + i + 1L, + worksheets[[sheet]]$conditionalFormatting[[i]], + perl = TRUE + ) + } + } + + nms <- c(names(worksheets[[sheet]]$conditionalFormatting), sqref) + + if (type == "expression") { + cfRule <- + sprintf( + '%s', + dxfId, + formula + ) + } else if (type == "dataBar") { + if (length(formula) == 2) { + negColour <- formula[[1]] + posColour <- formula[[2]] + } else { + posColour <- formula + negColour <- "FFFF0000" + } + + guid <- + stri_join( + "F7189283-14F7-4DE0-9601-54DE9DB", + 40000L + length(worksheets[[sheet]]$extLst) + ) + cfRule <- + sprintf( + '{%s}', + posColour, + guid + ) + } else if (length(formula) == 2L) { + cfRule <- + sprintf( + '', + formula[[1]], + formula[[2]] + ) + } else { + cfRule <- + sprintf( + '', + formula[[1]], + formula[[2]], + formula[[3]] + ) + } + + worksheets[[sheet]]$conditionalFormatting <<- + append(worksheets[[sheet]]$conditionalFormatting, cfRule) + + names(worksheets[[sheet]]$conditionalFormatting) <<- nms + + invisible(0) + } +) + + + + + + +Workbook$methods( + loadStyles = function(stylesXML) { + ## Build style objects from the styles XML + stylesTxt <- readUTF8(stylesXML) + stylesTxt <- removeHeadTag(stylesTxt) + + ## Indexed colours + vals <- getNodes(xml = stylesTxt, tagIn = "") + if (length(vals) > 0) { + styles$indexedColors <<- + stri_join("", vals, "") + } + + ## dxf (don't need these, I don't think) + dxf <- getNodes(xml = stylesTxt, tagIn = " 0) { + dxf <- getNodes(xml = dxf[[1]], tagIn = "") + if (length(dxf) > 0) { + styles$dxfs <<- dxf + } + } + + tableStyles <- getChildlessNode(stylesTxt, tag = "tableStyles") + if (length(tableStyles) > 0) { + styles$tableStyles <<- tableStyles + } + + extLst <- getChildlessNode(stylesTxt, tag = "extLst") + if (length(extLst) > 0) { + styles$extLst <<- extLst + } + + + ## Number formats + numFmts <- getChildlessNode(xml = stylesTxt, tag = "numFmt") + numFmtFlag <- FALSE + if (length(numFmts) > 0) { + numFmtsIds <- + sapply(numFmts, getAttr, tag = 'numFmtId="', USE.NAMES = FALSE) + formatCodes <- + sapply(numFmts, getAttr, tag = 'formatCode="', USE.NAMES = FALSE) + numFmts <- + lapply(seq_along(numFmts), function(i) { + list("numFmtId" = numFmtsIds[[i]], "formatCode" = formatCodes[[i]]) + }) + numFmtFlag <- TRUE + } + + ## fonts will maintain, sz, color, name, family scheme + if (grepl("", stylesTxt, fixed = TRUE)) { + ## empty font node + fonts <- getNodes(xml = stylesTxt, tagIn = "") + borders <- + substr( + borders, + start = regexpr("", borders)[1], + stop = regexpr("", borders) - 1L + ) + borders <- getNodes(xml = borders, tagIn = "", + stri_join( + names(attr), + '="', + attr, + '"', + collapse = " ", + sep = "" + ) + ) + if (!is.null(type) | !is.null(password)) + workbook$apps <<- sprintf("%i", type) + } else { + workbook$workbookProtection <<- "" + } + } +) + + + + + + + +Workbook$methods( + addCreator = function(Creator = NULL) { + if (!is.null(Creator)) { + current_creator <- + stri_match(core, regex = "(.*?)")[1, 2] + core <<- + stri_replace_all_fixed( + core, + pattern = current_creator, + replacement = stri_c(current_creator, Creator, sep = ";") + ) + } + } +) + + + + + +Workbook$methods( + getCreators = function() { + current_creator <- + stri_match(core, regex = "(.*?)")[1, 2] + + current_creator_vec <- as.character(stri_split_fixed( + str = current_creator, + pattern = ";", + simplify = T + )) + + return(current_creator_vec) + } +) + + + +Workbook$methods( + changeLastModifiedBy = function(LastModifiedBy = NULL) { + if (!is.null(LastModifiedBy)) { + current_LastModifiedBy <- + stri_match(core, regex = "(.*?)")[1, 2] + core <<- + stri_replace_all_fixed( + core, + pattern = current_LastModifiedBy, + replacement = LastModifiedBy + ) + } + } +) + + + +Workbook$methods( + setactiveSheet = function(activeSheet = NULL) { + if (is.character(activeSheet)) { + if (activeSheet %in% sheet_names) { + ActiveSheet <<- which(sheet_names[sheetOrder] == activeSheet) + } else { + stop(paste(activeSheet, "doesn't exist as sheet name.")) + } + } + + if (is.integer(activeSheet)|is.numeric(activeSheet)) { + if (activeSheet %in% seq_along(sheet_names)) { + ActiveSheet <<- which(sheetOrder==activeSheet) + }else { + stop(paste(activeSheet, "doesn't exist as sheet index.")) + } + } + + for(i in seq_along(sheet_names)){ + worksheets[[i]]$sheetViews <<- stri_replace_all_regex(worksheets[[i]]$sheetViews, + "tabSelected=\"(1|true|false|0)\"", + paste0("tabSelected=\"", + ifelse(sheetOrder[ActiveSheet] == i,"true","false") + ,"\"")) + + + } + + + + } +) diff -Nru r-cran-openxlsx-4.2.4/R/workbook_column_widths.R r-cran-openxlsx-4.2.5/R/workbook_column_widths.R --- r-cran-openxlsx-4.2.4/R/workbook_column_widths.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/workbook_column_widths.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,197 +1,197 @@ - -#' @include class_definitions.R - - -Workbook$methods(setColWidths = function(sheet) { - sheet <- validateSheet(sheet) - - widths <- colWidths[[sheet]] - hidden <- attr(colWidths[[sheet]], "hidden", exact = TRUE) - if (length(hidden) != length(widths)) { - hidden <- rep("0", length(widths)) - } - - cols <- names(colWidths[[sheet]]) - - autoColsInds <- widths %in% c("auto", "auto2") - autoCols <- cols[autoColsInds] - - ## If any not auto - if (any(!autoColsInds)) { - widths[!autoColsInds] <- as.numeric(widths[!autoColsInds]) + 0.71 - } - - ## If any auto - if (length(autoCols) > 0) { - - ## only run if data on worksheet - if (worksheets[[sheet]]$sheet_data$n_elements == 0) { - missingAuto <- autoCols - } else if (all(is.na(worksheets[[sheet]]$sheet_data$v))) { - missingAuto <- autoCols - } else { - - ## First thing - get base font max character width - baseFont <- getBaseFont() - baseFontName <- unlist(baseFont$name, use.names = FALSE) - if (is.null(baseFontName)) { - baseFontName <- "calibri" - } else { - baseFontName <- gsub(" ", ".", tolower(baseFontName), fixed = TRUE) - if (!baseFontName %in% names(openxlsxFontSizeLookupTable)) { - baseFontName <- "calibri" - } - } - - baseFontSize <- unlist(baseFont$size, use.names = FALSE) - if (is.null(baseFontSize)) { - baseFontSize <- 11 - } else { - baseFontSize <- as.numeric(baseFontSize) - baseFontSize <- ifelse(baseFontSize < 8, 8, ifelse(baseFontSize > 36, 36, baseFontSize)) - } - - baseFontCharWidth <- openxlsxFontSizeLookupTable[[baseFontName]][baseFontSize - 7] - allCharWidths <- rep(baseFontCharWidth, worksheets[[sheet]]$sheet_data$n_elements) - ######### ---------------------------------------------------------------- - - ## get char widths for each style object - if (length(styleObjects) > 0 & any(!is.na(worksheets[[sheet]]$sheet_data$style_id))) { - thisSheetName <- sheet_names[sheet] - - ## Calc font width for all styles on this worksheet - styleIds <- worksheets[[sheet]]$sheet_data$style_id - styObSubet <- styleObjects[sort(unique(styleIds))] - stySubset <- lapply(styObSubet, "[[", "style") - - ## loop through stlye objects assignin a charWidth else baseFontCharWidth - styleCharWidths <- sapply(stySubset, get_style_max_char_width, USE.NAMES = FALSE) - - - ## Now assign all cells a character width - allCharWidths <- styleCharWidths[worksheets[[sheet]]$sheet_data$style_id] - allCharWidths[is.na(allCharWidths)] <- baseFontCharWidth - } - - ## Now check for columns that are auto2 - auto2Inds <- which(widths %in% "auto2") - if (length(auto2Inds) > 0 & length(worksheets[[sheet]]$mergeCells) > 0) { - - ## get cell merges - merged_cells <- regmatches(worksheets[[sheet]]$mergeCells, regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells)) - - comps <- lapply(merged_cells, function(rectCoords) unlist(strsplit(rectCoords, split = ":"))) - merge_cols <- lapply(comps, convertFromExcelRef) - merge_cols <- lapply(merge_cols, function(x) x[x %in% cols[auto2Inds]]) ## subset to auto2Inds - - merge_rows <- lapply(comps, function(x) as.numeric(gsub("[A-Z]", "", x, perl = TRUE))) - merge_rows <- merge_rows[sapply(merge_cols, length) > 0] - merge_cols <- merge_cols[sapply(merge_cols, length) > 0] - - sd <- worksheets[[sheet]]$sheet_data - - if (length(merge_cols) > 0) { - all_merged_cells <- lapply(seq_along(merge_cols), function(i) { - expand.grid( - "rows" = min(merge_rows[[i]]):max(merge_rows[[i]]), - "cols" = min(merge_cols[[i]]):max(merge_cols[[i]]) - ) - }) - - all_merged_cells <- do.call("rbind", all_merged_cells) - - ## only want the sheet data in here - refs <- paste(all_merged_cells[[1]], all_merged_cells[[2]], sep = ",") - existing_cells <- paste(worksheets[[sheet]]$sheet_data$rows, worksheets[[sheet]]$sheet_data$cols, sep = ",") - keep <- which(!existing_cells %in% refs & !is.na(worksheets[[sheet]]$sheet_data$v)) - - sd <- Sheet_Data$new() - sd$cols <- worksheets[[sheet]]$sheet_data$cols[keep] - sd$t <- worksheets[[sheet]]$sheet_data$t[keep] - sd$v <- worksheets[[sheet]]$sheet_data$v[keep] - sd$n_elements <- length(sd$cols) - allCharWidths <- allCharWidths[keep] - } else { - sd <- worksheets[[sheet]]$sheet_data - } - } else { - sd <- worksheets[[sheet]]$sheet_data - } - - ## Now that we have the max character width for the largest font on the page calculate the column widths - calculatedWidths <- calc_column_widths( - sheet_data = sd, - sharedStrings = unlist(sharedStrings, use.names = FALSE), - autoColumns = as.integer(autoCols), - widths = allCharWidths, - baseFontCharWidth = baseFontCharWidth, - minW = openxlsx_getOp("minWidth", 3), - maxW = openxlsx_getOp("maxWidth", 250) - ) - - missingAuto <- autoCols[!autoCols %in% names(calculatedWidths)] - widths[names(calculatedWidths)] <- calculatedWidths + 0.71 - } - - widths[missingAuto] <- 9.15 - } - - # Check if any conflicting existing levels - if (any(cols %in% names(worksheets[[sheet]]$cols))) { - - for (i in intersect(cols, names(worksheets[[sheet]]$cols))) { - - width_hidden <- attr(colWidths[[sheet]], "hidden")[attr(colWidths[[sheet]], "names") == i] - width_widths <- as.numeric(colWidths[[sheet]][attr(colWidths[[sheet]], "names") == i]) + 0.71 - - # If column already has a custom width, just update the width and hidden attributes - if (grepl("customWidth", worksheets[[sheet]]$cols[[i]])) { - worksheets[[sheet]]$cols[[i]] <<- sub('(width=\\").*?(\\"\\shidden=\\").*?(\\")', paste0("\\1", width_widths, "\\2", width_hidden, "\\3"), worksheets[[sheet]]$cols[[i]], perl = TRUE) - } else { - # If column exists, but doesn't have a custom width - worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w)\")", paste0(width_hidden, "\" width=\"", width_widths, "\" customWidth=\"1\"/>"), worksheets[[sheet]]$cols[[i]], perl = TRUE) - } - } - - cols <- cols[!cols %in% names(worksheets[[sheet]]$cols)] - } - - # Add remaining columns - if (length(cols) > 0) { - colNodes <- sprintf('', cols, cols, widths, hidden) - names(colNodes) <- cols - worksheets[[sheet]]$cols <<- append(worksheets[[sheet]]$cols, colNodes) - } - -}) - - - - -get_style_max_char_width <- function(thisStyle) { - fN <- unlist(thisStyle$fontName, use.names = FALSE) - if (is.null(fN)) { - fN <- "calibri" - } else { - fN <- gsub(" ", ".", tolower(fN), fixed = TRUE) - if (!fN %in% names(openxlsxFontSizeLookupTable)) { - fN <- "calibri" - } - } - - fS <- unlist(thisStyle$fontSize, use.names = FALSE) - if (is.null(fS)) { - fS <- 11 - } else { - fS <- as.numeric(fS) - fS <- ifelse(fS < 8, 8, ifelse(fS > 36, 36, fS)) - } - - if ("BOLD" %in% thisStyle$fontDecoration) { - styleMaxCharWidth <- openxlsxFontSizeLookupTableBold[[fN]][fS - 7] - } else { - styleMaxCharWidth <- openxlsxFontSizeLookupTable[[fN]][fS - 7] - } - - return(styleMaxCharWidth) -} + +#' @include class_definitions.R + + +Workbook$methods(setColWidths = function(sheet) { + sheet <- validateSheet(sheet) + + widths <- colWidths[[sheet]] + hidden <- attr(colWidths[[sheet]], "hidden", exact = TRUE) + if (length(hidden) != length(widths)) { + hidden <- rep("0", length(widths)) + } + + cols <- names(colWidths[[sheet]]) + + autoColsInds <- widths %in% c("auto", "auto2") + autoCols <- cols[autoColsInds] + + ## If any not auto + if (any(!autoColsInds)) { + widths[!autoColsInds] <- as.numeric(widths[!autoColsInds]) + 0.71 + } + + ## If any auto + if (length(autoCols) > 0) { + + ## only run if data on worksheet + if (worksheets[[sheet]]$sheet_data$n_elements == 0) { + missingAuto <- autoCols + } else if (all(is.na(worksheets[[sheet]]$sheet_data$v))) { + missingAuto <- autoCols + } else { + + ## First thing - get base font max character width + baseFont <- getBaseFont() + baseFontName <- unlist(baseFont$name, use.names = FALSE) + if (is.null(baseFontName)) { + baseFontName <- "calibri" + } else { + baseFontName <- gsub(" ", ".", tolower(baseFontName), fixed = TRUE) + if (!baseFontName %in% names(openxlsxFontSizeLookupTable)) { + baseFontName <- "calibri" + } + } + + baseFontSize <- unlist(baseFont$size, use.names = FALSE) + if (is.null(baseFontSize)) { + baseFontSize <- 11 + } else { + baseFontSize <- as.numeric(baseFontSize) + baseFontSize <- ifelse(baseFontSize < 8, 8, ifelse(baseFontSize > 36, 36, baseFontSize)) + } + + baseFontCharWidth <- openxlsxFontSizeLookupTable[[baseFontName]][baseFontSize - 7] + allCharWidths <- rep(baseFontCharWidth, worksheets[[sheet]]$sheet_data$n_elements) + ######### ---------------------------------------------------------------- + + ## get char widths for each style object + if (length(styleObjects) > 0 & any(!is.na(worksheets[[sheet]]$sheet_data$style_id))) { + thisSheetName <- sheet_names[sheet] + + ## Calc font width for all styles on this worksheet + styleIds <- worksheets[[sheet]]$sheet_data$style_id + styObSubet <- styleObjects[sort(unique(styleIds))] + stySubset <- lapply(styObSubet, "[[", "style") + + ## loop through stlye objects assignin a charWidth else baseFontCharWidth + styleCharWidths <- sapply(stySubset, get_style_max_char_width, USE.NAMES = FALSE) + + + ## Now assign all cells a character width + allCharWidths <- styleCharWidths[worksheets[[sheet]]$sheet_data$style_id] + allCharWidths[is.na(allCharWidths)] <- baseFontCharWidth + } + + ## Now check for columns that are auto2 + auto2Inds <- which(widths %in% "auto2") + if (length(auto2Inds) > 0 & length(worksheets[[sheet]]$mergeCells) > 0) { + + ## get cell merges + merged_cells <- regmatches(worksheets[[sheet]]$mergeCells, regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells)) + + comps <- lapply(merged_cells, function(rectCoords) unlist(strsplit(rectCoords, split = ":"))) + merge_cols <- lapply(comps, convertFromExcelRef) + merge_cols <- lapply(merge_cols, function(x) x[x %in% cols[auto2Inds]]) ## subset to auto2Inds + + merge_rows <- lapply(comps, function(x) as.numeric(gsub("[A-Z]", "", x, perl = TRUE))) + merge_rows <- merge_rows[sapply(merge_cols, length) > 0] + merge_cols <- merge_cols[sapply(merge_cols, length) > 0] + + sd <- worksheets[[sheet]]$sheet_data + + if (length(merge_cols) > 0) { + all_merged_cells <- lapply(seq_along(merge_cols), function(i) { + expand.grid( + "rows" = min(merge_rows[[i]]):max(merge_rows[[i]]), + "cols" = min(merge_cols[[i]]):max(merge_cols[[i]]) + ) + }) + + all_merged_cells <- do.call("rbind", all_merged_cells) + + ## only want the sheet data in here + refs <- paste(all_merged_cells[[1]], all_merged_cells[[2]], sep = ",") + existing_cells <- paste(worksheets[[sheet]]$sheet_data$rows, worksheets[[sheet]]$sheet_data$cols, sep = ",") + keep <- which(!existing_cells %in% refs & !is.na(worksheets[[sheet]]$sheet_data$v)) + + sd <- Sheet_Data$new() + sd$cols <- worksheets[[sheet]]$sheet_data$cols[keep] + sd$t <- worksheets[[sheet]]$sheet_data$t[keep] + sd$v <- worksheets[[sheet]]$sheet_data$v[keep] + sd$n_elements <- length(sd$cols) + allCharWidths <- allCharWidths[keep] + } else { + sd <- worksheets[[sheet]]$sheet_data + } + } else { + sd <- worksheets[[sheet]]$sheet_data + } + + ## Now that we have the max character width for the largest font on the page calculate the column widths + calculatedWidths <- calc_column_widths( + sheet_data = sd, + sharedStrings = unlist(sharedStrings, use.names = FALSE), + autoColumns = as.integer(autoCols), + widths = allCharWidths, + baseFontCharWidth = baseFontCharWidth, + minW = openxlsx_getOp("minWidth", 3), + maxW = openxlsx_getOp("maxWidth", 250) + ) + + missingAuto <- autoCols[!autoCols %in% names(calculatedWidths)] + widths[names(calculatedWidths)] <- calculatedWidths + 0.71 + } + + widths[missingAuto] <- 9.15 + } + + # Check if any conflicting existing levels + if (any(cols %in% names(worksheets[[sheet]]$cols))) { + + for (i in intersect(cols, names(worksheets[[sheet]]$cols))) { + + width_hidden <- attr(colWidths[[sheet]], "hidden")[attr(colWidths[[sheet]], "names") == i] + width_widths <- as.numeric(colWidths[[sheet]][attr(colWidths[[sheet]], "names") == i]) + 0.71 + + # If column already has a custom width, just update the width and hidden attributes + if (grepl("customWidth", worksheets[[sheet]]$cols[[i]])) { + worksheets[[sheet]]$cols[[i]] <<- sub('(width=\\").*?(\\"\\shidden=\\").*?(\\")', paste0("\\1", width_widths, "\\2", width_hidden, "\\3"), worksheets[[sheet]]$cols[[i]], perl = TRUE) + } else { + # If column exists, but doesn't have a custom width + worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w)\")", paste0(width_hidden, "\" width=\"", width_widths, "\" customWidth=\"1\"/>"), worksheets[[sheet]]$cols[[i]], perl = TRUE) + } + } + + cols <- cols[!cols %in% names(worksheets[[sheet]]$cols)] + } + + # Add remaining columns + if (length(cols) > 0) { + colNodes <- sprintf('', cols, cols, widths, hidden) + names(colNodes) <- cols + worksheets[[sheet]]$cols <<- append(worksheets[[sheet]]$cols, colNodes) + } + +}) + + + + +get_style_max_char_width <- function(thisStyle) { + fN <- unlist(thisStyle$fontName, use.names = FALSE) + if (is.null(fN)) { + fN <- "calibri" + } else { + fN <- gsub(" ", ".", tolower(fN), fixed = TRUE) + if (!fN %in% names(openxlsxFontSizeLookupTable)) { + fN <- "calibri" + } + } + + fS <- unlist(thisStyle$fontSize, use.names = FALSE) + if (is.null(fS)) { + fS <- 11 + } else { + fS <- as.numeric(fS) + fS <- ifelse(fS < 8, 8, ifelse(fS > 36, 36, fS)) + } + + if ("BOLD" %in% thisStyle$fontDecoration) { + styleMaxCharWidth <- openxlsxFontSizeLookupTableBold[[fN]][fS - 7] + } else { + styleMaxCharWidth <- openxlsxFontSizeLookupTable[[fN]][fS - 7] + } + + return(styleMaxCharWidth) +} diff -Nru r-cran-openxlsx-4.2.4/R/workbook_read_workbook.R r-cran-openxlsx-4.2.5/R/workbook_read_workbook.R --- r-cran-openxlsx-4.2.4/R/workbook_read_workbook.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/workbook_read_workbook.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,361 +1,361 @@ - - - - -#' @export -read.xlsx.Workbook <- function(xlsxFile, - sheet = 1, - startRow = 1, - colNames = TRUE, - rowNames = FALSE, - detectDates = FALSE, - skipEmptyRows = TRUE, - skipEmptyCols = TRUE, - rows = NULL, - cols = NULL, - check.names = FALSE, - sep.names = ".", - namedRegion = NULL, - na.strings = "NA", - fillMergedCells = FALSE) { - - - ## Validate inputs and get files - if (!is.logical(colNames)) { - stop("colNames must be TRUE/FALSE.") - } - - if (!is.logical(rowNames)) { - stop("rowNames must be TRUE/FALSE.") - } - - if (!is.logical(detectDates)) { - stop("detectDates must be TRUE/FALSE.") - } - - if (!is.logical(skipEmptyRows)) { - stop("skipEmptyRows must be TRUE/FALSE.") - } - - if (!is.logical(check.names)) { - stop("check.names must be TRUE/FALSE.") - } - - if (!is.character(sep.names) | nchar(sep.names) != 1) { - stop("sep.names must be a character and only one.") - } - - if (length(sheet) != 1) { - stop("sheet must be of length 1.") - } - - ## Named region logic - reading_named_region <- FALSE - if (!is.null(namedRegion)) { - dn <- xlsxFile$workbook$definedNames - if (length(dn) == 0) { - warning("Workbook has no named regions.") - return(NULL) - } - - dn_names <- replaceXMLEntities(regmatches(dn, regexpr('(?<=name=")[^"]+', dn, perl = TRUE))) - ind <- tolower(dn_names) == tolower(namedRegion) - if (!any(ind)) { - stop(sprintf("Region '%s' not found!", namedRegion)) - } - - ## pull out first node value - dn <- dn[ind] - region <- regmatches(dn, regexpr("(?<=>)[^\\<]+", dn, perl = TRUE)) - sheet <- names(xlsxFile)[sapply(names(xlsxFile), function(x) grepl(x, dn))] - if (length(sheet) > 1) { - sheet <- sheet[which.max(nchar(sheet))] - } - - region <- gsub("[^A-Z0-9:]", "", gsub(sheet, "", region, fixed = TRUE)) - - if (grepl(":", region, fixed = TRUE)) { - cols <- unlist(lapply(strsplit(region, split = ":", fixed = TRUE), convertFromExcelRef)) - rows <- unlist(lapply(strsplit(region, split = ":", fixed = TRUE), function(x) as.integer(gsub("[A-Z]", "", x)))) - - cols <- seq(from = cols[1], to = cols[2], by = 1) - rows <- seq(from = rows[1], to = rows[2], by = 1) - } else { - cols <- convertFromExcelRef(region) - rows <- as.integer(gsub("[A-Z]", "", region, perl = TRUE)) - } - startRow <- 1 - reading_named_region <- TRUE - named_region_rows <- rows - } - - - if (is.null(rows)) { - rows <- NA - } else if (length(rows) > 1) { - rows <- as.integer(sort(rows)) - } - - ## check startRow - if (!is.null(startRow)) { - if (length(startRow) > 1) { - stop("startRow must have length 1.") - } - } - - - - ## create temp dir and unzip - nSheets <- length(xlsxFile$worksheets) - if (nSheets == 0) { - stop("Workbook has no worksheets") - } - - ## get workbook names - sheetNames <- xlsxFile$sheet_names - - if ("character" %in% class(sheet)) { - sheetNames <- replaceXMLEntities(sheetNames) - if (!sheet %in% sheetNames) { - stop(sprintf('Cannot find sheet named "%s"', sheet)) - } - sheet <- which(sheetNames == sheet) - } else { - sheet <- sheet - if (sheet > nSheets) { - stop(sprintf("sheet %s does not exist.", sheet)) - } - } - - - ## read in sharedStrings - sharedStrings <- paste(unlist(xlsxFile$sharedStrings), collapse = "\n") - if (length(sharedStrings) > 0) { - sharedStrings <- getSharedStringsFromFile(sharedStringsFile = sharedStrings, isFile = FALSE) - if (!is.null(na.strings)) { - sharedStrings[sharedStrings %in% na.strings] <- NA - } - } - - ## read in worksheet and get cells with a value node, skip emptyStrs cells - xlsxFile$worksheets[[sheet]]$order_sheetdata() - sheet_data <- xlsxFile$worksheets[[sheet]]$sheet_data - - - - ###################################################### - ## What data to read - - - keep <- rep.int(TRUE, length(sheet_data$rows)) - if (!is.na(rows[1])) { - keep <- keep & (sheet_data$rows %in% rows) - } - - if (!is.null(cols[1])) { - keep <- keep & (sheet_data$cols %in% cols) - } - - if (startRow > 1) { - keep <- keep & (sheet_data$rows >= startRow) - } - - ## error cells - keep <- keep & (sheet_data$t != 4 & !is.na(sheet_data$t) & !is.na(sheet_data$v)) ## "e" or missing - if (any(is.na(sharedStrings))) { - keep[(sheet_data$t %in% 1 & (sheet_data$v %in% as.character(which(is.na(sharedStrings)) - 1L)))] <- FALSE - } - - ## End what data to read - ###################################################### - - - - rows <- sheet_data$rows[keep] - cols <- sheet_data$cols[keep] - v <- sheet_data$v[keep] - t <- sheet_data$t[keep] - - if (length(v) == 0) { - warning("No data found on worksheet.", call. = FALSE) - return(NULL) - } - - - if (is.null(rows)) { - warning("No data found on worksheet.", call. = FALSE) - return(NULL) - } else { - if (skipEmptyRows) { - nRows <- length(unique(rows)) - } else if (reading_named_region) { - nRows <- max(named_region_rows) - min(named_region_rows) + 1 - } else { - nRows <- max(rows) - min(rows) + 1 - } - } - - ## get references for string cells - string_refs <- which(t == 2 | t == 1) ## "b" or "s" - if (length(string_refs) == 0) { - string_refs <- -1L - } - - - ## get Refs for boolean - bool_refs <- which(t == 2) ## "b" - if (length(bool_refs) == 0) { - bool_refs <- -1L - } - - if (bool_refs[1] != -1L) { - false_ind <- which(sharedStrings == "FALSE") - 1L - if (length(false_ind) == 0) { - false_ind <- length(sharedStrings) - sharedStrings <- c(sharedStrings, "FALSE") - } - - true_ind <- which(sharedStrings == "TRUE") - 1L - if (length(true_ind) == 0) { - true_ind <- length(sharedStrings) - sharedStrings <- c(sharedStrings, "TRUE") - } - - logical_vals <- v[bool_refs] - logical_vals[logical_vals == "0"] <- false_ind[1] - logical_vals[logical_vals == "1"] <- true_ind[1] - v[bool_refs] <- logical_vals - - rm(logical_vals) - rm(bool_refs) - } - - - ## If any t="str" exist, add v to sharedStrings and replace v with newSharedStringsInd - str_inds <- which(t == 3) ## "str" - if (length(str_inds) > 0) { - unique_strs <- unique(v[str_inds]) - unique_strs[unique_strs == "#N/A"] <- NA - - ## Match references of "str" cells to r - new_shared_string_inds <- length(sharedStrings):(length(sharedStrings) + length(unique_strs) - 1L) - - ## replace strings in v with reference to sharedStrings, (now can convert v to numeric) - v[str_inds] <- new_shared_string_inds[match(v[str_inds], unique_strs)] - - ## append new strings to sharedStrings - sharedStrings <- c(sharedStrings, unique_strs) - if (string_refs[1] == -1L) { - string_refs <- str_inds - } else { - string_refs <- sort(c(string_refs, str_inds)) - } - } - - ## Now safe to convert v to numeric - vn <- as.numeric(v) - - ## Using -1 as a flag for no strings - if (length(sharedStrings) == 0 | string_refs[1] == -1L) { - string_refs <- as.integer(NA) - } else { - - ## set encoding of sharedStrings & replace values in v with string values - Encoding(sharedStrings) <- "UTF-8" - v[string_refs] <- sharedStrings[vn[string_refs] + 1L] - - ## any NA sharedStrings - remove - v_na <- which(is.na(v)) - if (length(v_na) > 0) { - string_refs <- setdiff(string_refs, v_na) - } - } - - - ## date detection - origin <- 25569L - isDate <- as.logical(NA) - - if (detectDates) { - - ## get date origin - if (length(xlsxFile$workbook$workbookPr) > 0) { - if (grepl('date1904="1"|date1904="true"', xlsxFile$workbook$workbookPr, ignore.case = TRUE)) { - origin <- 24107L - } - } - - sO <- xlsxFile$styleObjects - sO <- sO[unlist(lapply(sO, "[[", "sheet")) == sheetNames[sheet]] - - - styles <- lapply(sO, function(x) { - fc <- x[["style"]][["numFmt"]]$formatCode - if (is.null(fc)) { - fc <- x[["style"]][["numFmt"]]$numFmtId - } - fc - }) - - - - sO <- sO[sapply(styles, length) > 0] - format_codes <- unlist(lapply(sO, function(x) { - fc <- x[["style"]][["numFmt"]]$formatCode - if (is.null(fc)) { - fc <- x[["style"]][["numFmt"]]$numFmtId - } - fc - })) - - - # dateIds <- NULL variable not used - if (length(format_codes) > 0) { - - ## this regex defines what "looks" like a date - format_codes <- gsub(".*(?<=\\])|@", "", format_codes, perl = TRUE) - sO <- sO[(!grepl("[^mdyhsapAMP[:punct:] ]", format_codes) & nchar(format_codes > 3)) | format_codes == 14] - } - - if (length(sO) > 0) { - style_rows <- unlist(lapply(sO, "[[", "rows")) - style_cols <- unlist(lapply(sO, "[[", "cols")) - isDate <- paste(rows, cols, sep = ",") %in% paste(style_rows, style_cols, sep = ",") - - ## check numbers are also integers - not_an_integer <- suppressWarnings(as.numeric(v[isDate])) - not_an_integer <- (not_an_integer %% 1L != 0) | is.na(not_an_integer) - isDate[not_an_integer] <- FALSE - - ## perform int to date to character convertsion (way too slow) - v[isDate] <- format(as.Date(as.integer(v[isDate]) - origin, origin = "1970-01-01"), "%Y-%m-%d") - } - } ## end of detectDates - - - ## Build data.frame - m <- read_workbook( - cols_in = cols, - rows_in = rows, - v = v, - string_inds = string_refs, - is_date = isDate, - hasColNames = colNames, - hasSepNames = sep.names, - skipEmptyRows = skipEmptyRows, - skipEmptyCols = skipEmptyCols, - nRows = nRows, - clean_names = clean_names - ) - - if (colNames && check.names) { - colnames(m) <- make.names(colnames(m), unique = TRUE) - } - - if (rowNames) { - rownames(m) <- m[[1]] - m[[1]] <- NULL - } - - return(m) -} + + + + +#' @export +read.xlsx.Workbook <- function(xlsxFile, + sheet = 1, + startRow = 1, + colNames = TRUE, + rowNames = FALSE, + detectDates = FALSE, + skipEmptyRows = TRUE, + skipEmptyCols = TRUE, + rows = NULL, + cols = NULL, + check.names = FALSE, + sep.names = ".", + namedRegion = NULL, + na.strings = "NA", + fillMergedCells = FALSE) { + + + ## Validate inputs and get files + if (!is.logical(colNames)) { + stop("colNames must be TRUE/FALSE.") + } + + if (!is.logical(rowNames)) { + stop("rowNames must be TRUE/FALSE.") + } + + if (!is.logical(detectDates)) { + stop("detectDates must be TRUE/FALSE.") + } + + if (!is.logical(skipEmptyRows)) { + stop("skipEmptyRows must be TRUE/FALSE.") + } + + if (!is.logical(check.names)) { + stop("check.names must be TRUE/FALSE.") + } + + if (!is.character(sep.names) | nchar(sep.names) != 1) { + stop("sep.names must be a character and only one.") + } + + if (length(sheet) != 1) { + stop("sheet must be of length 1.") + } + + ## Named region logic + reading_named_region <- FALSE + if (!is.null(namedRegion)) { + dn <- xlsxFile$workbook$definedNames + if (length(dn) == 0) { + warning("Workbook has no named regions.") + return(NULL) + } + + dn_names <- replaceXMLEntities(regmatches(dn, regexpr('(?<=name=")[^"]+', dn, perl = TRUE))) + ind <- tolower(dn_names) == tolower(namedRegion) + if (!any(ind)) { + stop(sprintf("Region '%s' not found!", namedRegion)) + } + + ## pull out first node value + dn <- dn[ind] + region <- regmatches(dn, regexpr("(?<=>)[^\\<]+", dn, perl = TRUE)) + sheet <- names(xlsxFile)[sapply(names(xlsxFile), function(x) grepl(x, dn))] + if (length(sheet) > 1) { + sheet <- sheet[which.max(nchar(sheet))] + } + + region <- gsub("[^A-Z0-9:]", "", gsub(sheet, "", region, fixed = TRUE)) + + if (grepl(":", region, fixed = TRUE)) { + cols <- unlist(lapply(strsplit(region, split = ":", fixed = TRUE), convertFromExcelRef)) + rows <- unlist(lapply(strsplit(region, split = ":", fixed = TRUE), function(x) as.integer(gsub("[A-Z]", "", x)))) + + cols <- seq(from = cols[1], to = cols[2], by = 1) + rows <- seq(from = rows[1], to = rows[2], by = 1) + } else { + cols <- convertFromExcelRef(region) + rows <- as.integer(gsub("[A-Z]", "", region, perl = TRUE)) + } + startRow <- 1 + reading_named_region <- TRUE + named_region_rows <- rows + } + + + if (is.null(rows)) { + rows <- NA + } else if (length(rows) > 1) { + rows <- as.integer(sort(rows)) + } + + ## check startRow + if (!is.null(startRow)) { + if (length(startRow) > 1) { + stop("startRow must have length 1.") + } + } + + + + ## create temp dir and unzip + nSheets <- length(xlsxFile$worksheets) + if (nSheets == 0) { + stop("Workbook has no worksheets") + } + + ## get workbook names + sheetNames <- xlsxFile$sheet_names + + if ("character" %in% class(sheet)) { + sheetNames <- replaceXMLEntities(sheetNames) + if (!sheet %in% sheetNames) { + stop(sprintf('Cannot find sheet named "%s"', sheet)) + } + sheet <- which(sheetNames == sheet) + } else { + sheet <- sheet + if (sheet > nSheets) { + stop(sprintf("sheet %s does not exist.", sheet)) + } + } + + + ## read in sharedStrings + sharedStrings <- paste(unlist(xlsxFile$sharedStrings), collapse = "\n") + if (length(sharedStrings) > 0) { + sharedStrings <- getSharedStringsFromFile(sharedStringsFile = sharedStrings, isFile = FALSE) + if (!is.null(na.strings)) { + sharedStrings[sharedStrings %in% na.strings] <- NA + } + } + + ## read in worksheet and get cells with a value node, skip emptyStrs cells + xlsxFile$worksheets[[sheet]]$order_sheetdata() + sheet_data <- xlsxFile$worksheets[[sheet]]$sheet_data + + + + ###################################################### + ## What data to read + + + keep <- rep.int(TRUE, length(sheet_data$rows)) + if (!is.na(rows[1])) { + keep <- keep & (sheet_data$rows %in% rows) + } + + if (!is.null(cols[1])) { + keep <- keep & (sheet_data$cols %in% cols) + } + + if (startRow > 1) { + keep <- keep & (sheet_data$rows >= startRow) + } + + ## error cells + keep <- keep & (sheet_data$t != 4 & !is.na(sheet_data$t) & !is.na(sheet_data$v)) ## "e" or missing + if (any(is.na(sharedStrings))) { + keep[(sheet_data$t %in% 1 & (sheet_data$v %in% as.character(which(is.na(sharedStrings)) - 1L)))] <- FALSE + } + + ## End what data to read + ###################################################### + + + + rows <- sheet_data$rows[keep] + cols <- sheet_data$cols[keep] + v <- sheet_data$v[keep] + t <- sheet_data$t[keep] + + if (length(v) == 0) { + warning("No data found on worksheet.", call. = FALSE) + return(NULL) + } + + + if (is.null(rows)) { + warning("No data found on worksheet.", call. = FALSE) + return(NULL) + } else { + if (skipEmptyRows) { + nRows <- length(unique(rows)) + } else if (reading_named_region) { + nRows <- max(named_region_rows) - min(named_region_rows) + 1 + } else { + nRows <- max(rows) - min(rows) + 1 + } + } + + ## get references for string cells + string_refs <- which(t == 2 | t == 1) ## "b" or "s" + if (length(string_refs) == 0) { + string_refs <- -1L + } + + + ## get Refs for boolean + bool_refs <- which(t == 2) ## "b" + if (length(bool_refs) == 0) { + bool_refs <- -1L + } + + if (bool_refs[1] != -1L) { + false_ind <- which(sharedStrings == "FALSE") - 1L + if (length(false_ind) == 0) { + false_ind <- length(sharedStrings) + sharedStrings <- c(sharedStrings, "FALSE") + } + + true_ind <- which(sharedStrings == "TRUE") - 1L + if (length(true_ind) == 0) { + true_ind <- length(sharedStrings) + sharedStrings <- c(sharedStrings, "TRUE") + } + + logical_vals <- v[bool_refs] + logical_vals[logical_vals == "0"] <- false_ind[1] + logical_vals[logical_vals == "1"] <- true_ind[1] + v[bool_refs] <- logical_vals + + rm(logical_vals) + rm(bool_refs) + } + + + ## If any t="str" exist, add v to sharedStrings and replace v with newSharedStringsInd + str_inds <- which(t %in% c(3, 5)) ## "str" or "inlineStr" + if (length(str_inds) > 0) { + unique_strs <- unique(v[str_inds]) + unique_strs[unique_strs == "#N/A"] <- NA + + ## Match references of "str" cells to r + new_shared_string_inds <- length(sharedStrings):(length(sharedStrings) + length(unique_strs) - 1L) + + ## replace strings in v with reference to sharedStrings, (now can convert v to numeric) + v[str_inds] <- new_shared_string_inds[match(v[str_inds], unique_strs)] + + ## append new strings to sharedStrings + sharedStrings <- c(sharedStrings, unique_strs) + if (string_refs[1] == -1L) { + string_refs <- str_inds + } else { + string_refs <- sort(c(string_refs, str_inds)) + } + } + + ## Now safe to convert v to numeric + vn <- as.numeric(v) + + ## Using -1 as a flag for no strings + if (length(sharedStrings) == 0 | string_refs[1] == -1L) { + string_refs <- as.integer(NA) + } else { + + ## set encoding of sharedStrings & replace values in v with string values + Encoding(sharedStrings) <- "UTF-8" + v[string_refs] <- sharedStrings[vn[string_refs] + 1L] + + ## any NA sharedStrings - remove + v_na <- which(is.na(v)) + if (length(v_na) > 0) { + string_refs <- setdiff(string_refs, v_na) + } + } + + + ## date detection + origin <- 25569L + isDate <- as.logical(NA) + + if (detectDates) { + + ## get date origin + if (length(xlsxFile$workbook$workbookPr) > 0) { + if (grepl('date1904="1"|date1904="true"', xlsxFile$workbook$workbookPr, ignore.case = TRUE)) { + origin <- 24107L + } + } + + sO <- xlsxFile$styleObjects + sO <- sO[unlist(lapply(sO, "[[", "sheet")) == sheetNames[sheet]] + + + styles <- lapply(sO, function(x) { + fc <- x[["style"]][["numFmt"]]$formatCode + if (is.null(fc)) { + fc <- x[["style"]][["numFmt"]]$numFmtId + } + fc + }) + + + + sO <- sO[sapply(styles, length) > 0] + format_codes <- unlist(lapply(sO, function(x) { + fc <- x[["style"]][["numFmt"]]$formatCode + if (is.null(fc)) { + fc <- x[["style"]][["numFmt"]]$numFmtId + } + fc + })) + + + # dateIds <- NULL variable not used + if (length(format_codes) > 0) { + + ## this regex defines what "looks" like a date + format_codes <- gsub(".*(?<=\\])|@", "", format_codes, perl = TRUE) + sO <- sO[(!grepl("[^mdyhsapAMP[:punct:] ]", format_codes) & nchar(format_codes > 3)) | format_codes == 14] + } + + if (length(sO) > 0) { + style_rows <- unlist(lapply(sO, "[[", "rows")) + style_cols <- unlist(lapply(sO, "[[", "cols")) + isDate <- paste(rows, cols, sep = ",") %in% paste(style_rows, style_cols, sep = ",") + + ## check numbers are also integers + not_an_integer <- suppressWarnings(as.numeric(v[isDate])) + not_an_integer <- (not_an_integer %% 1L != 0) | is.na(not_an_integer) + isDate[not_an_integer] <- FALSE + + ## perform int to date to character convertsion (way too slow) + v[isDate] <- format(as.Date(as.integer(v[isDate]) - origin, origin = "1970-01-01"), "%Y-%m-%d") + } + } ## end of detectDates + + + ## Build data.frame + m <- read_workbook( + cols_in = cols, + rows_in = rows, + v = v, + string_inds = string_refs, + is_date = isDate, + hasColNames = colNames, + hasSepNames = sep.names, + skipEmptyRows = skipEmptyRows, + skipEmptyCols = skipEmptyCols, + nRows = nRows, + clean_names = clean_names + ) + + if (colNames && check.names) { + colnames(m) <- make.names(colnames(m), unique = TRUE) + } + + if (rowNames) { + rownames(m) <- m[[1]] + m[[1]] <- NULL + } + + return(m) +} diff -Nru r-cran-openxlsx-4.2.4/R/workbook_write_data.R r-cran-openxlsx-4.2.5/R/workbook_write_data.R --- r-cran-openxlsx-4.2.4/R/workbook_write_data.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/workbook_write_data.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,302 +1,308 @@ - -#' @include class_definitions.R -Workbook$methods(writeData = function( - df, - sheet, - startRow, - startCol, - colNames, - colClasses, - hlinkNames, - keepNA, - na.string, - list_sep -) { - sheet <- validateSheet(sheet) - nCols <- ncol(df) - nRows <- nrow(df) - df_nms <- names(df) - - allColClasses <- unlist(colClasses) - - isPOSIXlt <- function(data) sapply(lapply(data, class), FUN = function(x) any(x == "POSIXlt")) - to_convert <- isPOSIXlt(df) - - if (any(to_convert)) { - message("Found POSIXlt. Converting to POSIXct") - df[to_convert] <- lapply(df[to_convert], as.POSIXct) - } - - - df <- as.list(df) - - ###################################################################### - ## standardise all column types - - ## pull out NaN values - nans <- unlist(lapply(1:nCols, function(i) { - tmp <- df[[i]] - if (!"character" %in% class(tmp) & !"list" %in% class(tmp)) { - v <- which(is.nan(tmp) | is.infinite(tmp)) - if (length(v) == 0) { - return(v) - } - return(as.integer(nCols * (v - 1) + i)) ## row position - } - })) - - ## convert any Dates to integers and create date style object - if (any(c("date", "posixct", "posixt") %in% allColClasses)) { - dInds <- which(sapply(colClasses, function(x) "date" %in% x)) - - origin <- 25569L - if (grepl('date1904="1"|date1904="true"', stri_join(unlist(workbook), collapse = ""), ignore.case = TRUE)) { - origin <- 24107L - } - - for (i in dInds) { - df[[i]] <- as.integer(df[[i]]) + origin - if (origin == 25569L){ - earlyDate <- which(df[[i]] < 60) - df[[i]][earlyDate] <- df[[i]][earlyDate] - 1 - } - } - - pInds <- which(sapply(colClasses, function(x) any(c("posixct", "posixt", "posixlt") %in% x))) - if (length(pInds) > 0 & nRows > 0) { - parseOffset <- function(tz) { - suppressWarnings( - ifelse(stri_sub(tz, 1, 1) == "+", 1L, -1L) - * (as.integer(stri_sub(tz, 2, 3)) + as.integer(stri_sub(tz, 4, 5)) / 60) / 24 - ) - } - - t <- lapply(df[pInds], function(x) format(x, "%z")) - offSet <- lapply(t, parseOffset) - offSet <- lapply(offSet, function(x) ifelse(is.na(x), 0, x)) - - for (i in seq_along(pInds)) { - df[[pInds[i]]] <- as.numeric(as.POSIXct(df[[pInds[i]]])) / 86400 + origin + offSet[[i]] - } - } - } - - ## convert any Dates to integers and create date style object - if (any(c("currency", "accounting", "percentage", "3", "comma") %in% allColClasses)) { - cInds <- which(sapply(colClasses, function(x) any(c("accounting", "currency", "percentage", "3", "comma") %in% tolower(x)))) - for (i in cInds) { - df[[i]] <- as.numeric(gsub("[^0-9\\.-]", "", df[[i]], perl = TRUE)) - } - class(df[[i]]) <- "numeric" - } - - ## convert scientific - if ("scientific" %in% allColClasses) { - for (i in which(sapply(colClasses, function(x) "scientific" %in% x))) { - class(df[[i]]) <- "numeric" - } - } - - ## - if ("list" %in% allColClasses) { - for (i in which(sapply(colClasses, function(x) "list" %in% x))) { - df[[i]] <- sapply(lapply(df[[i]], unlist), stri_join, collapse = list_sep) - } - } - - if (any(c("formula", "array_formula") %in% allColClasses)) { - - frm <- "formula" - cls <- "openxlsx_formula" - - if ("array_formula" %in% allColClasses) { - frm <- "array_formula" - cls <- "openxlsx_array_formula" - } - - for (i in which(sapply(colClasses, function(x) frm %in% x))) { - df[[i]] <- replaceIllegalCharacters(as.character(df[[i]])) - class(df[[i]]) <- cls - } - } - - if ("hyperlink" %in% allColClasses) { - for (i in which(sapply(colClasses, function(x) "hyperlink" %in% x))) { - class(df[[i]]) <- "hyperlink" - } - } - - colClasses <- sapply(df, function(x) tolower(class(x))[[1]]) ## by here all cols must have a single class only - - - ## convert logicals (Excel stores logicals as 0 & 1) - if ("logical" %in% allColClasses) { - for (i in which(sapply(colClasses, function(x) "logical" %in% x))) { - class(df[[i]]) <- "numeric" - } - } - - ## convert all numerics to character (this way preserves digits) - if ("numeric" %in% colClasses) { - for (i in which(sapply(colClasses, function(x) "numeric" %in% x))) { - class(df[[i]]) <- "character" - } - } - - ## End standardise all column types - ###################################################################### - - - ## cell types - t <- build_cell_types_integer(classes = colClasses, n_rows = nRows) - - for (i in which(sapply(colClasses, function(x) !"character" %in% x & !"numeric" %in% x))) { - df[[i]] <- as.character(df[[i]]) - } - - ## cell values - v <- as.character(t(as.matrix( - data.frame(df, stringsAsFactors = FALSE, check.names = FALSE, fix.empty.names = FALSE) - ))) - - - if (keepNA) { - if (is.null(na.string)) { - t[is.na(v)] <- 4L - v[is.na(v)] <- "#N/A" - } else { - t[is.na(v)] <- 1L - v[is.na(v)] <- as.character(na.string) - } - } else { - t[is.na(v)] <- as.integer(NA) - v[is.na(v)] <- as.character(NA) - } - - ## If any NaN values - if (length(nans) > 0) { - t[nans] <- 4L - v[nans] <- "#NUM!" - } - - - # prepend column headers - if (colNames) { - t <- c(rep.int(1L, nCols), t) - v <- c(df_nms, v) - nRows <- nRows + 1L - } - - - ## Formulas - f_in <- rep.int(as.character(NA), length(t)) - any_functions <- FALSE - ref_cell <- paste0(int_2_cell_ref(startCol), startRow) - - if (any(c("openxlsx_formula", "openxlsx_array_formula") %in% colClasses)) { - - ## alter the elements of t where we have a formula to be "str" - if ("openxlsx_formula" %in% colClasses) { - formula_cols <- which(sapply(colClasses, function(x) "openxlsx_formula" %in% x, USE.NAMES = FALSE), useNames = FALSE) - formula_strs <- stri_join("", unlist(df[formula_cols], use.names = FALSE), "") - } else { # openxlsx_array_formula - formula_cols <- which(sapply(colClasses, function(x) "openxlsx_array_formula" %in% x, USE.NAMES = FALSE), useNames = FALSE) - formula_strs <- stri_join("", unlist(df[formula_cols], use.names = FALSE), "") - } - formula_inds <- unlist(lapply(formula_cols, function(i) i + (1:(nRows - colNames) - 1) * nCols + (colNames * nCols)), use.names = FALSE) - f_in[formula_inds] <- formula_strs - any_functions <- TRUE - - rm(formula_cols) - rm(formula_strs) - rm(formula_inds) - } - - suppressWarnings(try(rm(df), silent = TRUE)) - - ## Append hyperlinks, convert h to s in cell type - hyperlink_cols <- which(sapply(colClasses, function(x) "hyperlink" %in% x, USE.NAMES = FALSE), useNames = FALSE) - if (length(hyperlink_cols) > 0) { - hyperlink_inds <- sort(unlist(lapply(hyperlink_cols, function(i) i + (1:(nRows - colNames) - 1) * nCols + (colNames * nCols)), use.names = FALSE)) - na_hyperlink <- intersect(hyperlink_inds, which(is.na(t))) - - if (length(hyperlink_inds) > 0) { - t[t %in% 9] <- 1L ## set cell type to "s" - - hyperlink_refs <- convert_to_excel_ref_expand(cols = hyperlink_cols + startCol - 1, LETTERS = LETTERS, rows = as.character((startRow + colNames):(startRow + nRows - 1L))) - - if (length(na_hyperlink) > 0) { - to_remove <- which(hyperlink_inds %in% na_hyperlink) - hyperlink_refs <- hyperlink_refs[-to_remove] - hyperlink_inds <- hyperlink_inds[-to_remove] - } - - exHlinks <- worksheets[[sheet]]$hyperlinks - targets <- replaceIllegalCharacters(v[hyperlink_inds]) - - if (!is.null(hlinkNames) & length(hlinkNames) == length(hyperlink_inds)) { - v[hyperlink_inds] <- hlinkNames - } ## this is text to display instead of hyperlink - - ## create hyperlink objects - newhl <- lapply(seq_along(hyperlink_inds), function(i) { - Hyperlink$new(ref = hyperlink_refs[i], target = targets[i], location = NULL, display = NULL, is_external = TRUE) - }) - - worksheets[[sheet]]$hyperlinks <<- append(worksheets[[sheet]]$hyperlinks, newhl) - } - } - - - ## convert all strings to references in sharedStrings and update values (v) - strFlag <- which(t == 1L) - newStrs <- v[strFlag] - if (length(newStrs) > 0) { - newStrs <- replaceIllegalCharacters(newStrs) - vl <- stri_length(newStrs) - - for (i in which(vl > 32767)) { - - if(vl[i]>32768+30){ - warning( - paste0( - stri_sub(newStrs[i], 32768, 32768 + 15), - " ... " , - stri_sub(newStrs[i], vl[i] - 15, vl[i]), - " is truncated. -Number of characters exeed the limit of 32767." - ) - ) - } else { - warning( - paste0( - stri_sub(newStrs[i], 32768, -1), - " is truncated. -Number of characters exeed the limit of 32767." - ) - ) - - } - - # v[i] <- stri_sub(v[i], 1, 32767) - } - newStrs <- stri_join("", newStrs, "") - - uNewStr <- unique(newStrs) - - .self$updateSharedStrings(uNewStr) - v[strFlag] <- match(newStrs, sharedStrings) - 1L - } - - # ## Create cell list of lists - worksheets[[sheet]]$sheet_data$write( - rows_in = startRow:(startRow + nRows - 1L), - cols_in = startCol:(startCol + nCols - 1L), - t_in = t, - v_in = v, - f_in = f_in, - any_functions = any_functions - ) - - invisible(0) -}) + +#' @include class_definitions.R +Workbook$methods(writeData = function( + df, + sheet, + startRow, + startCol, + colNames, + colClasses, + hlinkNames, + keepNA, + na.string, + list_sep +) { + sheet <- validateSheet(sheet) + nCols <- ncol(df) + nRows <- nrow(df) + df_nms <- names(df) + + allColClasses <- unlist(colClasses) + + isPOSIXlt <- function(data) sapply(lapply(data, class), FUN = function(x) any(x == "POSIXlt")) + to_convert <- isPOSIXlt(df) + + if (any(to_convert)) { + message("Found POSIXlt. Converting to POSIXct") + df[to_convert] <- lapply(df[to_convert], as.POSIXct) + } + + + df <- as.list(df) + + ###################################################################### + ## standardise all column types + + ## pull out NaN values + nans <- unlist(lapply(1:nCols, function(i) { + tmp <- df[[i]] + if (!"character" %in% class(tmp) & !"list" %in% class(tmp)) { + v <- which(is.nan(tmp) | is.infinite(tmp)) + if (length(v) == 0) { + return(v) + } + return(as.integer(nCols * (v - 1) + i)) ## row position + } + })) + + ## convert any Dates to integers and create date style object + if (any(c("date", "posixct", "posixt") %in% allColClasses)) { + dInds <- which(sapply(colClasses, function(x) "date" %in% x)) + + origin <- 25569L + if (grepl('date1904="1"|date1904="true"', stri_join(unlist(workbook), collapse = ""), ignore.case = TRUE)) { + origin <- 24107L + } + + for (i in dInds) { + df[[i]] <- as.integer(df[[i]]) + origin + if (origin == 25569L){ + earlyDate <- which(df[[i]] < 60) + df[[i]][earlyDate] <- df[[i]][earlyDate] - 1 + } + } + + pInds <- which(sapply(colClasses, function(x) any(c("posixct", "posixt", "posixlt") %in% x))) + if (length(pInds) > 0 & nRows > 0) { + parseOffset <- function(tz) { + suppressWarnings( + ifelse(stri_sub(tz, 1, 1) == "+", 1L, -1L) + * (as.integer(stri_sub(tz, 2, 3)) + as.integer(stri_sub(tz, 4, 5)) / 60) / 24 + ) + } + + t <- lapply(df[pInds], function(x) format(x, "%z")) + offSet <- lapply(t, parseOffset) + offSet <- lapply(offSet, function(x) ifelse(is.na(x), 0, x)) + + for (i in seq_along(pInds)) { + df[[pInds[i]]] <- as.numeric(as.POSIXct(df[[pInds[i]]])) / 86400 + origin + offSet[[i]] + } + } + } + + ## convert any Dates to integers and create date style object + if (any(c("currency", "accounting", "percentage", "3", "comma") %in% allColClasses)) { + cInds <- which(sapply(colClasses, function(x) any(c("accounting", "currency", "percentage", "3", "comma") %in% tolower(x)))) + for (i in cInds) { + df[[i]] <- as.numeric(gsub("[^0-9\\.-]", "", df[[i]], perl = TRUE)) + } + class(df[[i]]) <- "numeric" + } + + ## convert scientific + if ("scientific" %in% allColClasses) { + for (i in which(sapply(colClasses, function(x) "scientific" %in% x))) { + class(df[[i]]) <- "numeric" + } + } + + ## + if ("list" %in% allColClasses) { + for (i in which(sapply(colClasses, function(x) "list" %in% x))) { + # check for and replace NA + df_i <- lapply(df[[i]], unlist) + df_i <- lapply(df_i, function(x) { + x[is.na(x)] <- na.string + x + }) + df[[i]] <- sapply(df_i, stri_join, collapse = list_sep) + } + } + + if ("hyperlink" %in% allColClasses) { + for (i in which(sapply(colClasses, function(x) "hyperlink" %in% x))) { + class(df[[i]]) <- "hyperlink" + } + } + + if (any(c("formula", "array_formula") %in% allColClasses)) { + + frm <- "formula" + cls <- "openxlsx_formula" + + if ("array_formula" %in% allColClasses) { + frm <- "array_formula" + cls <- "openxlsx_array_formula" + } + + for (i in which(sapply(colClasses, function(x) frm %in% x))) { + df[[i]] <- replaceIllegalCharacters(as.character(df[[i]])) + class(df[[i]]) <- cls + } + } + + colClasses <- sapply(df, function(x) tolower(class(x))[[1]]) ## by here all cols must have a single class only + + + ## convert logicals (Excel stores logicals as 0 & 1) + if ("logical" %in% allColClasses) { + for (i in which(sapply(colClasses, function(x) "logical" %in% x))) { + class(df[[i]]) <- "numeric" + } + } + + ## convert all numerics to character (this way preserves digits) + if ("numeric" %in% colClasses) { + for (i in which(sapply(colClasses, function(x) "numeric" %in% x))) { + class(df[[i]]) <- "character" + } + } + + ## End standardise all column types + ###################################################################### + + + ## cell types + t <- build_cell_types_integer(classes = colClasses, n_rows = nRows) + + for (i in which(sapply(colClasses, function(x) !"character" %in% x & !"numeric" %in% x))) { + df[[i]] <- as.character(df[[i]]) + } + + ## cell values + v <- as.character(t(as.matrix( + data.frame(df, stringsAsFactors = FALSE, check.names = FALSE, fix.empty.names = FALSE) + ))) + + + if (keepNA) { + if (is.null(na.string)) { + t[is.na(v)] <- 4L + v[is.na(v)] <- "#N/A" + } else { + t[is.na(v)] <- 1L + v[is.na(v)] <- as.character(na.string) + } + } else { + t[is.na(v)] <- as.integer(NA) + v[is.na(v)] <- as.character(NA) + } + + ## If any NaN values + if (length(nans) > 0) { + t[nans] <- 4L + v[nans] <- "#NUM!" + } + + + # prepend column headers + if (colNames) { + t <- c(rep.int(1L, nCols), t) + v <- c(df_nms, v) + nRows <- nRows + 1L + } + + + ## Formulas + f_in <- rep.int(as.character(NA), length(t)) + any_functions <- FALSE + ref_cell <- paste0(int_2_cell_ref(startCol), startRow) + + if (any(c("openxlsx_formula", "openxlsx_array_formula") %in% colClasses)) { + + ## alter the elements of t where we have a formula to be "str" + if ("openxlsx_formula" %in% colClasses) { + formula_cols <- which(sapply(colClasses, function(x) "openxlsx_formula" %in% x, USE.NAMES = FALSE), useNames = FALSE) + formula_strs <- stri_join("", unlist(df[formula_cols], use.names = FALSE), "") + } else { # openxlsx_array_formula + formula_cols <- which(sapply(colClasses, function(x) "openxlsx_array_formula" %in% x, USE.NAMES = FALSE), useNames = FALSE) + formula_strs <- stri_join("", unlist(df[formula_cols], use.names = FALSE), "") + } + formula_inds <- unlist(lapply(formula_cols, function(i) i + (1:(nRows - colNames) - 1) * nCols + (colNames * nCols)), use.names = FALSE) + f_in[formula_inds] <- formula_strs + any_functions <- TRUE + + rm(formula_cols) + rm(formula_strs) + rm(formula_inds) + } + + suppressWarnings(try(rm(df), silent = TRUE)) + + ## Append hyperlinks, convert h to s in cell type + hyperlink_cols <- which(sapply(colClasses, function(x) "hyperlink" %in% x, USE.NAMES = FALSE), useNames = FALSE) + if (length(hyperlink_cols) > 0) { + hyperlink_inds <- sort(unlist(lapply(hyperlink_cols, function(i) i + (1:(nRows - colNames) - 1) * nCols + (colNames * nCols)), use.names = FALSE)) + na_hyperlink <- intersect(hyperlink_inds, which(is.na(t))) + + if (length(hyperlink_inds) > 0) { + t[t %in% 9] <- 1L ## set cell type to "s" + + hyperlink_refs <- convert_to_excel_ref_expand(cols = hyperlink_cols + startCol - 1, LETTERS = LETTERS, rows = as.character((startRow + colNames):(startRow + nRows - 1L))) + + if (length(na_hyperlink) > 0) { + to_remove <- which(hyperlink_inds %in% na_hyperlink) + hyperlink_refs <- hyperlink_refs[-to_remove] + hyperlink_inds <- hyperlink_inds[-to_remove] + } + + exHlinks <- worksheets[[sheet]]$hyperlinks + targets <- replaceIllegalCharacters(v[hyperlink_inds]) + + if (!is.null(hlinkNames) & length(hlinkNames) == length(hyperlink_inds)) { + v[hyperlink_inds] <- hlinkNames + } ## this is text to display instead of hyperlink + + ## create hyperlink objects + newhl <- lapply(seq_along(hyperlink_inds), function(i) { + Hyperlink$new(ref = hyperlink_refs[i], target = targets[i], location = NULL, display = NULL, is_external = TRUE) + }) + + worksheets[[sheet]]$hyperlinks <<- append(worksheets[[sheet]]$hyperlinks, newhl) + } + } + + + ## convert all strings to references in sharedStrings and update values (v) + strFlag <- which(t == 1L) + newStrs <- v[strFlag] + if (length(newStrs) > 0) { + newStrs <- replaceIllegalCharacters(newStrs) + vl <- stri_length(newStrs) + + for (i in which(vl > 32767)) { + + if(vl[i]>32768+30){ + warning( + paste0( + stri_sub(newStrs[i], 32768, 32768 + 15), + " ... " , + stri_sub(newStrs[i], vl[i] - 15, vl[i]), + " is truncated. +Number of characters exeed the limit of 32767." + ) + ) + } else { + warning( + paste0( + stri_sub(newStrs[i], 32768, -1), + " is truncated. +Number of characters exeed the limit of 32767." + ) + ) + + } + + # v[i] <- stri_sub(v[i], 1, 32767) + } + newStrs <- stri_join("", newStrs, "") + + uNewStr <- unique(newStrs) + + .self$updateSharedStrings(uNewStr) + v[strFlag] <- match(newStrs, sharedStrings) - 1L + } + + # ## Create cell list of lists + worksheets[[sheet]]$sheet_data$write( + rows_in = startRow:(startRow + nRows - 1L), + cols_in = startCol:(startCol + nCols - 1L), + t_in = t, + v_in = v, + f_in = f_in, + any_functions = any_functions + ) + + invisible(0) +}) diff -Nru r-cran-openxlsx-4.2.4/R/worksheet_class.R r-cran-openxlsx-4.2.5/R/worksheet_class.R --- r-cran-openxlsx-4.2.4/R/worksheet_class.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/worksheet_class.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,276 +1,276 @@ - -#' @include class_definitions.R - - -WorkSheet$methods(initialize = function( - showGridLines = TRUE, - tabSelected = FALSE, - tabColour = NULL, - zoom = 100, - - oddHeader = NULL, - oddFooter = NULL, - evenHeader = NULL, - evenFooter = NULL, - firstHeader = NULL, - firstFooter = NULL, - - paperSize = 9, - orientation = "portrait", - hdpi = 300, - vdpi = 300 - ) { - if (!is.null(tabColour)) { - tabColour <- sprintf('', tabColour) - } else { - tabColour <- character(0) - } - - if (zoom < 10) { - zoom <- 10 - } else if (zoom > 400) { - zoom <- 400 - } - - naToNULLList <- function(x) { - lapply(x, function(x) { - if (is.na(x)) { - return(NULL) - } - x - }) - } - - # hf <- list( - # oddHeader = naToNULLList(oddHeader), - # oddFooter = naToNULLList(oddFooter), - # evenHeader = naToNULLList(evenHeader), - # evenFooter = naToNULLList(evenFooter), - # firstHeader = naToNULLList(firstHeader), - # firstFooter = naToNULLList(firstFooter) - # ) - - hf <- list( - oddHeader = oddHeader, - oddFooter = oddFooter, - evenHeader = evenHeader, - evenFooter = evenFooter, - firstHeader = firstHeader, - firstFooter = firstFooter - ) - - if (all(vapply(hf, is.null, NA))) { - hf <- list() - } - - ## list of all possible children - sheetPr <<- tabColour - dimension <<- '' - sheetViews <<- sprintf('', as.integer(zoom), as.integer(showGridLines), as.integer(tabSelected)) - sheetFormatPr <<- '' - cols <<- character(0) - - autoFilter <<- character(0) - mergeCells <<- character(0) - conditionalFormatting <<- character(0) - dataValidations <<- NULL - dataValidationsLst <<- character(0) - hyperlinks <<- list() - pageMargins <<- '' - pageSetup <<- sprintf('', paperSize, orientation, hdpi, vdpi) ## will always be 2 - headerFooter <<- hf - rowBreaks <<- character(0) - colBreaks <<- character(0) - drawing <<- '' ## will always be 1 - legacyDrawing <<- character(0) - legacyDrawingHF <<- character(0) - oleObjects <<- character(0) - tableParts <<- character(0) - extLst <<- character(0) - - freezePane <<- character(0) - - sheet_data <<- Sheet_Data$new() -}) - - - -WorkSheet$methods(get_prior_sheet_data = function() { - xml <- '' - - if (length(sheetPr) > 0) { - tmp <- sheetPr - if (!any(grepl("", tmp, fixed = TRUE))) { - tmp <- paste0("", paste(tmp, collapse = ""), "") - } - - xml <- paste(xml, tmp, collapse = "") - } - - if (length(dimension) > 0) { - xml <- paste(xml, dimension, collapse = "") - } - - ## sheetViews handled here - if (length(freezePane) > 0) { - xml <- paste(xml, gsub("/>", paste0(">", freezePane, ""), sheetViews, fixed = TRUE), collapse = "") - } else if (length(sheetViews) > 0) { - xml <- paste(xml, sheetViews, collapse = "") - } - - if (length(sheetFormatPr) > 0) { - xml <- paste(xml, sheetFormatPr, collapse = "") - } - - if (length(cols) > 0) { - xml <- paste(xml, pxml(c("", cols, "")), collapse = "") - } - - - return(xml) -}) - - -WorkSheet$methods(get_post_sheet_data = function() { - xml <- "" - - if (length(sheetProtection) > 0) { - xml <- paste0(xml, sheetProtection, collapse = "") - } - - if (length(autoFilter) > 0) { - xml <- paste0(xml, autoFilter, collapse = "") - } - - if (length(mergeCells) > 0) { - xml <- paste0(xml, paste0(sprintf('', length(mergeCells)), pxml(mergeCells), ""), collapse = "") - } - - if (length(conditionalFormatting) > 0) { - nms <- names(conditionalFormatting) - xml <- paste0(xml, - paste( - sapply(unique(nms), function(x) { - paste0( - sprintf('', x), - pxml(conditionalFormatting[nms == x]), - "" - ) - }), - collapse = "" - ), - collapse = "" - ) - } - - - if (length(dataValidations) > 0) { - xml <- paste0(xml, paste0(sprintf('', length(dataValidations)), pxml(dataValidations), "")) - } - - if (length(hyperlinks) > 0) { - h_inds <- paste0(seq_along(hyperlinks), "h") - xml <- paste(xml, paste("", paste(sapply(seq_along(h_inds), function(i) hyperlinks[[i]]$to_xml(h_inds[i])), collapse = ""), ""), collapse = "") - } - - if (length(pageMargins) > 0) { - xml <- paste0(xml, pageMargins, collapse = "") - } - - if (length(pageSetup) > 0) { - xml <- paste0(xml, pageSetup, collapse = "") - } - - if (!identical(headerFooter, list()) && length(headerFooter) > 0) { - xml <- paste0(xml, genHeaderFooterNode(headerFooter), collapse = "") - } - - ## rowBreaks and colBreaks - if (length(rowBreaks) > 0) { - xml <- paste0(xml, - paste0(sprintf('', length(rowBreaks), length(rowBreaks)), paste(rowBreaks, collapse = ""), ""), - collapse = "" - ) - } - - if (length(colBreaks) > 0) { - xml <- paste0(xml, - paste0(sprintf('', length(colBreaks), length(colBreaks)), paste(colBreaks, collapse = ""), ""), - collapse = "" - ) - } - - if (length(drawing) > 0) { - xml <- paste0(xml, drawing, collapse = "") - } - - if (length(legacyDrawing) > 0) { - xml <- paste0(xml, legacyDrawing, collapse = "") - } - - if (length(legacyDrawingHF) > 0) { - xml <- paste0(xml, legacyDrawingHF, collapse = "") - } - - if (length(oleObjects) > 0) { - xml <- paste0(xml, oleObjects, collapse = "") - } - - if (length(tableParts) > 0) { - xml <- paste0(xml, - paste0(sprintf('', length(tableParts)), pxml(tableParts), ""), - collapse = "" - ) - } - - - if (length(dataValidationsLst) > 0) { - dataValidationsLst_xml <- paste0(sprintf('', length(dataValidationsLst)), - paste0(pxml(dataValidationsLst), ""), - collapse = "" - ) - } else { - dataValidationsLst_xml <- character(0) - } - - - if (length(extLst) > 0 || length(dataValidationsLst) > 0) { - xml <- paste0(xml, sprintf("%s", paste0(pxml(extLst), dataValidationsLst_xml))) - } - - xml <- paste0(xml, "") - - return(xml) -}) - - -WorkSheet$methods(order_sheetdata = function() { - if (sheet_data$n_elements == 0) { - return(invisible(0)) - } - - if (sheet_data$data_count > 1) { - ord <- order(sheet_data$rows, sheet_data$cols, method = "radix", na.last = TRUE) - sheet_data$rows <<- sheet_data$rows[ord] - sheet_data$cols <<- sheet_data$cols[ord] - sheet_data$t <<- sheet_data$t[ord] - sheet_data$v <<- sheet_data$v[ord] - sheet_data$f <<- sheet_data$f[ord] - - sheet_data$style_id <<- sheet_data$style_id[ord] - - sheet_data$data_count <<- 1L - - dm1 <- paste0(int_2_cell_ref(cols = sheet_data$cols[1]), sheet_data$rows[1]) - dm2 <- paste0(int_2_cell_ref(cols = sheet_data$cols[sheet_data$n_elements]), sheet_data$rows[sheet_data$n_elements]) - - if (length(dm1) == 1 & length(dm2) != 1) { - if (!is.na(dm1) & !is.na(dm2) & dm1 != "NA" & dm2 != "NA") { - dimension <<- sprintf("", dm1, dm2) - } - } - } - - - invisible(0) -}) + +#' @include class_definitions.R + + +WorkSheet$methods(initialize = function( + showGridLines = TRUE, + tabSelected = FALSE, + tabColour = NULL, + zoom = 100, + + oddHeader = NULL, + oddFooter = NULL, + evenHeader = NULL, + evenFooter = NULL, + firstHeader = NULL, + firstFooter = NULL, + + paperSize = 9, + orientation = "portrait", + hdpi = 300, + vdpi = 300 + ) { + if (!is.null(tabColour)) { + tabColour <- sprintf('', tabColour) + } else { + tabColour <- character(0) + } + + if (zoom < 10) { + zoom <- 10 + } else if (zoom > 400) { + zoom <- 400 + } + + naToNULLList <- function(x) { + lapply(x, function(x) { + if (is.na(x)) { + return(NULL) + } + x + }) + } + + # hf <- list( + # oddHeader = naToNULLList(oddHeader), + # oddFooter = naToNULLList(oddFooter), + # evenHeader = naToNULLList(evenHeader), + # evenFooter = naToNULLList(evenFooter), + # firstHeader = naToNULLList(firstHeader), + # firstFooter = naToNULLList(firstFooter) + # ) + + hf <- list( + oddHeader = oddHeader, + oddFooter = oddFooter, + evenHeader = evenHeader, + evenFooter = evenFooter, + firstHeader = firstHeader, + firstFooter = firstFooter + ) + + if (all(vapply(hf, is.null, NA))) { + hf <- list() + } + + ## list of all possible children + sheetPr <<- tabColour + dimension <<- '' + sheetViews <<- sprintf('', as.integer(zoom), as.integer(showGridLines), as.integer(tabSelected)) + sheetFormatPr <<- '' + cols <<- character(0) + + autoFilter <<- character(0) + mergeCells <<- character(0) + conditionalFormatting <<- character(0) + dataValidations <<- NULL + dataValidationsLst <<- character(0) + hyperlinks <<- list() + pageMargins <<- '' + pageSetup <<- sprintf('', paperSize, orientation, hdpi, vdpi) ## will always be 2 + headerFooter <<- hf + rowBreaks <<- character(0) + colBreaks <<- character(0) + drawing <<- '' ## will always be 1 + legacyDrawing <<- character(0) + legacyDrawingHF <<- character(0) + oleObjects <<- character(0) + tableParts <<- character(0) + extLst <<- character(0) + + freezePane <<- character(0) + + sheet_data <<- Sheet_Data$new() +}) + + + +WorkSheet$methods(get_prior_sheet_data = function() { + xml <- '' + + if (length(sheetPr) > 0) { + tmp <- sheetPr + if (!any(grepl("", tmp, fixed = TRUE))) { + tmp <- paste0("", paste(tmp, collapse = ""), "") + } + + xml <- paste(xml, tmp, collapse = "") + } + + if (length(dimension) > 0) { + xml <- paste(xml, dimension, collapse = "") + } + + ## sheetViews handled here + if (length(freezePane) > 0) { + xml <- paste(xml, gsub("/>", paste0(">", freezePane, ""), sheetViews, fixed = TRUE), collapse = "") + } else if (length(sheetViews) > 0) { + xml <- paste(xml, sheetViews, collapse = "") + } + + if (length(sheetFormatPr) > 0) { + xml <- paste(xml, sheetFormatPr, collapse = "") + } + + if (length(cols) > 0) { + xml <- paste(xml, pxml(c("", cols, "")), collapse = "") + } + + + return(xml) +}) + + +WorkSheet$methods(get_post_sheet_data = function() { + xml <- "" + + if (length(sheetProtection) > 0) { + xml <- paste0(xml, sheetProtection, collapse = "") + } + + if (length(autoFilter) > 0) { + xml <- paste0(xml, autoFilter, collapse = "") + } + + if (length(mergeCells) > 0) { + xml <- paste0(xml, paste0(sprintf('', length(mergeCells)), pxml(mergeCells), ""), collapse = "") + } + + if (length(conditionalFormatting) > 0) { + nms <- names(conditionalFormatting) + xml <- paste0(xml, + paste( + sapply(unique(nms), function(x) { + paste0( + sprintf('', x), + pxml(conditionalFormatting[nms == x]), + "" + ) + }), + collapse = "" + ), + collapse = "" + ) + } + + + if (length(dataValidations) > 0) { + xml <- paste0(xml, paste0(sprintf('', length(dataValidations)), pxml(dataValidations), "")) + } + + if (length(hyperlinks) > 0) { + h_inds <- paste0(seq_along(hyperlinks), "h") + xml <- paste(xml, paste("", paste(sapply(seq_along(h_inds), function(i) hyperlinks[[i]]$to_xml(h_inds[i])), collapse = ""), ""), collapse = "") + } + + if (length(pageMargins) > 0) { + xml <- paste0(xml, pageMargins, collapse = "") + } + + if (length(pageSetup) > 0) { + xml <- paste0(xml, pageSetup, collapse = "") + } + + if (!identical(headerFooter, list()) && length(headerFooter) > 0) { + xml <- paste0(xml, genHeaderFooterNode(headerFooter), collapse = "") + } + + ## rowBreaks and colBreaks + if (length(rowBreaks) > 0) { + xml <- paste0(xml, + paste0(sprintf('', length(rowBreaks), length(rowBreaks)), paste(rowBreaks, collapse = ""), ""), + collapse = "" + ) + } + + if (length(colBreaks) > 0) { + xml <- paste0(xml, + paste0(sprintf('', length(colBreaks), length(colBreaks)), paste(colBreaks, collapse = ""), ""), + collapse = "" + ) + } + + if (length(drawing) > 0) { + xml <- paste0(xml, drawing, collapse = "") + } + + if (length(legacyDrawing) > 0) { + xml <- paste0(xml, legacyDrawing, collapse = "") + } + + if (length(legacyDrawingHF) > 0) { + xml <- paste0(xml, legacyDrawingHF, collapse = "") + } + + if (length(oleObjects) > 0) { + xml <- paste0(xml, oleObjects, collapse = "") + } + + if (length(tableParts) > 0) { + xml <- paste0(xml, + paste0(sprintf('', length(tableParts)), pxml(tableParts), ""), + collapse = "" + ) + } + + + if (length(dataValidationsLst) > 0) { + dataValidationsLst_xml <- paste0(sprintf('', length(dataValidationsLst)), + paste0(pxml(dataValidationsLst), ""), + collapse = "" + ) + } else { + dataValidationsLst_xml <- character(0) + } + + + if (length(extLst) > 0 || length(dataValidationsLst) > 0) { + xml <- paste0(xml, sprintf("%s", paste0(pxml(extLst), dataValidationsLst_xml))) + } + + xml <- paste0(xml, "") + + return(xml) +}) + + +WorkSheet$methods(order_sheetdata = function() { + if (sheet_data$n_elements == 0) { + return(invisible(0)) + } + + if (sheet_data$data_count > 1) { + ord <- order(sheet_data$rows, sheet_data$cols, method = "radix", na.last = TRUE) + sheet_data$rows <<- sheet_data$rows[ord] + sheet_data$cols <<- sheet_data$cols[ord] + sheet_data$t <<- sheet_data$t[ord] + sheet_data$v <<- sheet_data$v[ord] + sheet_data$f <<- sheet_data$f[ord] + + sheet_data$style_id <<- sheet_data$style_id[ord] + + sheet_data$data_count <<- 1L + + dm1 <- paste0(int_2_cell_ref(cols = sheet_data$cols[1]), sheet_data$rows[1]) + dm2 <- paste0(int_2_cell_ref(cols = sheet_data$cols[sheet_data$n_elements]), sheet_data$rows[sheet_data$n_elements]) + + if (length(dm1) == 1 & length(dm2) != 1) { + if (!is.na(dm1) & !is.na(dm2) & dm1 != "NA" & dm2 != "NA") { + dimension <<- sprintf("", dm1, dm2) + } + } + } + + + invisible(0) +}) diff -Nru r-cran-openxlsx-4.2.4/R/wrappers.R r-cran-openxlsx-4.2.5/R/wrappers.R --- r-cran-openxlsx-4.2.4/R/wrappers.R 2021-06-09 10:47:24.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/wrappers.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,4677 +1,4657 @@ - -#' @name createWorkbook -#' @title Create a new Workbook object -#' @description Create a new Workbook object -#' @param creator Creator of the workbook (your name). Defaults to login username -#' @param title Workbook properties title -#' @param subject Workbook properties subject -#' @param category Workbook properties category -#' @author Alexander Walker -#' @return Workbook object -#' @export -#' @seealso \code{\link{loadWorkbook}} -#' @seealso \code{\link{saveWorkbook}} -#' @import methods -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook() -#' -#' ## Save workbook to working directory -#' \dontrun{ -#' saveWorkbook(wb, file = "createWorkbookExample.xlsx", overwrite = TRUE) -#' } -#' -#' ## Set Workbook properties -#' wb <- createWorkbook( -#' creator = "Me", -#' title = "title here", -#' subject = "this & that", -#' category = "something" -#' ) -createWorkbook <- function(creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"), Sys.getenv("USER")), - title = NULL, - subject = NULL, - category = NULL) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - ## check all inputs are valid - if (length(creator) > 1) creator <- creator[[1]] - if (length(creator) == 0) creator <- "" - if (!"character" %in% class(creator)) creator <- "" - - if (length(title) > 1) title <- title[[1]] - if (length(subject) > 1) subject <- subject[[1]] - if (length(category) > 1) category <- category[[1]] - - if (!is.null(title)) { - if (!"character" %in% class(title)) { - stop("title must be a string") - } - } - - if (!is.null(subject)) { - if (!"character" %in% class(subject)) { - stop("subject must be a string") - } - } - - if (!is.null(category)) { - if (!"character" %in% class(category)) { - stop("category must be a string") - } - } - - invisible(Workbook$new(creator = creator, title = title, subject = subject, category = category)) -} - - -#' @name saveWorkbook -#' @title save Workbook to file -#' @description save a Workbook object to file -#' @author Alexander Walker, Philipp Schauberger -#' @param wb A Workbook object to write to file -#' @param file A character string naming an xlsx file -#' @param overwrite If \code{TRUE}, overwrite any existing file. -#' @param returnValue If \code{TRUE}, returns \code{TRUE} in case of a success, else \code{FALSE}. -#' If flag is \code{FALSE}, then no return value is returned. -#' @seealso \code{\link{createWorkbook}} -#' @seealso \code{\link{addWorksheet}} -#' @seealso \code{\link{loadWorkbook}} -#' @seealso \code{\link{writeData}} -#' @seealso \code{\link{writeDataTable}} -#' @export -#' @examples -#' ## Create a new workbook and add a worksheet -#' wb <- createWorkbook("Creator of workbook") -#' addWorksheet(wb, sheetName = "My first worksheet") -#' -#' ## Save workbook to working directory -#' \dontrun{ -#' saveWorkbook(wb, file = "saveWorkbookExample.xlsx", overwrite = TRUE) -#' } -saveWorkbook <- function(wb, file, overwrite = FALSE, returnValue = FALSE) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - ## increase scipen to avoid writing in scientific - sci_pen <- getOption("scipen") - options("scipen" = 10000) - on.exit(options("scipen" = sci_pen), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (!is.logical(overwrite)) { - overwrite <- FALSE - } - - if (!is.logical(returnValue)) { - returnValue <- FALSE - } - - if (file.exists(file) & !overwrite) { - stop("File already exists!") - } - - xlsx_file <- wb$saveWorkbook() - - result<-tryCatch(file.copy(from = xlsx_file, to = file, overwrite = overwrite), - error = function(e) e, warning = function(w) w) - - - - - ## delete temporary dir - unlink(dirname(xlsx_file), force = TRUE, recursive = TRUE) - if(returnValue == FALSE){ - invisible(1) - }else{ - return(result) - } - -} - - -#' @name mergeCells -#' @title Merge cells within a worksheet -#' @description Merge cells within a worksheet -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols Columns to merge -#' @param rows corresponding rows to merge -#' @details As merged region must be rectangular, only min and max of cols and rows are used. -#' @author Alexander Walker -#' @seealso \code{\link{removeCellMerge}} -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook() -#' -#' ## Add a worksheet -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2") -#' -#' ## Merge cells: Row 2 column C to F (3:6) -#' mergeCells(wb, "Sheet 1", cols = 2, rows = 3:6) -#' -#' ## Merge cells:Rows 10 to 20 columns A to J (1:10) -#' mergeCells(wb, 1, cols = 1:10, rows = 10:20) -#' -#' ## Intersecting merges -#' mergeCells(wb, 2, cols = 1:10, rows = 1) -#' mergeCells(wb, 2, cols = 5:10, rows = 2) -#' mergeCells(wb, 2, cols = c(1, 10), rows = 12) ## equivalent to 1:10 as only min/max are used -#' # mergeCells(wb, 2, cols = 1, rows = c(1,10)) # Throws error because intersects existing merge -#' -#' ## remove merged cells -#' removeCellMerge(wb, 2, cols = 1, rows = 1) # removes any intersecting merges -#' mergeCells(wb, 2, cols = 1, rows = 1:10) # Now this works -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "mergeCellsExample.xlsx", overwrite = TRUE) -#' } -mergeCells <- function(wb, sheet, cols, rows) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (!is.numeric(cols)) { - cols <- convertFromExcelRef(cols) - } - - wb$mergeCells(sheet, startRow = min(rows), endRow = max(rows), startCol = min(cols), endCol = max(cols)) -} - - - -#' @name int2col -#' @title Convert integer to Excel column -#' @description Converts an integer to an Excel column label. -#' @param x A numeric vector -#' @export -#' @examples -#' int2col(1:10) -int2col <- function(x) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!is.numeric(x)) { - stop("x must be numeric.") - } - - convert_to_excel_ref(cols = x, LETTERS = LETTERS) -} - - -#' @name removeCellMerge -#' @title Create a new Workbook object -#' @description Unmerges any merged cells that intersect -#' with the region specified by, min(cols):max(cols) X min(rows):max(rows) -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols vector of column indices -#' @param rows vector of row indices -#' @author Alexander Walker -#' @export -#' @seealso \code{\link{mergeCells}} -removeCellMerge <- function(wb, sheet, cols, rows) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - cols <- convertFromExcelRef(cols) - rows <- as.integer(rows) - - wb$removeCellMerge(sheet, startRow = min(rows), endRow = max(rows), startCol = min(cols), endCol = max(cols)) -} - - -#' @name sheets -#' @title Returns names of worksheets. -#' @description DEPRECATED. Use names(). -#' @param wb A workbook object -#' @return Name of worksheet(s) for a given index -#' @author Alexander Walker -#' @seealso \code{\link{names}} to rename a worksheet in a Workbook -#' @details DEPRECATED. Use \code{\link{names}} -#' @export -#' @examples -#' -#' ## Create a new workbook -#' wb <- createWorkbook() -#' -#' ## Add some worksheets -#' addWorksheet(wb, "Worksheet Name") -#' addWorksheet(wb, "This is worksheet 2") -#' addWorksheet(wb, "The third worksheet") -#' -#' ## Return names of sheets, can not be used for assignment. -#' names(wb) -#' # openXL(wb) -#' -#' names(wb) <- c("A", "B", "C") -#' names(wb) -#' # openXL(wb) -sheets <- function(wb) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - nms <- wb$sheet_names - nms <- replaceXMLEntities(nms) - - return(nms) -} - - - -#' @name addWorksheet -#' @title Add a worksheet to a workbook -#' @description Add a worksheet to a Workbook object -#' @author Alexander Walker -#' @param wb A Workbook object to attach the new worksheet -#' @param sheetName A name for the new worksheet -#' @param gridLines A logical. If \code{FALSE}, the worksheet grid lines will be hidden. -#' @param tabColour Colour of the worksheet tab. A valid colour (belonging to colours()) or a valid hex colour beginning with "#" -#' @param zoom A numeric between 10 and 400. Worksheet zoom level as a percentage. -#' @param header document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. -#' @param footer document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. -#' @param evenHeader document header for even pages. -#' @param evenFooter document footer for even pages. -#' @param firstHeader document header for first page only. -#' @param firstFooter document footer for first page only. -#' @param visible If FALSE, sheet is hidden else visible. -#' @param paperSize An integer corresponding to a paper size. See ?pageSetup for details. -#' @param orientation One of "portrait" or "landscape" -#' @param hdpi Horizontal DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.hdpi" = X) -#' @param vdpi Vertical DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.vdpi" = X) -#' @details Headers and footers can contain special tags -#' \itemize{ -#' \item{\bold{&[Page]}}{ Page number} -#' \item{\bold{&[Pages]}}{ Number of pages} -#' \item{\bold{&[Date]}}{ Current date} -#' \item{\bold{&[Time]}}{ Current time} -#' \item{\bold{&[Path]}}{ File path} -#' \item{\bold{&[File]}}{ File name} -#' \item{\bold{&[Tab]}}{ Worksheet name} -#' } -#' @return XML tree -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook("Fred") -#' -#' ## Add 3 worksheets -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2", gridLines = FALSE) -#' addWorksheet(wb, "Sheet 3", tabColour = "red") -#' addWorksheet(wb, "Sheet 4", gridLines = FALSE, tabColour = "#4F81BD") -#' -#' ## Headers and Footers -#' addWorksheet(wb, "Sheet 5", -#' header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), -#' footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), -#' evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), -#' evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), -#' firstHeader = c("TOP", "OF FIRST", "PAGE"), -#' firstFooter = c("BOTTOM", "OF FIRST", "PAGE") -#' ) -#' -#' addWorksheet(wb, "Sheet 6", -#' header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), -#' footer = c("&[Path]&[File]", NA, "&[Tab]"), -#' firstHeader = c(NA, "Center Header of First Page", NA), -#' firstFooter = c(NA, "Center Footer of First Page", NA) -#' ) -#' -#' addWorksheet(wb, "Sheet 7", -#' header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), -#' footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") -#' ) -#' -#' addWorksheet(wb, "Sheet 8", -#' firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), -#' firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") -#' ) -#' -#' ## Need data on worksheet to see all headers and footers -#' writeData(wb, sheet = 5, 1:400) -#' writeData(wb, sheet = 6, 1:400) -#' writeData(wb, sheet = 7, 1:400) -#' writeData(wb, sheet = 8, 1:400) -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "addWorksheetExample.xlsx", overwrite = TRUE) -#' } -addWorksheet <- function( - wb, - sheetName, - gridLines = openxlsx_getOp("gridLines", TRUE), - tabColour = NULL, - zoom = 100, - header = openxlsx_getOp("header"), - footer = openxlsx_getOp("footer"), - evenHeader = openxlsx_getOp("evenHeader"), - evenFooter = openxlsx_getOp("evenFooter"), - firstHeader = openxlsx_getOp("firstHeader"), - firstFooter = openxlsx_getOp("firstFooter"), - visible = TRUE, - paperSize = openxlsx_getOp("paperSize", 9), - orientation = openxlsx_getOp("orientation", "portrait"), - vdpi = openxlsx_getOp("vdpi", 300), - hdpi = openxlsx_getOp("hdpi", 300) -) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (inherits(wb, "list")) { - wb <- wb[[1]] - } - - if (!inherits(wb, "Workbook")) { - stop("wb must be a Workbok", call. = FALSE) - } - - # Set NULL defaults - gridLines <- gridLines %||% TRUE - paperSize <- paperSize %||% 9 - orientation <- orientation %||% "portrait" - vdpi <- vdpi %||% 300 - hdpi <- hdpi %||% 300 - - if (tolower(sheetName) %in% tolower(wb$sheet_names)) { - stop(paste0("A worksheet by the name '", sheetName, "' already exists! Sheet names must be unique case-insensitive.")) - } - - if (!is.logical(gridLines) | length(gridLines) > 1) { - stop("gridLines must be a logical of length 1.") - } - - if (nchar(sheetName) > 31) { - stop(paste0("sheetName '", sheetName, "' too long! Max length is 31 characters.")) - } - - if (!is.null(tabColour)) { - tabColour <- validateColour(tabColour, "Invalid tabColour in addWorksheet.") - } - - if (!is.numeric(zoom)) { - stop("zoom must be numeric") - } - - if (!is.character(sheetName)) { - sheetName <- as.character(sheetName) - } - - if (!is.null(header) & length(header) != 3) { - stop("header must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(footer) & length(footer) != 3) { - stop("footer must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(evenHeader) & length(evenHeader) != 3) { - stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(evenFooter) & length(evenFooter) != 3) { - stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(firstHeader) & length(firstHeader) != 3) { - stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(firstFooter) & length(firstFooter) != 3) { - stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.") - } - - visible <- tolower(visible[1]) - if (!visible %in% c("true", "false", "hidden", "visible", "veryhidden")) { - stop("visible must be one of: TRUE, FALSE, 'hidden', 'visible', 'veryHidden'") - } - - orientation <- tolower(orientation) - if (!orientation %in% c("portrait", "landscape")) { - stop("orientation must be 'portrait' or 'landscape'.") - } - - vdpi <- as.integer(vdpi) - if (is.na(vdpi)) { - stop("vdpi must be numeric") - } - - hdpi <- as.integer(hdpi) - if (is.na(hdpi)) { - stop("hdpi must be numeric") - } - - - - ## Invalid XML characters - sheetName <- replaceIllegalCharacters(sheetName) - - invisible(wb$addWorksheet( - sheetName = sheetName, - showGridLines = gridLines, - tabColour = tabColour, - zoom = zoom[1], - oddHeader = headerFooterSub(header), - oddFooter = headerFooterSub(footer), - evenHeader = headerFooterSub(evenHeader), - evenFooter = headerFooterSub(evenFooter), - firstHeader = headerFooterSub(firstHeader), - firstFooter = headerFooterSub(firstFooter), - visible = visible, - paperSize = paperSize, - orientation = orientation, - vdpi = vdpi, - hdpi = hdpi - )) -} - -#' @name cloneWorksheet -#' @title Clone a worksheet to a workbook -#' @description Clone a worksheet to a Workbook object -#' @author Reinhold Kainhofer -#' @param wb A Workbook object to attach the new worksheet -#' @param sheetName A name for the new worksheet -#' @param clonedSheet The name of the existing worksheet to be cloned. -#' @return XML tree -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook("Fred") -#' -#' ## Add 3 worksheets -#' addWorksheet(wb, "Sheet 1") -#' cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "cloneWorksheetExample.xlsx", overwrite = TRUE) -#' } -cloneWorksheet <- function(wb, sheetName, clonedSheet) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (tolower(sheetName) %in% tolower(wb$sheet_names)) { - stop("A worksheet by that name already exists! Sheet names must be unique case-insensitive.") - } - - if (nchar(sheetName) > 31) { - stop("sheetName too long! Max length is 31 characters.") - } - - if (!is.character(sheetName)) { - sheetName <- as.character(sheetName) - } - - ## Invalid XML characters - sheetName <- replaceIllegalCharacters(sheetName) - - invisible(wb$cloneWorksheet(sheetName = sheetName, clonedSheet = clonedSheet)) -} - - -#' @name renameWorksheet -#' @title Rename a worksheet -#' @description Rename a worksheet -#' @author Alexander Walker -#' @param wb A Workbook object containing a worksheet -#' @param sheet The name or index of the worksheet to rename -#' @param newName The new name of the worksheet. No longer than 31 chars. -#' @details DEPRECATED. Use \code{\link{names}} -#' @export -#' @examples -#' -#' ## Create a new workbook -#' wb <- createWorkbook("CREATOR") -#' -#' ## Add 3 worksheets -#' addWorksheet(wb, "Worksheet Name") -#' addWorksheet(wb, "This is worksheet 2") -#' addWorksheet(wb, "Not the best name") -#' -#' #' ## rename all worksheets -#' names(wb) <- c("A", "B", "C") -#' -#' -#' ## Rename worksheet 1 & 3 -#' renameWorksheet(wb, 1, "New name for sheet 1") -#' names(wb)[[1]] <- "New name for sheet 1" -#' names(wb)[[3]] <- "A better name" -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "renameWorksheetExample.xlsx", overwrite = TRUE) -#' } -renameWorksheet <- function(wb, sheet, newName) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - invisible(wb$setSheetName(sheet, newName)) -} - - -#' @name convertFromExcelRef -#' @title Convert excel column name to integer index -#' @description Convert excel column name to integer index e.g. "J" to 10 -#' @param col An excel column reference -#' @export -#' @examples -#' convertFromExcelRef("DOG") -#' convertFromExcelRef("COW") -#' -#' ## numbers will be removed -#' convertFromExcelRef("R22") -convertFromExcelRef <- function(col) { - - ## increase scipen to avoid writing in scientific - exSciPen <- getOption("scipen") - od <- getOption("OutDec") - options("scipen" = 10000) - options("OutDec" = ".") - - on.exit(options("scipen" = exSciPen), add = TRUE) - on.exit(expr = options("OutDec" = od), add = TRUE) - - col <- toupper(col) - charFlag <- grepl("[A-Z]", col) - if (any(charFlag)) { - col[charFlag] <- gsub("[0-9]", "", col[charFlag]) - d <- lapply(strsplit(col[charFlag], split = ""), function(x) match(rev(x), LETTERS)) - col[charFlag] <- unlist(lapply(seq_along(d), function(i) sum(d[[i]] * (26^( - seq_along(d[[i]]) - 1))))) - } - - col[!charFlag] <- as.integer(col[!charFlag]) - - return(as.integer(col)) -} - - - -#' @name createStyle -#' @title Create a cell style -#' @description Create a new style to apply to worksheet cells -#' @author Alexander Walker -#' @seealso \code{\link{addStyle}} -#' @param fontName A name of a font. Note the font name is not validated. If fontName is NULL, -#' the workbook base font is used. (Defaults to Calibri) -#' @param fontColour Colour of text in cell. A valid hex colour beginning with "#" -#' or one of colours(). If fontColour is NULL, the workbook base font colours is used. -#' (Defaults to black) -#' @param fontSize Font size. A numeric greater than 0. -#' If fontSize is NULL, the workbook base font size is used. (Defaults to 11) -#' @param numFmt Cell formatting -#' \itemize{ -#' \item{\bold{GENERAL}} -#' \item{\bold{NUMBER}} -#' \item{\bold{CURRENCY}} -#' \item{\bold{ACCOUNTING}} -#' \item{\bold{DATE}} -#' \item{\bold{LONGDATE}} -#' \item{\bold{TIME}} -#' \item{\bold{PERCENTAGE}} -#' \item{\bold{FRACTION}} -#' \item{\bold{SCIENTIFIC}} -#' \item{\bold{TEXT}} -#' \item{\bold{COMMA}{ for comma separated thousands}} -#' \item{For date/datetime styling a combination of d, m, y and punctuation marks} -#' \item{For numeric rounding use "0.00" with the preferred number of decimal places} -#' } -#' -#' @param border Cell border. A vector of "top", "bottom", "left", "right" or a single string). -#' \itemize{ -#' \item{\bold{"top"}}{ Top border} -#' \item{\bold{bottom}}{ Bottom border} -#' \item{\bold{left}}{ Left border} -#' \item{\bold{right}}{ Right border} -#' \item{\bold{TopBottom} or \bold{c("top", "bottom")}}{ Top and bottom border} -#' \item{\bold{LeftRight} or \bold{c("left", "right")}}{ Left and right border} -#' \item{\bold{TopLeftRight} or \bold{c("top", "left", "right")}}{ Top, Left and right border} -#' \item{\bold{TopBottomLeftRight} or \bold{c("top", "bottom", "left", "right")}}{ All borders} -#' } -#' -#' @param borderColour Colour of cell border vector the same length as the number of sides specified in "border" -#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#" -#' -#' @param borderStyle Border line style vector the same length as the number of sides specified in "border" -#' \itemize{ -#' \item{\bold{none}}{ No Border} -#' \item{\bold{thin}}{ thin border} -#' \item{\bold{medium}}{ medium border} -#' \item{\bold{dashed}}{ dashed border} -#' \item{\bold{dotted}}{ dotted border} -#' \item{\bold{thick}}{ thick border} -#' \item{\bold{double}}{ double line border} -#' \item{\bold{hair}}{ Hairline border} -#' \item{\bold{mediumDashed}}{ medium weight dashed border} -#' \item{\bold{dashDot}}{ dash-dot border} -#' \item{\bold{mediumDashDot}}{ medium weight dash-dot border} -#' \item{\bold{dashDotDot}}{ dash-dot-dot border} -#' \item{\bold{mediumDashDotDot}}{ medium weight dash-dot-dot border} -#' \item{\bold{slantDashDot}}{ slanted dash-dot border} -#' } -#' -#' @param bgFill Cell background fill colour. -#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#". -#' -- \bold{Use for conditional formatting styles only.} -#' @param fgFill Cell foreground fill colour. -#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#" -#' -#' @param halign -#' Horizontal alignment of cell contents -#' \itemize{ -#' \item{\bold{left}}{ Left horizontal align cell contents} -#' \item{\bold{right}}{ Right horizontal align cell contents} -#' \item{\bold{center}}{ Center horizontal align cell contents} -#' } -#' -#' @param valign A name -#' Vertical alignment of cell contents -#' \itemize{ -#' \item{\bold{top}}{ Top vertical align cell contents} -#' \item{\bold{center}}{ Center vertical align cell contents} -#' \item{\bold{bottom}}{ Bottom vertical align cell contents} -#' } -#' -#' @param textDecoration -#' Text styling. -#' \itemize{ -#' \item{\bold{bold}}{ Bold cell contents} -#' \item{\bold{strikeout}}{ Strikeout cell contents} -#' \item{\bold{italic}}{ Italicise cell contents} -#' \item{\bold{underline}}{ Underline cell contents} -#' \item{\bold{underline2}}{ Double underline cell contents} -#' } -#' -#' @param wrapText Logical. If \code{TRUE} cell contents will wrap to fit in column. -#' @param textRotation Rotation of text in degrees. 255 for vertical text. -#' @param indent Horizontal indentation of cell contents. -#' @param hidden Whether the formula of the cell contents will be hidden (if worksheet protection is turned on) -#' @param locked Whether cell contents are locked (if worksheet protection is turned on) -#' @return A style object -#' @export -#' @examples -#' ## See package vignettes for further examples -#' -#' ## Modify default values of border colour and border line style -#' options("openxlsx.borderColour" = "#4F80BD") -#' options("openxlsx.borderStyle" = "thin") -#' -#' ## Size 18 Arial, Bold, left horz. aligned, fill colour #1A33CC, all borders, -#' style <- createStyle( -#' fontSize = 18, fontName = "Arial", -#' textDecoration = "bold", halign = "left", fgFill = "#1A33CC", border = "TopBottomLeftRight" -#' ) -#' -#' ## Red, size 24, Bold, italic, underline, center aligned Font, bottom border -#' style <- createStyle( -#' fontSize = 24, fontColour = rgb(1, 0, 0), -#' textDecoration = c("bold", "italic", "underline"), -#' halign = "center", valign = "center", border = "Bottom" -#' ) -#' -#' # borderColour is recycled for each border or all colours can be supplied -#' -#' # colour is recycled 3 times for "Top", "Bottom" & "Right" sides. -#' createStyle(border = "TopBottomRight", borderColour = "red") -#' -#' # supply all colours -#' createStyle(border = "TopBottomLeft", borderColour = c("red", "yellow", "green")) -createStyle <- function( - fontName = NULL, - fontSize = NULL, - fontColour = NULL, - numFmt = openxlsx_getOp("numFmt", "GENERAL"), - border = NULL, - borderColour = openxlsx_getOp("borderColour", "black"), - borderStyle = openxlsx_getOp("borderStyle", "thin"), - bgFill = NULL, - fgFill = NULL, - halign = NULL, - valign = NULL, - textDecoration = NULL, - wrapText = FALSE, - textRotation = NULL, - indent = NULL, - locked = NULL, - hidden = NULL - ) { - - ### Error checking - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - ## if num fmt is made up of dd, mm, yy - numFmt_original <- numFmt[[1]] - numFmt <- tolower(numFmt_original) - validNumFmt <- c("general", "number", "currency", "accounting", "date", "longdate", "time", "percentage", "scientific", "text", "3", "4", "comma") - - if (numFmt == "date") { - numFmt <- openxlsx_getOp("dateFormat", "date") - } else if (numFmt == "longdate") { - numFmt <- openxlsx_getOp("datetimeFormat", "longdate") - } else if (!numFmt %in% validNumFmt) { - numFmt <- replaceIllegalCharacters(numFmt_original) - } - - numFmtMapping <- list( - list(numFmtId = 0), # GENERAL - list(numFmtId = 2), # NUMBER - list(numFmtId = 164, formatCode = ""$"#,##0.00"), ## CURRENCY - list(numFmtId = 44), # ACCOUNTING - list(numFmtId = 14), # DATE - list(numFmtId = 166, formatCode = "yyyy/mm/dd hh:mm:ss"), # LONGDATE - list(numFmtId = 167), # TIME - list(numFmtId = 10), # PERCENTAGE - list(numFmtId = 11), # SCIENTIFIC - list(numFmtId = 49), # TEXT - list(numFmtId = 3), - list(numFmtId = 4), - list(numFmtId = 3) - ) - - names(numFmtMapping) <- validNumFmt - - ## Validate border line style - if (!is.null(borderStyle)) { - borderStyle <- validateBorderStyle(borderStyle) - } - - if (!is.null(halign)) { - halign <- tolower(halign[[1]]) - if (!halign %in% c("left", "right", "center")) { - stop("Invalid halign argument!") - } - } - - if (!is.null(valign)) { - valign <- tolower(valign[[1]]) - if (!valign %in% c("top", "bottom", "center")) { - stop("Invalid valign argument!") - } - } - - if (!is.logical(wrapText)) { - stop("Invalid wrapText") - } - - if (!is.null(indent)) { - if (!is.numeric(indent) & !is.integer(indent)) { - stop("indent must be numeric") - } - } - - textDecoration <- tolower(textDecoration) - if (!is.null(textDecoration)) { - if (!all(textDecoration %in% c("bold", "strikeout", "italic", "underline", "underline2", ""))) { - stop("Invalid textDecoration!") - } - } - - borderColour <- validateColour(borderColour, "Invalid border colour!") - - if (!is.null(fontColour)) { - fontColour <- validateColour(fontColour, "Invalid font colour!") - } - - if (!is.null(fontSize)) { - if (fontSize < 1) stop("Font size must be greater than 0!") - } - - if (!is.null(locked)) { - if (!is.logical(locked)) stop("Cell attribute locked must be TRUE or FALSE") - } - if (!is.null(hidden)) { - if (!is.logical(hidden)) stop("Cell attribute hidden must be TRUE or FALSE") - } - - - - - - ######################### error checking complete ############################# - style <- Style$new() - - if (!is.null(fontName)) { - style$fontName <- list("val" = fontName) - } - - if (!is.null(fontSize)) { - style$fontSize <- list("val" = fontSize) - } - - if (!is.null(fontColour)) { - style$fontColour <- list("rgb" = fontColour) - } - - style$fontDecoration <- toupper(textDecoration) - - ## background fill - if (is.null(bgFill)) { - # bgFillList <- NULL variable not used - } else { - bgFill <- validateColour(bgFill, "Invalid bgFill colour") - style$fill <- append(style$fill, list(fillBg = list("rgb" = bgFill))) - } - - ## foreground fill - if (is.null(fgFill)) { - # fgFillList <- NULL variable not used - } else { - fgFill <- validateColour(fgFill, "Invalid fgFill colour") - style$fill <- append(style$fill, list(fillFg = list(rgb = fgFill))) - } - - - ## border - if (!is.null(border)) { - border <- toupper(border) - border <- paste(border, collapse = "") - - ## find position of each side in string - sides <- c("LEFT", "RIGHT", "TOP", "BOTTOM") - pos <- sapply(sides, function(x) regexpr(x, border)) - pos <- pos[order(pos, decreasing = FALSE)] - nSides <- sum(pos > 0) - - borderColour <- rep(borderColour, length.out = nSides) - borderStyle <- rep(borderStyle, length.out = nSides) - - pos <- pos[pos > 0] - - if (length(pos) == 0) { - stop("Unknown border argument") - } - - names(borderColour) <- names(pos) - names(borderStyle) <- names(pos) - - if ("LEFT" %in% names(pos)) { - style$borderLeft <- borderStyle[["LEFT"]] - style$borderLeftColour <- list("rgb" = borderColour[["LEFT"]]) - } - - if ("RIGHT" %in% names(pos)) { - style$borderRight <- borderStyle[["RIGHT"]] - style$borderRightColour <- list("rgb" = borderColour[["RIGHT"]]) - } - - if ("TOP" %in% names(pos)) { - style$borderTop <- borderStyle[["TOP"]] - style$borderTopColour <- list("rgb" = borderColour[["TOP"]]) - } - - if ("BOTTOM" %in% names(pos)) { - style$borderBottom <- borderStyle[["BOTTOM"]] - style$borderBottomColour <- list("rgb" = borderColour[["BOTTOM"]]) - } - } - - ## other fields - if (!is.null(halign)) { - style$halign <- halign - } - - if (!is.null(valign)) { - style$valign <- valign - } - - if (!is.null(indent)) { - style$indent <- indent - } - - if (wrapText) { - style$wrapText <- TRUE - } - - if (!is.null(textRotation)) { - if (!is.numeric(textRotation)) { - stop("textRotation must be numeric.") - } - - if (textRotation < 0 & textRotation >= -90) { - textRotation <- (textRotation * -1) + 90 - } - - style$textRotation <- round(textRotation[[1]], 0) - } - - if (numFmt != "general") { - if (numFmt %in% validNumFmt) { - style$numFmt <- numFmtMapping[[numFmt[[1]]]] - } else { - style$numFmt <- list("numFmtId" = 165, formatCode = numFmt) ## Custom numFmt - } - } - - - if (!is.null(locked)) { - style$locked <- locked - } - - if (!is.null(hidden)) { - style$hidden <- hidden - } - - return(style) -} - - - -#' @name addStyle -#' @title Add a style to a set of cells -#' @description Function adds a style to a specified set of cells. -#' @author Alexander Walker -#' @param wb A Workbook object containing a worksheet. -#' @param sheet A worksheet to apply the style to. -#' @param style A style object returned from createStyle() -#' @param rows Rows to apply style to. -#' @param cols columns to apply style to. -#' @param gridExpand If \code{TRUE}, style will be applied to all combinations of rows and cols. -#' @param stack If \code{TRUE} the new style is merged with any existing cell styles. If FALSE, any -#' existing style is replaced by the new style. -#' @seealso \code{\link{createStyle}} -#' @seealso expand.grid -#' @export -#' @examples -#' ## See package vignette for more examples. -#' -#' ## Create a new workbook -#' wb <- createWorkbook("My name here") -#' -#' ## Add a worksheets -#' addWorksheet(wb, "Expenditure", gridLines = FALSE) -#' -#' ## write data to worksheet 1 -#' writeData(wb, sheet = 1, USPersonalExpenditure, rowNames = TRUE) -#' -#' ## create and add a style to the column headers -#' headerStyle <- createStyle( -#' fontSize = 14, fontColour = "#FFFFFF", halign = "center", -#' fgFill = "#4F81BD", border = "TopBottom", borderColour = "#4F81BD" -#' ) -#' -#' ## style for body -#' bodyStyle <- createStyle(border = "TopBottom", borderColour = "#4F81BD") -#' addStyle(wb, sheet = 1, bodyStyle, rows = 2:6, cols = 1:6, gridExpand = TRUE) -#' setColWidths(wb, 1, cols = 1, widths = 21) ## set column width for row names column -#' \dontrun{ -#' saveWorkbook(wb, "addStyleExample.xlsx", overwrite = TRUE) -#' } -addStyle <- function( - wb, - sheet, - style, - rows, - cols, - gridExpand = FALSE, - stack = FALSE -) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - - if (!is.null(style$numFmt) & length(wb$styleObjects) > 0) { - if (style$numFmt$numFmtId == 165) { - maxnumFmtId <- max(c(sapply(wb$styleObjects, function(i) { - as.integer( - max(c(i$style$numFmt$numFmtId, 0)) - ) - }), 165)) - style$numFmt$numFmtId <- maxnumFmtId + 1 - } - } - sheet <- wb$validateSheet(sheet) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (!"Style" %in% class(style)) { - stop("style argument must be a Style object.") - } - - if (!is.logical(stack)) { - stop("stack parameter must be a logical!") - } - - if (length(cols) == 0 | length(rows) == 0) { - return(invisible(0)) - } - - cols <- convertFromExcelRef(cols) - rows <- as.integer(rows) - - ## rows and cols need to be the same length - if (gridExpand) { - n <- length(cols) - cols <- rep.int(cols, times = length(rows)) - rows <- rep(rows, each = n) - } else if (length(rows) == 1 & length(cols) > 1) { - rows <- rep.int(rows, times = length(cols)) - } else if (length(cols) == 1 & length(rows) > 1) { - cols <- rep.int(cols, times = length(rows)) - } else if (length(rows) != length(cols)) { - stop("Length of rows and cols must be equal.") - } - - - wb$addStyle(sheet = sheet, style = style, rows = rows, cols = cols, stack = stack) -} - - -#' @name getCellRefs -#' @title Return excel cell coordinates from (x,y) coordinates -#' @description Return excel cell coordinates from (x,y) coordinates -#' @author Philipp Schauberger, Alexander Walker -#' @param cellCoords A data.frame with two columns coordinate pairs. -#' @return Excel alphanumeric cell reference -#' @examples -#' getCellRefs(data.frame(1, 2)) -#' # "B1" -#' getCellRefs(data.frame(1:3, 2:4)) -#' # "B1" "C2" "D3" -#' @export -getCellRefs <- function(cellCoords) { - if (!"data.frame" %in% class(cellCoords)) { - stop("Provide a data.frame!") - } - - - - if (!("numeric" %in% sapply(cellCoords[, 1], class) | - "integer" %in% sapply(cellCoords[, 1], class)) - & ("numeric" %in% sapply(cellCoords[, 2], class) | - "integer" %in% sapply(cellCoords[, 2], class)) - - ) { - stop("Provide a data.frame containing integers!") - } - - - - - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - l <- convert_to_excel_ref(cols = unlist(cellCoords[, 2]), LETTERS = LETTERS) - paste0(l, cellCoords[, 1]) -} - - - - - - - - - - - -#' @name freezePane -#' @title Freeze a worksheet pane -#' @description Freeze a worksheet pane -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param firstActiveRow Top row of active region -#' @param firstActiveCol Furthest left column of active region -#' @param firstRow If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2) -#' @param firstCol If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2) -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook("Kenshin") -#' -#' ## Add some worksheets -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2") -#' addWorksheet(wb, "Sheet 3") -#' addWorksheet(wb, "Sheet 4") -#' -#' ## Freeze Panes -#' freezePane(wb, "Sheet 1", firstActiveRow = 5, firstActiveCol = 3) -#' freezePane(wb, "Sheet 2", firstCol = TRUE) ## shortcut to firstActiveCol = 2 -#' freezePane(wb, 3, firstRow = TRUE) ## shortcut to firstActiveRow = 2 -#' freezePane(wb, 4, firstActiveRow = 1, firstActiveCol = "D") -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "freezePaneExample.xlsx", overwrite = TRUE) -#' } -freezePane <- function(wb, sheet, firstActiveRow = NULL, firstActiveCol = NULL, firstRow = FALSE, firstCol = FALSE) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (is.null(firstActiveRow) & is.null(firstActiveCol) & !firstRow & !firstCol) { - return(invisible(0)) - } - - if (!is.logical(firstRow)) { - stop("firstRow must be TRUE/FALSE") - } - - if (!is.logical(firstCol)) { - stop("firstCol must be TRUE/FALSE") - } - - - - - if (firstRow & !firstCol) { - invisible(wb$freezePanes(sheet, firstRow = firstRow)) - } else if (firstCol & !firstRow) { - invisible(wb$freezePanes(sheet, firstCol = firstCol)) - } else if (firstRow & firstCol) { - invisible(wb$freezePanes(sheet, firstActiveRow = 2L, firstActiveCol = 2L)) - } else { ## else both firstRow and firstCol are FALSE - - ## Convert to numeric if column letter given - if (!is.null(firstActiveRow)) { - firstActiveRow <- convertFromExcelRef(firstActiveRow) - } else { - firstActiveRow <- 1L - } - - if (!is.null(firstActiveCol)) { - firstActiveCol <- convertFromExcelRef(firstActiveCol) - } else { - firstActiveCol <- 1L - } - - invisible(wb$freezePanes(sheet, firstActiveRow = firstActiveRow, firstActiveCol = firstActiveCol, firstRow = firstRow, firstCol = firstCol)) - } -} - - -convert2EMU <- function(d, units) { - if (grepl("in", units)) { - d <- d * 2.54 - } - - if (grepl("mm|milli", units)) { - d <- d / 10 - } - - return(d * 360000) -} - - - - -#' @name insertImage -#' @title Insert an image into a worksheet -#' @description Insert an image into a worksheet -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param file An image file. Valid file types are: jpeg, png, bmp -#' @param width Width of figure. -#' @param height Height of figure. -#' @param startRow Row coordinate of upper left corner of the image -#' @param startCol Column coordinate of upper left corner of the image -#' @param units Units of width and height. Can be "in", "cm" or "px" -#' @param dpi Image resolution used for conversion between units. -#' @importFrom grDevices bmp png jpeg -#' @seealso \code{\link{insertPlot}} -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook("Ayanami") -#' -#' ## Add some worksheets -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2") -#' addWorksheet(wb, "Sheet 3") -#' -#' ## Insert images -#' img <- system.file("extdata", "einstein.jpg", package = "openxlsx") -#' insertImage(wb, "Sheet 1", img, startRow = 5, startCol = 3, width = 6, height = 5) -#' insertImage(wb, 2, img, startRow = 2, startCol = 2) -#' insertImage(wb, 3, img, width = 15, height = 12, startRow = 3, startCol = "G", units = "cm") -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "insertImageExample.xlsx", overwrite = TRUE) -#' } -insertImage <- function(wb, sheet, file, width = 6, height = 3, startRow = 1, startCol = 1, units = "in", dpi = 300) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!file.exists(file)) { - stop("File does not exist.") - } - - if (!grepl("\\\\|\\/", file)) { - file <- file.path(getwd(), file, fsep = .Platform$file.sep) - } - - units <- tolower(units) - - if (!units %in% c("cm", "in", "px")) { - stop("Invalid units.\nunits must be one of: cm, in, px") - } - - startCol <- convertFromExcelRef(startCol) - startRow <- as.integer(startRow) - - ## convert to inches - if (units == "px") { - width <- width / dpi - height <- height / dpi - } else if (units == "cm") { - width <- width / 2.54 - height <- height / 2.54 - } - - ## Convert to EMUs - widthEMU <- as.integer(round(width * 914400L, 0)) # (EMUs per inch) - heightEMU <- as.integer(round(height * 914400L, 0)) # (EMUs per inch) - - wb$insertImage(sheet, file = file, startRow = startRow, startCol = startCol, width = widthEMU, height = heightEMU) -} - -pixels2ExcelColWidth <- function(pixels) { - if (any(!is.numeric(pixels))) { - stop("All elements of pixels must be numeric") - } - - pixels[pixels == 0] <- 8.43 - pixels[pixels != 0] <- (pixels[pixels != 0] - 12) / 7 + 1 - - pixels -} - - -#' @name setRowHeights -#' @title Set worksheet row heights -#' @description Set worksheet row heights -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param rows Indices of rows to set height -#' @param heights Heights to set rows to specified in Excel column height units. -#' @seealso \code{\link{removeRowHeights}} -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook() -#' -#' ## Add a worksheet -#' addWorksheet(wb, "Sheet 1") -#' -#' ## set row heights -#' setRowHeights(wb, 1, rows = c(1, 4, 22, 2, 19), heights = c(24, 28, 32, 42, 33)) -#' -#' ## overwrite row 1 height -#' setRowHeights(wb, 1, rows = 1, heights = 40) -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "setRowHeightsExample.xlsx", overwrite = TRUE) -#' } -setRowHeights <- function(wb, sheet, rows, heights) { - sheet <- wb$validateSheet(sheet) - - if (length(rows) > length(heights)) { - heights <- rep(heights, length.out = length(rows)) - } - - if (length(heights) > length(rows)) { - stop("Greater number of height values than rows.") - } - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - ## Remove duplicates - heights <- heights[!duplicated(rows)] - rows <- rows[!duplicated(rows)] - - - heights <- as.character(as.numeric(heights)) - names(heights) <- rows - - wb$setRowHeights(sheet, rows, heights) -} - -#' @name setColWidths -#' @title Set worksheet column widths -#' @description Set worksheet column widths to specific width or "auto". -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols Indices of cols to set width -#' @param widths widths to set cols to specified in Excel column width units or "auto" for automatic sizing. The widths argument is -#' recycled to the length of cols. -#' @param hidden Logical vector. If TRUE the column is hidden. -#' @param ignoreMergedCells Ignore any cells that have been merged with other cells in the calculation of "auto" column widths. -#' @details The global min and max column width for "auto" columns is set by (default values show): -#' \itemize{ -#' \item{options("openxlsx.minWidth" = 3)} -#' \item{options("openxlsx.maxWidth" = 250)} ## This is the maximum width allowed in Excel -#' } -#' -#' NOTE: The calculation of column widths can be slow for large worksheets. -#' -#' NOTE: The \code{hidden} parameter may conflict with the one set in \code{groupColumns}; changing one will update the other. -#' -#' @seealso \code{\link{removeColWidths}} -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- createWorkbook() -#' -#' ## Add a worksheet -#' addWorksheet(wb, "Sheet 1") -#' -#' -#' ## set col widths -#' setColWidths(wb, 1, cols = c(1, 4, 6, 7, 9), widths = c(16, 15, 12, 18, 33)) -#' -#' ## auto columns -#' addWorksheet(wb, "Sheet 2") -#' writeData(wb, sheet = 2, x = iris) -#' setColWidths(wb, sheet = 2, cols = 1:5, widths = "auto") -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "setColWidthsExample.xlsx", overwrite = TRUE) -#' } -#' -setColWidths <- function(wb, sheet, cols, widths = 8.43, hidden = rep(FALSE, length(cols)), ignoreMergedCells = FALSE) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - sheet <- wb$validateSheet(sheet) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - widths <- tolower(widths) ## possibly "auto" - if (ignoreMergedCells) { - widths[widths == "auto"] <- "auto2" - } - - # should do nothing if the cols' length is zero - if (length(cols) == 0L) return(invisible(0)) - - if (length(widths) > length(cols)) { - stop("More widths than columns supplied.") - } - - if (length(hidden) > length(cols)) { - stop("hidden argument is longer than cols.") - } - - if (length(widths) < length(cols)) { - widths <- rep(widths, length.out = length(cols)) - } - - if (length(hidden) < length(cols)) { - hidden <- rep(hidden, length.out = length(cols)) - } - - ## Remove duplicates - widths <- widths[!duplicated(cols)] - hidden <- hidden[!duplicated(cols)] - cols <- cols[!duplicated(cols)] - cols <- convertFromExcelRef(cols) - - if (length(wb$colWidths[[sheet]]) > 0) { - existing_cols <- names(wb$colWidths[[sheet]]) - existing_widths <- unname(wb$colWidths[[sheet]]) - existing_hidden <- attr(wb$colWidths[[sheet]], "hidden") - - ## check for existing custom widths - flag <- existing_cols %in% cols - if (any(flag)) { - existing_cols <- existing_cols[!flag] - existing_widths <- existing_widths[!flag] - existing_hidden <- existing_hidden[!flag] - } - - all_names <- c(existing_cols, cols) - all_widths <- c(existing_widths, widths) - all_hidden <- c(existing_hidden, as.character(as.integer(hidden))) - - ord <- order(as.integer(all_names)) - all_names <- all_names[ord] - all_widths <- all_widths[ord] - all_hidden <- all_hidden[ord] - - - names(all_widths) <- all_names - wb$colWidths[[sheet]] <- all_widths - attr(wb$colWidths[[sheet]], "hidden") <- all_hidden - } else { - names(widths) <- cols - wb$colWidths[[sheet]] <- widths - attr(wb$colWidths[[sheet]], "hidden") <- as.character(as.integer(hidden)) - } - - # Check if any conflicting column outline levels - if (length(wb$colOutlineLevels[[sheet]]) > 0) { - existing_cols <- names(wb$colOutlineLevels[[sheet]]) - - if (any(existing_cols %in% cols)) { - for (i in intersect(existing_cols, cols)) { - width_hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i] - outline_hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "names") == i] - - if (outline_hidden != width_hidden) { - attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "names") == i] <- width_hidden - } - } - - cols <- cols[!cols %in% existing_cols] - hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") %in% cols] - } - } - - invisible(0) -} - - -#' @name removeColWidths -#' @title Remove column widths from a worksheet - -#' @description Remove column widths from a worksheet -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols Indices of columns to remove custom width (if any) from. -#' @seealso \code{\link{setColWidths}} -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -#' -#' ## remove column widths in columns 1 to 20 -#' removeColWidths(wb, 1, cols = 1:20) -#' \dontrun{ -#' saveWorkbook(wb, "removeColWidthsExample.xlsx", overwrite = TRUE) -#' } -removeColWidths <- function(wb, sheet, cols) { - sheet <- wb$validateSheet(sheet) - - if (!is.numeric(cols)) { - cols <- convertFromExcelRef(cols) - } - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - customCols <- as.integer(names(wb$colWidths[[sheet]])) - removeInds <- which(customCols %in% cols) - if (length(removeInds) > 0) { - remainingCols <- customCols[-removeInds] - if (length(remainingCols) == 0) { - wb$colWidths[[sheet]] <- list() - } else { - rem_widths <- wb$colWidths[[sheet]][-removeInds] - names(rem_widths) <- as.character(remainingCols) - wb$colWidths[[sheet]] <- rem_widths - } - } -} - - - -#' @name removeRowHeights -#' @title Remove custom row heights from a worksheet -#' @description Remove row heights from a worksheet -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param rows Indices of rows to remove custom height (if any) from. -#' @seealso \code{\link{setRowHeights}} -#' @export -#' @examples -#' ## Create a new workbook -#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -#' -#' ## remove any custom row heights in rows 1 to 10 -#' removeRowHeights(wb, 1, rows = 1:10) -#' \dontrun{ -#' saveWorkbook(wb, "removeRowHeightsExample.xlsx", overwrite = TRUE) -#' } -removeRowHeights <- function(wb, sheet, rows) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - sheet <- wb$validateSheet(sheet) - - customRows <- as.integer(names(wb$rowHeights[[sheet]])) - removeInds <- which(customRows %in% rows) - if (length(removeInds) > 0) { - wb$rowHeights[[sheet]] <- wb$rowHeights[[sheet]][-removeInds] - } -} - - -#' @name insertPlot -#' @title Insert the current plot into a worksheet -#' @author Alexander Walker -#' @description The current plot is saved to a temporary image file using dev.copy. -#' This file is then written to the workbook using insertImage. -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param startRow Row coordinate of upper left corner of figure. xy[[2]] when xy is given. -#' @param startCol Column coordinate of upper left corner of figure. xy[[1]] when xy is given. -#' @param xy Alternate way to specify startRow and startCol. A vector of length 2 of form (startcol, startRow) -#' @param width Width of figure. Defaults to 6in. -#' @param height Height of figure . Defaults to 4in. -#' @param fileType File type of image -#' @param units Units of width and height. Can be "in", "cm" or "px" -#' @param dpi Image resolution -#' @seealso \code{\link{insertImage}} -#' @export -#' @importFrom grDevices bmp png jpeg tiff dev.copy dev.list dev.off -#' @examples -#' \dontrun{ -#' ## Create a new workbook -#' wb <- createWorkbook() -#' -#' ## Add a worksheet -#' addWorksheet(wb, "Sheet 1", gridLines = FALSE) -#' -#' ## create plot objects -#' require(ggplot2) -#' p1 <- qplot(mpg, -#' data = mtcars, geom = "density", -#' fill = as.factor(gear), alpha = I(.5), main = "Distribution of Gas Mileage" -#' ) -#' p2 <- qplot(age, circumference, -#' data = Orange, geom = c("point", "line"), colour = Tree -#' ) -#' -#' ## Insert currently displayed plot to sheet 1, row 1, column 1 -#' print(p1) # plot needs to be showing -#' insertPlot(wb, 1, width = 5, height = 3.5, fileType = "png", units = "in") -#' -#' ## Insert plot 2 -#' print(p2) -#' insertPlot(wb, 1, xy = c("J", 2), width = 16, height = 10, fileType = "png", units = "cm") -#' -#' ## Save workbook -#' saveWorkbook(wb, "insertPlotExample.xlsx", overwrite = TRUE) -#' } -insertPlot <- function(wb, sheet, width = 6, height = 4, xy = NULL, - startRow = 1, startCol = 1, fileType = "png", units = "in", dpi = 300) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (is.null(dev.list()[[1]])) { - warning("No plot to insert.") - return() - } - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (!is.null(xy)) { - startCol <- xy[[1]] - startRow <- xy[[2]] - } - - fileType <- tolower(fileType) - units <- tolower(units) - - if (fileType == "jpg") { - fileType <- "jpeg" - } - - if (!fileType %in% c("png", "jpeg", "tiff", "bmp")) { - stop("Invalid file type.\nfileType must be one of: png, jpeg, tiff, bmp") - } - - if (!units %in% c("cm", "in", "px")) { - stop("Invalid units.\nunits must be one of: cm, in, px") - } - - fileName <- tempfile(pattern = "figureImage", fileext = paste0(".", fileType)) - - if (fileType == "bmp") { - dev.copy(bmp, filename = fileName, width = width, height = height, units = units, res = dpi) - } else if (fileType == "jpeg") { - dev.copy(jpeg, filename = fileName, width = width, height = height, units = units, quality = 100, res = dpi) - } else if (fileType == "png") { - dev.copy(png, filename = fileName, width = width, height = height, units = units, res = dpi) - } else if (fileType == "tiff") { - dev.copy(tiff, filename = fileName, width = width, height = height, units = units, compression = "none", res = dpi) - } - - ## write image - invisible(dev.off()) - - insertImage(wb = wb, sheet = sheet, file = fileName, width = width, height = height, startRow = startRow, startCol = startCol, units = units, dpi = dpi) -} - - - -#' @name replaceStyle -#' @title Replace an existing cell style -#' @description Replace an existing cell style -#' @author Alexander Walker -#' @param wb A workbook object -#' @param index Index of style object to replace -#' @param newStyle A style to replace the existing style as position index -#' @description Replace a style object -#' @export -#' @seealso \code{\link{getStyles}} -#' @examples -#' -#' ## load a workbook -#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -#' -#' ## create a new style and replace style 2 -#' -#' newStyle <- createStyle(fgFill = "#00FF00") -#' -#' ## replace style 2 -#' getStyles(wb)[1:3] ## prints styles -#' replaceStyle(wb, 2, newStyle = newStyle) -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "replaceStyleExample.xlsx", overwrite = TRUE) -#' } -replaceStyle <- function(wb, index, newStyle) { - nStyles <- length(wb$styleObjects) - - if (nStyles == 0) { - stop("Workbook has no existing styles.") - } - - if (index > nStyles) { - stop(sprintf("Invalid index. Workbook only has %s styles.", nStyles)) - } - - if (!all("Style" %in% class(newStyle))) { - stop("Invalid style object.") - } - - wb$styleObjects[[index]]$style <- newStyle -} - - -#' @name getStyles -#' @title Returns a list of all styles in the workbook -#' @description Returns list of style objects in the workbook -#' @param wb A workbook object -#' @export -#' @seealso \code{\link{replaceStyle}} -#' @examples -#' ## load a workbook -#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -#' getStyles(wb)[1:3] -getStyles <- function(wb) { - nStyles <- length(wb$styleObjects) - - if (nStyles == 0) { - stop("Workbook has no existing styles.") - } - - styles <- lapply(wb$styleObjects, "[[", "style") - - return(styles) -} - - - -#' @name removeWorksheet -#' @title Remove a worksheet from a workbook -#' @description Remove a worksheet from a Workbook object -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @description Remove a worksheet from a workbook -#' @export -#' @examples -#' ## load a workbook -#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -#' -#' ## Remove sheet 2 -#' removeWorksheet(wb, 2) -#' -#' ## save the modified workbook -#' \dontrun{ -#' saveWorkbook(wb, "removeWorksheetExample.xlsx", overwrite = TRUE) -#' } -removeWorksheet <- function(wb, sheet) { - if (class(wb) != "Workbook") { - stop("wb must be a Workbook object!") - } - - if (length(sheet) != 1) { - stop("sheet must have length 1.") - } - - wb$deleteWorksheet(sheet) - - invisible(0) -} - - -#' @name deleteData -#' @title Delete cell data -#' @description Delete contents and styling from a cell. -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param rows Rows to delete data from. -#' @param cols columns to delete data from. -#' @param gridExpand If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols) -#' will be removed. -#' @export -#' @examples -#' ## write some data -#' wb <- createWorkbook() -#' addWorksheet(wb, "Worksheet 1") -#' x <- data.frame(matrix(runif(200), ncol = 10)) -#' writeData(wb, sheet = 1, x = x, startCol = 2, startRow = 3, colNames = FALSE) -#' -#' ## delete some data -#' deleteData(wb, sheet = 1, cols = 3:5, rows = 5:7, gridExpand = TRUE) -#' deleteData(wb, sheet = 1, cols = 7:9, rows = 5:7, gridExpand = TRUE) -#' deleteData(wb, sheet = 1, cols = LETTERS, rows = 18, gridExpand = TRUE) -#' \dontrun{ -#' saveWorkbook(wb, "deleteDataExample.xlsx", overwrite = TRUE) -#' } -deleteData <- function(wb, sheet, cols, rows, gridExpand = FALSE) { - sheet <- wb$validateSheet(sheet) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - - wb$worksheets[[sheet]]$sheet_data$delete(rows_in = rows, cols_in = cols, grid_expand = gridExpand) - - - invisible(0) -} - - -#' @name modifyBaseFont -#' @title Modify the default font -#' @description Modify the default font for this workbook -#' @author Alexander Walker -#' @param wb A workbook object -#' @param fontSize font size -#' @param fontColour font colour -#' @param fontName Name of a font -#' @details The font name is not validated in anyway. Excel replaces unknown font names -#' with Arial. Base font is black, size 11, Calibri. -#' @export -#' @examples -#' ## create a workbook -#' wb <- createWorkbook() -#' addWorksheet(wb, "S1") -#' ## modify base font to size 10 Arial Narrow in red -#' modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") -#' -#' writeData(wb, "S1", iris) -#' writeDataTable(wb, "S1", x = iris, startCol = 10) ## font colour does not affect tables -#' \dontrun{ -#' saveWorkbook(wb, "modifyBaseFontExample.xlsx", overwrite = TRUE) -#' } -modifyBaseFont <- function(wb, fontSize = 11, fontColour = "black", fontName = "Calibri") { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (fontSize < 0) stop("Invalid fontSize") - fontColour <- validateColour(fontColour) - - wb$styles$fonts[[1]] <- sprintf('', fontSize, fontColour, fontName) -} - - -#' @name getBaseFont -#' @title Return the workbook default font -#' @description Return the workbook default font -#' @author Alexander Walker -#' @param wb A workbook object -#' @description Returns the base font used in the workbook. -#' @export -#' @examples -#' ## create a workbook -#' wb <- createWorkbook() -#' getBaseFont(wb) -#' -#' ## modify base font to size 10 Arial Narrow in red -#' modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") -#' -#' getBaseFont(wb) -getBaseFont <- function(wb) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - wb$getBaseFont() -} - - -#' @name setHeaderFooter -#' @title Set document headers and footers -#' @description Set document headers and footers -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param header document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. -#' @param footer document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. -#' @param evenHeader document header for even pages. -#' @param evenFooter document footer for even pages. -#' @param firstHeader document header for first page only. -#' @param firstFooter document footer for first page only. -#' @details Headers and footers can contain special tags -#' \itemize{ -#' \item{\bold{&[Page]}}{ Page number} -#' \item{\bold{&[Pages]}}{ Number of pages} -#' \item{\bold{&[Date]}}{ Current date} -#' \item{\bold{&[Time]}}{ Current time} -#' \item{\bold{&[Path]}}{ File path} -#' \item{\bold{&[File]}}{ File name} -#' \item{\bold{&[Tab]}}{ Worksheet name} -#' } -#' @export -#' @seealso \code{\link{addWorksheet}} to set headers and footers when adding a worksheet -#' @examples -#' wb <- createWorkbook() -#' -#' addWorksheet(wb, "S1") -#' addWorksheet(wb, "S2") -#' addWorksheet(wb, "S3") -#' addWorksheet(wb, "S4") -#' -#' writeData(wb, 1, 1:400) -#' writeData(wb, 2, 1:400) -#' writeData(wb, 3, 3:400) -#' writeData(wb, 4, 3:400) -#' -#' setHeaderFooter(wb, -#' sheet = "S1", -#' header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), -#' footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), -#' evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), -#' evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), -#' firstHeader = c("TOP", "OF FIRST", "PAGE"), -#' firstFooter = c("BOTTOM", "OF FIRST", "PAGE") -#' ) -#' -#' setHeaderFooter(wb, -#' sheet = 2, -#' header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), -#' footer = c("&[Path]&[File]", NA, "&[Tab]"), -#' firstHeader = c(NA, "Center Header of First Page", NA), -#' firstFooter = c(NA, "Center Footer of First Page", NA) -#' ) -#' -#' setHeaderFooter(wb, -#' sheet = 3, -#' header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), -#' footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") -#' ) -#' -#' setHeaderFooter(wb, -#' sheet = 4, -#' firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), -#' firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") -#' ) -#' \dontrun{ -#' saveWorkbook(wb, "setHeaderFooterExample.xlsx", overwrite = TRUE) -#' } -setHeaderFooter <- function(wb, sheet, - header = NULL, - footer = NULL, - evenHeader = NULL, - evenFooter = NULL, - firstHeader = NULL, - firstFooter = NULL) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - - if (!is.null(header) & length(header) != 3) { - stop("header must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(footer) & length(footer) != 3) { - stop("footer must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(evenHeader) & length(evenHeader) != 3) { - stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(evenFooter) & length(evenFooter) != 3) { - stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(firstHeader) & length(firstHeader) != 3) { - stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.") - } - - if (!is.null(firstFooter) & length(firstFooter) != 3) { - stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.") - } - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - oddHeader <- headerFooterSub(header) - oddFooter <- headerFooterSub(footer) - evenHeader <- headerFooterSub(evenHeader) - evenFooter <- headerFooterSub(evenFooter) - firstHeader <- headerFooterSub(firstHeader) - firstFooter <- headerFooterSub(firstFooter) - - naToNULLList <- function(x) { - lapply(x, function(x) { - if (is.na(x)) { - return(NULL) - } - x - }) - } - - hf <- list( - oddHeader = naToNULLList(oddHeader), - oddFooter = naToNULLList(oddFooter), - evenHeader = naToNULLList(evenHeader), - evenFooter = naToNULLList(evenFooter), - firstHeader = naToNULLList(firstHeader), - firstFooter = naToNULLList(firstFooter) - ) - - if (all(sapply(hf, length) == 0)) { - hf <- NULL - } - - - wb$worksheets[[sheet]]$headerFooter <- hf -} - - - - -#' @name pageSetup -#' @title Set page margins, orientation and print scaling -#' @description Set page margins, orientation and print scaling -#' @author Alexander Walker, Joshua Sturm -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param orientation Page orientation. One of "portrait" or "landscape" -#' @param scale Print scaling. Numeric value between 10 and 400 -#' @param left left page margin in inches -#' @param right right page margin in inches -#' @param top top page margin in inches -#' @param bottom bottom page margin in inches -#' @param header header margin in inches -#' @param footer footer margin in inches -#' @param fitToWidth If \code{TRUE}, worksheet is scaled to fit to page width on printing. -#' @param fitToHeight If \code{TRUE}, worksheet is scaled to fit to page height on printing. -#' @param paperSize See details. Default value is 9 (A4 paper). -#' @param printTitleRows Rows to repeat at top of page when printing. Integer vector. -#' @param printTitleCols Columns to repeat at left when printing. Integer vector. -#' @param summaryRow Location of summary rows in groupings. One of "Above" or "Below". -#' @param summaryCol Location of summary columns in groupings. One of "Right" or "Left". -#' @export -#' @details -#' paperSize is an integer corresponding to: -#' \itemize{ -#' \item{\bold{1}}{ Letter paper (8.5 in. by 11 in.)} -#' \item{\bold{2}}{ Letter small paper (8.5 in. by 11 in.)} -#' \item{\bold{3}}{ Tabloid paper (11 in. by 17 in.)} -#' \item{\bold{4}}{ Ledger paper (17 in. by 11 in.)} -#' \item{\bold{5}}{ Legal paper (8.5 in. by 14 in.)} -#' \item{\bold{6}}{ Statement paper (5.5 in. by 8.5 in.)} -#' \item{\bold{7}}{ Executive paper (7.25 in. by 10.5 in.)} -#' \item{\bold{8}}{ A3 paper (297 mm by 420 mm)} -#' \item{\bold{9}}{ A4 paper (210 mm by 297 mm)} -#' \item{\bold{10}}{ A4 small paper (210 mm by 297 mm)} -#' \item{\bold{11}}{ A5 paper (148 mm by 210 mm)} -#' \item{\bold{12}}{ B4 paper (250 mm by 353 mm)} -#' \item{\bold{13}}{ B5 paper (176 mm by 250 mm)} -#' \item{\bold{14}}{ Folio paper (8.5 in. by 13 in.)} -#' \item{\bold{15}}{ Quarto paper (215 mm by 275 mm)} -#' \item{\bold{16}}{ Standard paper (10 in. by 14 in.)} -#' \item{\bold{17}}{ Standard paper (11 in. by 17 in.)} -#' \item{\bold{18}}{ Note paper (8.5 in. by 11 in.)} -#' \item{\bold{19}}{ #9 envelope (3.875 in. by 8.875 in.)} -#' \item{\bold{20}}{ #10 envelope (4.125 in. by 9.5 in.)} -#' \item{\bold{21}}{ #11 envelope (4.5 in. by 10.375 in.)} -#' \item{\bold{22}}{ #12 envelope (4.75 in. by 11 in.)} -#' \item{\bold{23}}{ #14 envelope (5 in. by 11.5 in.)} -#' \item{\bold{24}}{ C paper (17 in. by 22 in.)} -#' \item{\bold{25}}{ D paper (22 in. by 34 in.)} -#' \item{\bold{26}}{ E paper (34 in. by 44 in.)} -#' \item{\bold{27}}{ DL envelope (110 mm by 220 mm)} -#' \item{\bold{28}}{ C5 envelope (162 mm by 229 mm)} -#' \item{\bold{29}}{ C3 envelope (324 mm by 458 mm)} -#' \item{\bold{30}}{ C4 envelope (229 mm by 324 mm)} -#' \item{\bold{31}}{ C6 envelope (114 mm by 162 mm)} -#' \item{\bold{32}}{ C65 envelope (114 mm by 229 mm)} -#' \item{\bold{33}}{ B4 envelope (250 mm by 353 mm)} -#' \item{\bold{34}}{ B5 envelope (176 mm by 250 mm)} -#' \item{\bold{35}}{ B6 envelope (176 mm by 125 mm)} -#' \item{\bold{36}}{ Italy envelope (110 mm by 230 mm)} -#' \item{\bold{37}}{ Monarch envelope (3.875 in. by 7.5 in.).} -#' \item{\bold{38}}{ 6 3/4 envelope (3.625 in. by 6.5 in.)} -#' \item{\bold{39}}{ US standard fanfold (14.875 in. by 11 in.)} -#' \item{\bold{40}}{ German standard fanfold (8.5 in. by 12 in.)} -#' \item{\bold{41}}{ German legal fanfold (8.5 in. by 13 in.)} -#' \item{\bold{42}}{ ISO B4 (250 mm by 353 mm)} -#' \item{\bold{43}}{ Japanese double postcard (200 mm by 148 mm)} -#' \item{\bold{44}}{ Standard paper (9 in. by 11 in.)} -#' \item{\bold{45}}{ Standard paper (10 in. by 11 in.)} -#' \item{\bold{46}}{ Standard paper (15 in. by 11 in.)} -#' \item{\bold{47}}{ Invite envelope (220 mm by 220 mm)} -#' \item{\bold{50}}{ Letter extra paper (9.275 in. by 12 in.)} -#' \item{\bold{51}}{ Legal extra paper (9.275 in. by 15 in.)} -#' \item{\bold{52}}{ Tabloid extra paper (11.69 in. by 18 in.)} -#' \item{\bold{53}}{ A4 extra paper (236 mm by 322 mm)} -#' \item{\bold{54}}{ Letter transverse paper (8.275 in. by 11 in.)} -#' \item{\bold{55}}{ A4 transverse paper (210 mm by 297 mm)} -#' \item{\bold{56}}{ Letter extra transverse paper (9.275 in. by 12 in.)} -#' \item{\bold{57}}{ SuperA/SuperA/A4 paper (227 mm by 356 mm)} -#' \item{\bold{58}}{ SuperB/SuperB/A3 paper (305 mm by 487 mm)} -#' \item{\bold{59}}{ Letter plus paper (8.5 in. by 12.69 in.)} -#' \item{\bold{60}}{ A4 plus paper (210 mm by 330 mm)} -#' \item{\bold{61}}{ A5 transverse paper (148 mm by 210 mm)} -#' \item{\bold{62}}{ JIS B5 transverse paper (182 mm by 257 mm)} -#' \item{\bold{63}}{ A3 extra paper (322 mm by 445 mm)} -#' \item{\bold{64}}{ A5 extra paper (174 mm by 235 mm)} -#' \item{\bold{65}}{ ISO B5 extra paper (201 mm by 276 mm)} -#' \item{\bold{66}}{ A2 paper (420 mm by 594 mm)} -#' \item{\bold{67}}{ A3 transverse paper (297 mm by 420 mm)} -#' \item{\bold{68}}{ A3 extra transverse paper (322 mm by 445 mm)} -#' } -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "S1") -#' addWorksheet(wb, "S2") -#' writeDataTable(wb, 1, x = iris[1:30, ]) -#' writeDataTable(wb, 2, x = iris[1:30, ], xy = c("C", 5)) -#' -#' ## landscape page scaled to 50% -#' pageSetup(wb, sheet = 1, orientation = "landscape", scale = 50) -#' -#' ## portrait page scales to 300% with 0.5in left and right margins -#' pageSetup(wb, sheet = 2, orientation = "portrait", scale = 300, left = 0.5, right = 0.5) -#' -#' -#' ## print titles -#' addWorksheet(wb, "print_title_rows") -#' addWorksheet(wb, "print_title_cols") -#' -#' writeData(wb, "print_title_rows", rbind(iris, iris, iris, iris)) -#' writeData(wb, "print_title_cols", x = rbind(mtcars, mtcars, mtcars), rowNames = TRUE) -#' -#' pageSetup(wb, sheet = "print_title_rows", printTitleRows = 1) ## first row -#' pageSetup(wb, sheet = "print_title_cols", printTitleCols = 1, printTitleRows = 1) -#' \dontrun{ -#' saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) -#' } -pageSetup <- function(wb, sheet, orientation = NULL, scale = 100, - left = 0.7, right = 0.7, top = 0.75, bottom = 0.75, - header = 0.3, footer = 0.3, - fitToWidth = FALSE, fitToHeight = FALSE, paperSize = NULL, - printTitleRows = NULL, printTitleCols = NULL, - summaryRow = NULL, summaryCol = NULL) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - xml <- wb$worksheets[[sheet]]$pageSetup - - if (!is.null(orientation)) { - orientation <- tolower(orientation) - if (!orientation %in% c("portrait", "landscape")) stop("Invalid page orientation.") - } else { - orientation <- ifelse(grepl("landscape", xml), "landscape", "portrait") ## get existing - } - - if (scale < 10 | scale > 400) { - stop("Scale must be between 10 and 400.") - } - - if (!is.null(paperSize)) { - paperSizes <- 1:68 - paperSizes <- paperSizes[!paperSizes %in% 48:49] - if (!paperSize %in% paperSizes) { - stop("paperSize must be an integer in range [1, 68]. See ?pageSetup details.") - } - paperSize <- as.integer(paperSize) - } else { - paperSize <- regmatches(xml, regexpr('(?<=paperSize=")[0-9]+', xml, perl = TRUE)) ## get existing - } - - - ############################## - ## Keep defaults on orientation, hdpi, vdpi, paperSize - hdpi <- regmatches(xml, regexpr('(?<=horizontalDpi=")[0-9]+', xml, perl = TRUE)) - vdpi <- regmatches(xml, regexpr('(?<=verticalDpi=")[0-9]+', xml, perl = TRUE)) - - - ############################## - ## Update - wb$worksheets[[sheet]]$pageSetup <- sprintf( - '', - paperSize, orientation, scale, as.integer(fitToWidth), as.integer(fitToHeight), hdpi, vdpi - ) - - if (fitToHeight | fitToWidth) { - wb$worksheets[[sheet]]$sheetPr <- unique(c(wb$worksheets[[sheet]]$sheetPr, '')) - } - - wb$worksheets[[sheet]]$pageMargins <- - sprintf('', left, right, top, bottom, header, footer) - - validRow <- function(summaryRow) { - return(tolower(summaryRow) %in% c("above", "below")) - } - validCol <- function(summaryCol) { - return(tolower(summaryCol) %in% c("left", "right")) - } - - outlinepr <- "" - - if (!is.null(summaryRow)) { - - if (!validRow(summaryRow)) { - stop("Invalid \`summaryRow\` option. Must be one of \"Above\" or \"Below\".") - } else if (tolower(summaryRow) == "above") { - outlinepr <- ' summaryBelow=\"0\"' - } else { - outlinepr <- ' summaryBelow=\"1\"' - } - } - - if (!is.null(summaryCol)) { - - if (!validCol(summaryCol)) { - stop("Invalid \`summaryCol\` option. Must be one of \"Left\" or \"Right\".") - } else if (tolower(summaryCol) == "left") { - outlinepr <- paste0(outlinepr, ' summaryRight=\"0\"') - } else { - outlinepr <- paste0(outlinepr, ' summaryRight=\"1\"') - } - } - - if (!stri_isempty(outlinepr)) { - wb$worksheets[[sheet]]$sheetPr <- unique(c(wb$worksheets[[sheet]]$sheetPr, paste0(""))) - } - - ## print Titles - if (!is.null(printTitleRows) & is.null(printTitleCols)) { - if (!is.numeric(printTitleRows)) { - stop("printTitleRows must be numeric.") - } - - wb$createNamedRegion( - ref1 = paste0("$", min(printTitleRows)), - ref2 = paste0("$", max(printTitleRows)), - name = "_xlnm.Print_Titles", - sheet = names(wb)[[sheet]], - localSheetId = sheet - 1L - ) - } else if (!is.null(printTitleCols) & is.null(printTitleRows)) { - if (!is.numeric(printTitleCols)) { - stop("printTitleCols must be numeric.") - } - - cols <- convert_to_excel_ref(cols = range(printTitleCols), LETTERS = LETTERS) - wb$createNamedRegion( - ref1 = paste0("$", cols[1]), - ref2 = paste0("$", cols[2]), - name = "_xlnm.Print_Titles", - sheet = names(wb)[[sheet]], - localSheetId = sheet - 1L - ) - } else if (!is.null(printTitleCols) & !is.null(printTitleRows)) { - if (!is.numeric(printTitleRows)) { - stop("printTitleRows must be numeric.") - } - - if (!is.numeric(printTitleCols)) { - stop("printTitleCols must be numeric.") - } - - cols <- convert_to_excel_ref(cols = range(printTitleCols), LETTERS = LETTERS) - rows <- range(printTitleRows) - - cols <- paste(paste0("$", cols[1]), paste0("$", cols[2]), sep = ":") - rows <- paste(paste0("$", rows[1]), paste0("$", rows[2]), sep = ":") - localSheetId <- sheet - 1L - sheet <- names(wb)[[sheet]] - - wb$workbook$definedNames <- c( - wb$workbook$definedNames, - sprintf('\'%s\'!%s,\'%s\'!%s', localSheetId, sheet, cols, sheet, rows) - ) - } -} - - -#' @name protectWorksheet -#' @title Protect a worksheet from modifications -#' @description Protect or unprotect a worksheet from modifications by the user in the graphical user interface. Replaces an existing protection. -#' @author Reinhold Kainhofer -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param protect Whether to protect or unprotect the sheet (default=TRUE) -#' @param password (optional) password required to unprotect the worksheet -#' @param lockSelectingLockedCells Whether selecting locked cells is locked -#' @param lockSelectingUnlockedCells Whether selecting unlocked cells is locked -#' @param lockFormattingCells Whether formatting cells is locked -#' @param lockFormattingColumns Whether formatting columns is locked -#' @param lockFormattingRows Whether formatting rows is locked -#' @param lockInsertingColumns Whether inserting columns is locked -#' @param lockInsertingRows Whether inserting rows is locked -#' @param lockInsertingHyperlinks Whether inserting hyperlinks is locked -#' @param lockDeletingColumns Whether deleting columns is locked -#' @param lockDeletingRows Whether deleting rows is locked -#' @param lockSorting Whether sorting is locked -#' @param lockAutoFilter Whether auto-filter is locked -#' @param lockPivotTables Whether pivot tables are locked -#' @param lockObjects Whether objects are locked -#' @param lockScenarios Whether scenarios are locked -#' @export -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "S1") -#' writeDataTable(wb, 1, x = iris[1:30, ]) -#' # Formatting cells / columns is allowed , but inserting / deleting columns is protected: -#' protectWorksheet(wb, "S1", -#' protect = TRUE, -#' lockFormattingCells = FALSE, lockFormattingColumns = FALSE, -#' lockInsertingColumns = TRUE, lockDeletingColumns = TRUE -#' ) -#' -#' # Remove the protection -#' protectWorksheet(wb, "S1", protect = FALSE) -#' \dontrun{ -#' saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) -#' } -protectWorksheet <- function(wb, sheet, protect = TRUE, password = NULL, - lockSelectingLockedCells = NULL, lockSelectingUnlockedCells = NULL, - lockFormattingCells = NULL, lockFormattingColumns = NULL, lockFormattingRows = NULL, - lockInsertingColumns = NULL, lockInsertingRows = NULL, lockInsertingHyperlinks = NULL, - lockDeletingColumns = NULL, lockDeletingRows = NULL, - lockSorting = NULL, lockAutoFilter = NULL, lockPivotTables = NULL, - lockObjects = NULL, lockScenarios = NULL) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - # xml <- wb$worksheets[[sheet]]$sheetProtection variable not used - - props <- c() - - if (!missing(password) && !is.null(password)) { - props["password"] <- hashPassword(password) - } - - if (!missing(lockSelectingLockedCells) && !is.null(lockSelectingLockedCells)) { - props["selectLockedCells"] <- toString(as.numeric(lockSelectingLockedCells)) - } - if (!missing(lockSelectingUnlockedCells) && !is.null(lockSelectingUnlockedCells)) { - props["selectUnlockedCells"] <- toString(as.numeric(lockSelectingUnlockedCells)) - } - if (!missing(lockFormattingCells) && !is.null(lockFormattingCells)) { - props["formatCells"] <- toString(as.numeric(lockFormattingCells)) - } - if (!missing(lockFormattingColumns) && !is.null(lockFormattingColumns)) { - props["formatColumns"] <- toString(as.numeric(lockFormattingColumns)) - } - if (!missing(lockFormattingRows) && !is.null(lockFormattingRows)) { - props["formatRows"] <- toString(as.numeric(lockFormattingRows)) - } - if (!missing(lockInsertingColumns) && !is.null(lockInsertingColumns)) { - props["insertColumns"] <- toString(as.numeric(lockInsertingColumns)) - } - if (!missing(lockInsertingRows) && !is.null(lockInsertingRows)) { - props["insertRows"] <- toString(as.numeric(lockInsertingRows)) - } - if (!missing(lockInsertingHyperlinks) && !is.null(lockInsertingHyperlinks)) { - props["insertHyperlinks"] <- toString(as.numeric(lockInsertingHyperlinks)) - } - if (!missing(lockDeletingColumns) && !is.null(lockDeletingColumns)) { - props["deleteColumns"] <- toString(as.numeric(lockDeletingColumns)) - } - if (!missing(lockDeletingRows) && !is.null(lockDeletingRows)) { - props["deleteRows"] <- toString(as.numeric(lockDeletingRows)) - } - if (!missing(lockSorting) && !is.null(lockSorting)) { - props["sort"] <- toString(as.numeric(lockSorting)) - } - if (!missing(lockAutoFilter) && !is.null(lockAutoFilter)) { - props["autoFilter"] <- toString(as.numeric(lockAutoFilter)) - } - if (!missing(lockPivotTables) && !is.null(lockPivotTables)) { - props["pivotTables"] <- toString(as.numeric(lockPivotTables)) - } - if (!missing(lockObjects) && !is.null(lockObjects)) { - props["objects"] <- toString(as.numeric(lockObjects)) - } - if (!missing(lockScenarios) && !is.null(lockScenarios)) { - props["scenarios"] <- toString(as.numeric(lockScenarios)) - } - - if (protect) { - props["sheet"] <- "1" - wb$worksheets[[sheet]]$sheetProtection <- sprintf("", paste(names(props), '="', props, '"', collapse = " ", sep = "")) - } else { - wb$worksheets[[sheet]]$sheetProtection <- "" - } -} - - - -#' @name protectWorkbook -#' @title Protect a workbook from modifications -#' @description Protect or unprotect a workbook from modifications by the user in the graphical user interface. Replaces an existing protection. -#' @author Reinhold Kainhofer -#' @param wb A workbook object -#' @param protect Whether to protect or unprotect the sheet (default=TRUE) -#' @param password (optional) password required to unprotect the workbook -#' @param lockStructure Whether the workbook structure should be locked -#' @param lockWindows Whether the window position of the spreadsheet should be locked -#' @export -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "S1") -#' protectWorkbook(wb, protect = TRUE, password = "Password", lockStructure = TRUE) -#' \dontrun{ -#' saveWorkbook(wb, "WorkBook_Protection.xlsx", overwrite = TRUE) -#' } -#' # Remove the protection -#' protectWorkbook(wb, protect = FALSE) -#' \dontrun{ -#' saveWorkbook(wb, "WorkBook_Protection_unprotected.xlsx", overwrite = TRUE) -#' } -protectWorkbook <- function(wb, protect = TRUE, password = NULL, lockStructure = FALSE, lockWindows = FALSE) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - invisible(wb$protectWorkbook(protect = protect, password = password, lockStructure = lockStructure, lockWindows = lockWindows)) -} - - - - - -#' @name showGridLines -#' @title Set worksheet gridlines to show or hide. -#' @description Set worksheet gridlines to show or hide. -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param showGridLines A logical. If \code{FALSE}, grid lines are hidden. -#' @export -#' @examples -#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) -#' names(wb) ## list worksheets in workbook -#' showGridLines(wb, 1, showGridLines = FALSE) -#' showGridLines(wb, "testing", showGridLines = FALSE) -#' \dontrun{ -#' saveWorkbook(wb, "showGridLinesExample.xlsx", overwrite = TRUE) -#' } -showGridLines <- function(wb, sheet, showGridLines = FALSE) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - - if (!is.logical(showGridLines)) stop("showGridLines must be a logical") - - - sv <- wb$worksheets[[sheet]]$sheetViews - showGridLines <- as.integer(showGridLines) - ## If attribute exists gsub - if (grepl("showGridLines", sv)) { - sv <- gsub('showGridLines=".?[^"]', sprintf('showGridLines="%s', showGridLines), sv, perl = TRUE) - } else { - sv <- gsub(" length(wb$worksheets))) { - stop("Elements of order are greater than the number of worksheets") - } - - - old_ActiveSheet <- wb$ActiveSheet - - wb$sheetOrder <- value - wb$setactiveSheet(old_ActiveSheet) - - - invisible(wb) -} - - - - -#' @name convertToDate -#' @title Convert from excel date number to R Date type -#' @description Convert from excel date number to R Date type -#' @param x A vector of integers -#' @param origin date. Default value is for Windows Excel 2010 -#' @param ... additional parameters passed to as.Date() -#' @details Excel stores dates as number of days from some origin day -#' @seealso \code{\link{writeData}} -#' @export -#' @examples -#' ## 2014 April 21st to 25th -#' convertToDate(c(41750, 41751, 41752, 41753, 41754, NA)) -#' convertToDate(c(41750.2, 41751.99, NA, 41753)) -convertToDate <- function(x, origin = "1900-01-01", ...) { - x <- as.numeric(x) - notNa <- !is.na(x) - earlyDate <- x < 60 - if (origin == "1900-01-01") { - x[notNa] <- x[notNa] - 2 - x[earlyDate & notNa] <- x[earlyDate & notNa] + 1 - } - - return(as.Date(x, origin = origin, ...)) -} - - -#' @name convertToDateTime -#' @title Convert from excel time number to R POSIXct type. -#' @description Convert from excel time number to R POSIXct type. -#' @param x A numeric vector -#' @param origin date. Default value is for Windows Excel 2010 -#' @param ... Additional parameters passed to as.POSIXct -#' @details Excel stores dates as number of days from some origin date -#' @export -#' @examples -#' ## 2014-07-01, 2014-06-30, 2014-06-29 -#' x <- c(41821.8127314815, 41820.8127314815, NA, 41819, NaN) -#' convertToDateTime(x) -#' convertToDateTime(x, tz = "Australia/Perth") -#' convertToDateTime(x, tz = "UTC") -convertToDateTime <- function(x, origin = "1900-01-01", ...) { - sci_pen <- getOption("scipen") - options("scipen" = 10000) - on.exit(options("scipen" = sci_pen), add = TRUE) - - x <- as.numeric(x) - date <- convertToDate(x, origin) - - x <- x * 86400 - rem <- x %% 86400 - - hours <- as.integer(floor(rem / 3600)) - minutes_fraction <- rem %% 3600 - minutes_whole <- as.integer(floor(minutes_fraction / 60)) - secs <- minutes_fraction %% 60 - - y <- sprintf("%02d:%02d:%06.3f", hours, minutes_whole, secs) - notNA <- !is.na(x) - date_time <- rep(NA, length(x)) - date_time[notNA] <- as.POSIXct(paste(date[notNA], y[notNA]), ...) - - date_time <- .POSIXct(date_time) - - return(date_time) -} - - - -#' @name names -#' @title get or set worksheet names -#' @description get or set worksheet names -#' @aliases names.Workbook -#' @export -#' @method names Workbook -#' @param x A \code{Workbook} object -#' @examples -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, "S1") -#' addWorksheet(wb, "S2") -#' addWorksheet(wb, "S3") -#' -#' names(wb) -#' names(wb)[[2]] <- "S2a" -#' names(wb) -#' names(wb) <- paste("Sheet", 1:3) -names.Workbook <- function(x) { - nms <- x$sheet_names - nms <- replaceXMLEntities(nms) -} - -#' @rdname names -#' @param value a character vector the same length as wb -#' @export -`names<-.Workbook` <- function(x, value) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (any(duplicated(tolower(value)))) { - stop("Worksheet names must be unique.") - } - - existing_sheets <- x$sheet_names - inds <- which(value != existing_sheets) - - if (length(inds) == 0) { - return(invisible(x)) - } - - if (length(value) != length(x$worksheets)) { - stop(sprintf("names vector must have length equal to number of worksheets in Workbook [%s]", length(existing_sheets))) - } - - if (any(nchar(value) > 31)) { - warning("Worksheet names must less than 32 characters. Truncating names...") - value[nchar(value) > 31] <- sapply(value[nchar(value) > 31], substr, start = 1, stop = 31) - } - - for (i in inds) { - invisible(x$setSheetName(i, value[[i]])) - } - - invisible(x) -} - - - -#' @name createNamedRegion -#' @title Create a named region. -#' @description Create a named region -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param rows Numeric vector specifying rows to include in region -#' @param cols Numeric vector specifying columns to include in region -#' @param name Name for region. A character vector of length 1. Note region names musts be case-insensitive unique. -#' @details Region is given by: min(cols):max(cols) X min(rows):max(rows) -#' @export -#' @seealso \code{\link{getNamedRegions}} -#' @examples -#' ## create named regions -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' -#' ## specify region -#' writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) -#' createNamedRegion( -#' wb = wb, -#' sheet = 1, -#' name = "iris", -#' rows = 1:(nrow(iris) + 1), -#' cols = 1:ncol(iris) -#' ) -#' -#' -#' ## using writeData 'name' argument -#' writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) -#' -#' out_file <- tempfile(fileext = ".xlsx") -#' \dontrun{ -#' saveWorkbook(wb, out_file, overwrite = TRUE) -#' -#' ## see named regions -#' getNamedRegions(wb) ## From Workbook object -#' getNamedRegions(out_file) ## From xlsx file -#' -#' ## read named regions -#' df <- read.xlsx(wb, namedRegion = "iris") -#' head(df) -#' -#' df <- read.xlsx(out_file, namedRegion = "iris2") -#' head(df) -#' } -createNamedRegion <- function(wb, sheet, cols, rows, name) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - sheet <- wb$validateSheet(sheet) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (!is.numeric(rows)) { - stop("rows argument must be a numeric/integer vector") - } - - if (!is.numeric(cols)) { - stop("cols argument must be a numeric/integer vector") - } - - ## check name doesn't already exist - ## named region - - ex_names <- regmatches(wb$workbook$definedNames, regexpr('(?<=name=")[^"]+', wb$workbook$definedNames, perl = TRUE)) - ex_names <- tolower(replaceXMLEntities(ex_names)) - - if (tolower(name) %in% ex_names) { - stop(sprintf("Named region with name '%s' already exists!", name)) - } else if (grepl("^[A-Z]{1,3}[0-9]+$", name)) { - stop("name cannot look like a cell reference.") - } - - - cols <- round(cols) - rows <- round(rows) - - startCol <- min(cols) - endCol <- max(cols) - - startRow <- min(rows) - endRow <- max(rows) - - ref1 <- paste0("$", convert_to_excel_ref(cols = startCol, LETTERS = LETTERS), "$", startRow) - ref2 <- paste0("$", convert_to_excel_ref(cols = endCol, LETTERS = LETTERS), "$", endRow) - - invisible( - wb$createNamedRegion(ref1 = ref1, ref2 = ref2, name = name, sheet = wb$sheet_names[sheet]) - ) -} - - - - - - - -#' @name getNamedRegions -#' @title Get named regions -#' @description Return a vector of named regions in a xlsx file or -#' Workbook object -#' @param x An xlsx file or Workbook object -#' @export -#' @seealso \code{\link{createNamedRegion}} -#' @examples -#' ## create named regions -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' -#' ## specify region -#' writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) -#' createNamedRegion( -#' wb = wb, -#' sheet = 1, -#' name = "iris", -#' rows = 1:(nrow(iris) + 1), -#' cols = 1:ncol(iris) -#' ) -#' -#' -#' ## using writeData 'name' argument to create a named region -#' writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) -#' \dontrun{ -#' out_file <- tempfile(fileext = ".xlsx") -#' saveWorkbook(wb, out_file, overwrite = TRUE) -#' -#' ## see named regions -#' getNamedRegions(wb) ## From Workbook object -#' getNamedRegions(out_file) ## From xlsx file -#' -#' ## read named regions -#' df <- read.xlsx(wb, namedRegion = "iris") -#' head(df) -#' -#' df <- read.xlsx(out_file, namedRegion = "iris2") -#' head(df) -#' } -getNamedRegions <- function(x) { - UseMethod("getNamedRegions", x) -} - -#' @export -getNamedRegions.default <- function(x) { - if (!file.exists(x)) { - stop(sprintf("File '%s' does not exist.", x)) - } - - xmlDir <- file.path(tempdir(), "named_regions_tmp") - xmlFiles <- unzip(x, exdir = xmlDir) - - workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) - workbook <- unlist(readUTF8(workbook)) - - dn <- getChildlessNode(xml = removeHeadTag(workbook), tag = "definedName") - if (length(dn) == 0) { - return(NULL) - } - - dn_names <- get_named_regions_from_string(dn = dn) - - unlink(xmlDir, recursive = TRUE, force = TRUE) - - return(dn_names) -} - - -#' @export -getNamedRegions.Workbook <- function(x) { - dn <- x$workbook$definedNames - if (length(dn) == 0) { - return(NULL) - } - - dn_names <- get_named_regions_from_string(dn = dn) - - return(dn_names) -} - - - - - - -#' @name addFilter -#' @title Add column filters -#' @description Add excel column filters to a worksheet -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols columns to add filter to. -#' @param rows A row number. -#' @seealso \code{\link{writeData}} -#' @details adds filters to worksheet columns, same as filter parameters in writeData. -#' writeDataTable automatically adds filters to first row of a table. -#' NOTE Can only have a single filter per worksheet unless using tables. -#' @export -#' @seealso \code{\link{addFilter}} -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2") -#' addWorksheet(wb, "Sheet 3") -#' -#' writeData(wb, 1, iris) -#' addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) -#' -#' ## Equivalently -#' writeData(wb, 2, x = iris, withFilter = TRUE) -#' -#' ## Similarly -#' writeDataTable(wb, 3, iris) -#' \dontrun{ -#' saveWorkbook(wb, file = "addFilterExample.xlsx", overwrite = TRUE) -#' } -addFilter <- function(wb, sheet, rows, cols) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - - if (length(rows) != 1) { - stop("row must be a numeric of length 1.") - } - - if (!is.numeric(cols)) { - cols <- convertFromExcelRef(cols) - } - - wb$worksheets[[sheet]]$autoFilter <- sprintf('', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":")) - - invisible(wb) -} - - -#' @name removeFilter -#' @title Remove a worksheet filter -#' @description Removes filters from addFilter() and writeData() -#' @param wb A workbook object -#' @param sheet A vector of names or indices of worksheets -#' @export -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2") -#' addWorksheet(wb, "Sheet 3") -#' -#' writeData(wb, 1, iris) -#' addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) -#' -#' ## Equivalently -#' writeData(wb, 2, x = iris, withFilter = TRUE) -#' -#' ## Similarly -#' writeDataTable(wb, 3, iris) -#' -#' ## remove filters -#' removeFilter(wb, 1:2) ## remove filters -#' removeFilter(wb, 3) ## Does not affect tables! -#' \dontrun{ -#' saveWorkbook(wb, file = "removeFilterExample.xlsx", overwrite = TRUE) -#' } -removeFilter <- function(wb, sheet) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - for (s in sheet) { - s <- wb$validateSheet(s) - wb$worksheets[[s]]$autoFilter <- character(0) - } - - invisible(wb) -} - - - - - - - - - - - -#' @name setHeader -#' @title Set header for all worksheets -#' @description DEPRECATED -#' @author Alexander Walker -#' @param wb A workbook object -#' @param text header text. A character vector of length 1. -#' @param position Position of text in header. One of "left", "center" or "right" -#' @export -#' @examples -#' \dontrun{ -#' wb <- createWorkbook("Edgar Anderson") -#' addWorksheet(wb, "S1") -#' writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) -#' -#' ## set all headers -#' setHeader(wb, "This is a header", position = "center") -#' setHeader(wb, "To the left", position = "left") -#' setHeader(wb, "On the right", position = "right") -#' -#' ## set all footers -#' setFooter(wb, "Center Footer Here", position = "center") -#' setFooter(wb, "Bottom left", position = "left") -#' setFooter(wb, Sys.Date(), position = "right") -#' -#' saveWorkbook(wb, "headerHeaderExample.xlsx", overwrite = TRUE) -#' } -setHeader <- function(wb, text, position = "center") { - warning("This function is deprecated. Use function 'setHeaderFooter()'") - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - position <- tolower(position) - if (!position %in% c("left", "center", "right")) { - stop("Invalid position.") - } - - if (length(text) != 1) { - stop("Text argument must be a character vector of length 1") - } - - # sheet <- wb$validateSheet(1) variable not used - wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "head"] <- - as.character(text) -} - - -#' @name setFooter -#' @title Set footer for all worksheets -#' @description DEPRECATED -#' @author Alexander Walker -#' @param wb A workbook object -#' @param text footer text. A character vector of length 1. -#' @param position Position of text in footer. One of "left", "center" or "right" -#' @export -#' @examples -#' \dontrun{ -#' wb <- createWorkbook("Edgar Anderson") -#' addWorksheet(wb, "S1") -#' writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) -#' -#' ## set all headers -#' setHeader(wb, "This is a header", position = "center") -#' setHeader(wb, "To the left", position = "left") -#' setHeader(wb, "On the right", position = "right") -#' -#' ## set all footers -#' setFooter(wb, "Center Footer Here", position = "center") -#' setFooter(wb, "Bottom left", position = "left") -#' setFooter(wb, Sys.Date(), position = "right") -#' -#' saveWorkbook(wb, "headerFooterExample.xlsx", overwrite = TRUE) -#' } -setFooter <- function(wb, text, position = "center") { - warning("This function is deprecated. Use function 'setHeaderFooter()'") - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - position <- tolower(position) - if (!position %in% c("left", "center", "right")) { - stop("Invalid position.") - } - - if (length(text) != 1) { - stop("Text argument must be a character vector of length 1") - } - - # sheet <- wb$validateSheet(1) variable not used - wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "foot"] <- as.character(text) -} - - - - - - - - - - - -#' @name dataValidation -#' @title Add data validation to cells -#' @description Add Excel data validation to cells -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols Contiguous columns to apply conditional formatting to -#' @param rows Contiguous rows to apply conditional formatting to -#' @param type One of 'whole', 'decimal', 'date', 'time', 'textLength', 'list' (see examples) -#' @param operator One of 'between', 'notBetween', 'equal', -#' 'notEqual', 'greaterThan', 'lessThan', 'greaterThanOrEqual', 'lessThanOrEqual' -#' @param value a vector of length 1 or 2 depending on operator (see examples) -#' @param allowBlank logical -#' @param showInputMsg logical -#' @param showErrorMsg logical -#' @export -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2") -#' -#' writeDataTable(wb, 1, x = iris[1:30, ]) -#' -#' dataValidation(wb, 1, -#' col = 1:3, rows = 2:31, type = "whole", -#' operator = "between", value = c(1, 9) -#' ) -#' -#' dataValidation(wb, 1, -#' col = 5, rows = 2:31, type = "textLength", -#' operator = "between", value = c(4, 6) -#' ) -#' -#' -#' ## Date and Time cell validation -#' df <- data.frame( -#' "d" = as.Date("2016-01-01") + -5:5, -#' "t" = as.POSIXct("2016-01-01") + -5:5 * 10000 -#' ) -#' -#' writeData(wb, 2, x = df) -#' dataValidation(wb, 2, -#' col = 1, rows = 2:12, type = "date", -#' operator = "greaterThanOrEqual", value = as.Date("2016-01-01") -#' ) -#' -#' dataValidation(wb, 2, -#' col = 2, rows = 2:12, type = "time", -#' operator = "between", value = df$t[c(4, 8)] -#' ) -#' \dontrun{ -#' saveWorkbook(wb, "dataValidationExample.xlsx", overwrite = TRUE) -#' } -#' -#' -#' ###################################################################### -#' ## If type == 'list' -#' # operator argument is ignored. -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' addWorksheet(wb, "Sheet 2") -#' -#' writeDataTable(wb, sheet = 1, x = iris[1:30, ]) -#' writeData(wb, sheet = 2, x = sample(iris$Sepal.Length, 10)) -#' -#' dataValidation(wb, 1, col = 1, rows = 2:31, type = "list", value = "'Sheet 2'!$A$1:$A$10") -#' -#' # openXL(wb) -dataValidation <- function(wb, sheet, cols, rows, type, operator, value, allowBlank = TRUE, showInputMsg = TRUE, showErrorMsg = TRUE) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - ## rows and cols - if (!is.numeric(cols)) { - cols <- convertFromExcelRef(cols) - } - rows <- as.integer(rows) - - ## check length of value - if (length(value) > 2) { - stop("value argument must be length < 2") - } - - valid_types <- c( - "whole", - "decimal", - "date", - "time", ## need to conv - "textLength", - "list" - ) - - if (!tolower(type) %in% tolower(valid_types)) { - stop("Invalid 'type' argument!") - } - - - ## operator == 'between' we leave out - valid_operators <- c( - "between", - "notBetween", - "equal", - "notEqual", - "greaterThan", - "lessThan", - "greaterThanOrEqual", - "lessThanOrEqual" - ) - - if (tolower(type) != "list") { - if (!tolower(operator) %in% tolower(valid_operators)) { - stop("Invalid 'operator' argument!") - } - - operator <- valid_operators[tolower(valid_operators) %in% tolower(operator)][1] - } else { - operator <- "between" ## ignored - } - - if (!is.logical(allowBlank)) { - stop("Argument 'allowBlank' musts be logical!") - } - - if (!is.logical(showInputMsg)) { - stop("Argument 'showInputMsg' musts be logical!") - } - - if (!is.logical(showErrorMsg)) { - stop("Argument 'showErrorMsg' musts be logical!") - } - - ## All inputs validated - - type <- valid_types[tolower(valid_types) %in% tolower(type)][1] - - ## check input combinations - if (type == "date" & !"Date" %in% class(value)) { - stop("If type == 'date' value argument must be a Date vector.") - } - - if (type == "time" & !any(tolower(class(value)) %in% c("posixct", "posixt"))) { - stop("If type == 'date' value argument must be a POSIXct or POSIXlt vector.") - } - - - value <- head(value, 2) - allowBlank <- as.integer(allowBlank[1]) - showInputMsg <- as.integer(showInputMsg[1]) - showErrorMsg <- as.integer(showErrorMsg[1]) - - if (type == "list") { - invisible(wb$dataValidation_list( - sheet = sheet, - startRow = min(rows), - endRow = max(rows), - startCol = min(cols), - endCol = max(cols), - value = value, - allowBlank = allowBlank, - showInputMsg = showInputMsg, - showErrorMsg = showErrorMsg - )) - } else { - invisible(wb$dataValidation( - sheet = sheet, - startRow = min(rows), - endRow = max(rows), - startCol = min(cols), - endCol = max(cols), - type = type, - operator = operator, - value = value, - allowBlank = allowBlank, - showInputMsg = showInputMsg, - showErrorMsg = showErrorMsg - )) - } - - - - invisible(0) -} - - - - - - - - -#' @name getDateOrigin -#' @title Get the date origin an xlsx file is using -#' @description Return the date origin used internally by an xlsx or xlsm file -#' @author Alexander Walker -#' @param xlsxFile An xlsx or xlsm file. -#' @details Excel stores dates as the number of days from either 1904-01-01 or 1900-01-01. This function -#' checks the date origin being used in an Excel file and returns is so it can be used in \code{\link{convertToDate}} -#' @return One of "1900-01-01" or "1904-01-01". -#' @seealso \code{\link{convertToDate}} -#' @examples -#' -#' ## create a file with some dates -#' \dontrun{ -#' write.xlsx(as.Date("2015-01-10") - (0:4), file = "getDateOriginExample.xlsx") -#' m <- read.xlsx("getDateOriginExample.xlsx") -#' -#' ## convert to dates -#' do <- getDateOrigin(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -#' convertToDate(m[[1]], do) -#' } -#' @export -getDateOrigin <- function(xlsxFile) { - xlsxFile <- getFile(xlsxFile) - if (!file.exists(xlsxFile)) { - stop("File does not exist.") - } - - if (grepl("\\.xls$|\\.xlm$", xlsxFile)) { - stop("openxlsx can not read .xls or .xlm files!") - } - - ## create temp dir and unzip - xmlDir <- file.path(tempdir(), "_excelXMLRead") - xmlFiles <- unzip(xlsxFile, exdir = xmlDir) - - on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE) - - workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) - workbook <- paste(unlist(readUTF8(workbook)), collapse = "") - - if (grepl('date1904="1"|date1904="true"', workbook, ignore.case = TRUE)) { - origin <- "1904-01-01" - } else { - origin <- "1900-01-01" - } - - return(origin) -} - - - - - - - - -#' @name getSheetNames -#' @title Get names of worksheets -#' @description Returns the worksheet names within an xlsx file -#' @author Alexander Walker -#' @param file An xlsx or xlsm file. -#' @return Character vector of worksheet names. -#' @examples -#' getSheetNames(system.file("extdata", "readTest.xlsx", package = "openxlsx")) -#' @export -getSheetNames <- function(file) { - if (!file.exists(file)) { - stop("file does not exist.") - } - - if (grepl("\\.xls$|\\.xlm$", file)) { - stop("openxlsx can not read .xls or .xlm files!") - } - - ## create temp dir and unzip - xmlDir <- file.path(tempdir(), "_excelXMLRead") - xmlFiles <- unzip(file, exdir = xmlDir) - - on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE) - - workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) - workbook <- readUTF8(workbook) - workbook <- removeHeadTag(workbook) - sheets <- unlist(regmatches(workbook, gregexpr("(?<=).*(?=)", workbook, perl = TRUE))) - sheets <- unlist(regmatches(sheets, gregexpr("]*>", sheets, perl = TRUE))) - - ## Some veryHidden sheets do not have a sheet content and their rId is empty. - ## Such sheets need to be filtered out because otherwise their sheet names - ## occur in the list of all sheet names, leading to a wrong association - ## of sheet names with sheet indeces. - sheets <- grep('r:id="[[:blank:]]*"', sheets, invert = TRUE, value = TRUE) - - sheetNames <- unlist(regmatches(sheets, gregexpr('(?<=name=")[^"]+', sheets, perl = TRUE))) - sheetNames <- replaceXMLEntities(sheetNames) - - return(sheetNames) -} - - - - -#' @name sheetVisibility -#' @title Get/set worksheet visible state -#' @description Get and set worksheet visible state -#' @param wb A workbook object -#' @return Character vector of worksheet names. -#' @return Vector of "hidden", "visible", "veryHidden" -#' @examples -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, sheetName = "S1", visible = FALSE) -#' addWorksheet(wb, sheetName = "S2", visible = TRUE) -#' addWorksheet(wb, sheetName = "S3", visible = FALSE) -#' -#' sheetVisibility(wb) -#' sheetVisibility(wb)[1] <- TRUE ## show sheet 1 -#' sheetVisibility(wb)[2] <- FALSE ## hide sheet 2 -#' sheetVisibility(wb)[3] <- "hidden" ## hide sheet 3 -#' sheetVisibility(wb)[3] <- "veryHidden" ## hide sheet 3 from UI -#' @export -sheetVisibility <- function(wb) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - state <- rep("visible", length(wb$workbook$sheets)) - state[grepl("hidden", wb$workbook$sheets)] <- "hidden" - state[grepl("veryHidden", wb$workbook$sheets, ignore.case = TRUE)] <- "veryHidden" - - - return(state) -} - -#' @rdname sheetVisibility -#' @param value a logical/character vector the same length as sheetVisibility(wb) -#' @export -`sheetVisibility<-` <- function(wb, value) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - value <- tolower(as.character(value)) - if (!any(value %in% c("true", "visible"))) { - stop("A workbook must have atleast 1 visible worksheet.") - } - - value[value %in% "true"] <- "visible" - value[value %in% "false"] <- "hidden" - value[value %in% "veryhidden"] <- "veryHidden" - - - exState0 <- regmatches(wb$workbook$sheets, regexpr('(?<=state=")[^"]+', wb$workbook$sheets, perl = TRUE)) - exState <- tolower(exState0) - exState[exState %in% "true"] <- "visible" - exState[exState %in% "hidden"] <- "hidden" - exState[exState %in% "false"] <- "hidden" - exState[exState %in% "veryhidden"] <- "veryHidden" - - if (length(value) != length(wb$workbook$sheets)) { - stop(sprintf("value vector must have length equal to number of worksheets in Workbook [%s]", length(exState))) - } - - inds <- which(value != exState) - if (length(inds) == 0) { - return(invisible(wb)) - } - - for (i in seq_along(wb$worksheets)) { - wb$workbook$sheets[i] <- gsub(exState0[i], value[i], wb$workbook$sheets[i], fixed = TRUE) - } - - invisible(wb) -} - - - - - -#' @name pageBreak -#' @title add a page break to a worksheet -#' @description insert page breaks into a worksheet -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param i row or column number to insert page break. -#' @param type One of "row" or "column" for a row break or column break. -#' @export -#' @seealso \code{\link{addWorksheet}} -#' @examples -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' writeData(wb, sheet = 1, x = iris) -#' -#' pageBreak(wb, sheet = 1, i = 10, type = "row") -#' pageBreak(wb, sheet = 1, i = 20, type = "row") -#' pageBreak(wb, sheet = 1, i = 2, type = "column") -#' \dontrun{ -#' saveWorkbook(wb, "pageBreakExample.xlsx", TRUE) -#' } -#' ## In Excel: View tab -> Page Break Preview -pageBreak <- function(wb, sheet, i, type = "row") { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - - type <- tolower(type)[1] - if (!type %in% c("row", "column")) { - stop("'type' argument must be 'row' or 'column'.") - } - - if (!is.numeric(i)) { - stop("'i' must be numeric.") - } - i <- round(i) - - if (type == "row") { - wb$worksheets[[sheet]]$rowBreaks <- c( - wb$worksheets[[sheet]]$rowBreaks, - sprintf('', i) - ) - } else if (type == "column") { - wb$worksheets[[sheet]]$colBreaks <- c( - wb$worksheets[[sheet]]$colBreaks, - sprintf('', i) - ) - } - - - # wb$worksheets[[sheet]]$autoFilter <- sprintf('', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":")) - - invisible(wb) -} - - - - - - - - - - - - - - - - - - -#' @name conditionalFormat -#' @title Add conditional formatting to cells -#' @description DEPRECATED! USE \code{\link{conditionalFormatting}} -#' @author Alexander Walker -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols Columns to apply conditional formatting to -#' @param rows Rows to apply conditional formatting to -#' @param rule The condition under which to apply the formatting or a vector of colours. See examples. -#' @param style A style to apply to those cells that satisfy the rule. A Style object returned from createStyle() -#' @details DEPRECATED! USE \code{\link{conditionalFormatting}} -#' -#' Valid operators are "<", "<=", ">", ">=", "==", "!=". See Examples. -#' Default style given by: createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -#' @param type Either 'expression', 'colorscale' or 'databar'. If 'expression' the formatting is determined -#' by a formula. If colorScale cells are coloured based on cell value. See examples. -#' @seealso \code{\link{createStyle}} -#' @export -conditionalFormat <- function(wb, sheet, cols, rows, rule = NULL, style = NULL, type = "expression") { - warning("conditionalFormat() has been deprecated. Use conditionalFormatting().") - ## Rule always applies to top left of sqref, $ determine which cells the rule depends on - ## Rule for "databar" and colourscale are colours of length 2/3 or 1 respectively. - - type <- tolower(type) - if (tolower(type) %in% c("colorscale", "colourscale")) { - type <- "colorScale" - } else if (type == "databar") { - type <- "dataBar" - } else if (type != "expression") { - stop("Invalid type argument. Type must be 'expression', 'colourScale' or 'databar'") - } - - ## rows and cols - if (!is.numeric(cols)) { - cols <- convertFromExcelRef(cols) - } - rows <- as.integer(rows) - - ## check valid rule - if (type == "colorScale") { - if (!length(rule) %in% 2:3) { - stop("rule must be a vector containing 2 or 3 colours if type is 'colorScale'") - } - - rule <- validateColour(rule, errorMsg = "Invalid colour specified in rule.") - dxfId <- NULL - } else if (type == "dataBar") { - - ## If rule is NULL use default colour - if (is.null(rule)) { - rule <- "FF638EC6" - } else { - rule <- validateColour(rule, errorMsg = "Invalid colour specified in rule.") - } - - dxfId <- NULL - } else { ## else type == "expression" - - rule <- toupper(gsub(" ", "", rule)) - rule <- replaceIllegalCharacters(rule) - rule <- gsub("!=", "<>", rule) - rule <- gsub("==", "=", rule) - - if (!grepl("[A-Z]", substr(rule, 1, 2))) { - - ## formula looks like "operatorX" , attach top left cell to rule - rule <- paste0(getCellRefs(data.frame("x" = min(rows), "y" = min(cols))), rule) - } ## else, there is a letter in the formula and apply as is - - if (is.null(style)) { - style <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") - } - - invisible(dxfId <- wb$addDXFS(style)) - } - - - invisible(wb$conditionalFormatCell(sheet, - startRow = min(rows), - endRow = max(rows), - startCol = min(cols), - endCol = max(cols), - dxfId, - formula = rule, - type = type - )) - - invisible(0) -} - - - - -#' @name all.equal -#' @aliases all.equal.Workbook -#' @title Check equality of workbooks -#' @description Check equality of workbooks -#' @method all.equal Workbook -#' @param target A \code{Workbook} object -#' @param current A \code{Workbook} object -#' @param ... ignored -all.equal.Workbook <- function(target, current, ...) { - - - # print("Comparing workbooks...") - # ".rels", - # "app", - # "charts", - # "colWidths", - # "Content_Types", - # "core", - # "drawings", - # "drawings_rels", - # "media", - # "rowHeights", - # "workbook", - # "workbook.xml.rels", - # "worksheets", - # "sheetOrder" - # "sharedStrings", - # "tables", - # "tables.xml.rels", - # "theme" - - - ## TODO - # sheet_data - - x <- target - y <- current - - - - - nSheets <- length(names(x)) - failures <- NULL - - flag <- all(names(x$charts) %in% names(y$charts)) & all(names(y$charts) %in% names(x$charts)) - if (!flag) { - message("charts not equal") - failures <- c(failures, "wb$charts") - } - - flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$colWidths[[i]], y$colWidths[[i]])))) - if (!flag) { - message("colWidths not equal") - failures <- c(failures, "wb$colWidths") - } - - flag <- all(x$Content_Types %in% y$Content_Types) & all(y$Content_Types %in% x$Content_Types) - if (!flag) { - message("Content_Types not equal") - failures <- c(failures, "wb$Content_Types") - } - - flag <- all(unlist(x$core) == unlist(y$core)) - if (!flag) { - message("core not equal") - failures <- c(failures, "wb$core") - } - - - flag <- all(unlist(x$drawings) %in% unlist(y$drawings)) & all(unlist(y$drawings) %in% unlist(x$drawings)) - if (!flag) { - message("drawings not equal") - failures <- c(failures, "wb$drawings") - } - - flag <- all(unlist(x$drawings_rels) %in% unlist(y$drawings_rels)) & all(unlist(y$drawings_rels) %in% unlist(x$drawings_rels)) - if (!flag) { - message("drawings_rels not equal") - failures <- c(failures, "wb$drawings_rels") - } - - flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$drawings_rels[[i]], y$drawings_rels[[i]])))) - if (!flag) { - message("drawings_rels not equal") - failures <- c(failures, "wb$drawings_rels") - } - - - - - flag <- all(names(x$media) %in% names(y$media) & names(y$media) %in% names(x$media)) - if (!flag) { - message("media not equal") - failures <- c(failures, "wb$media") - } - - flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$rowHeights[[i]], y$rowHeights[[i]])))) - if (!flag) { - message("rowHeights not equal") - failures <- c(failures, "wb$rowHeights") - } - - flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(names(x$rowHeights[[i]]), names(y$rowHeights[[i]]))))) - if (!flag) { - message("rowHeights not equal") - failures <- c(failures, "wb$rowHeights") - } - - flag <- all(x$sharedStrings %in% y$sharedStrings) & all(y$sharedStrings %in% x$sharedStrings) & (length(x$sharedStrings) == length(y$sharedStrings)) - if (!flag) { - message("sharedStrings not equal") - failures <- c(failures, "wb$sharedStrings") - } - - - - # flag <- sapply(1:nSheets, function(i) isTRUE(all.equal(x$worksheets[[i]]$sheet_data, y$worksheets[[i]]$sheet_data))) - # if(!all(flag)){ - # - # tmp_x <- x$sheet_data[[which(!flag)[[1]]]] - # tmp_y <- y$sheet_data[[which(!flag)[[1]]]] - # - # tmp_x_e <- sapply(tmp_x, "[[", "r") - # tmp_y_e <- sapply(tmp_y, "[[", "r") - # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") - # if(any(flag)){ - # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) - # message(sprintf("r elements: %s", paste(which(flag), collapse = ", "))) - # return(FALSE) - # } - # - # tmp_x_e <- sapply(tmp_x, "[[", "t") - # tmp_y_e <- sapply(tmp_y, "[[", "t") - # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") - # if(any(flag)){ - # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) - # message(sprintf("t elements: %s", paste(which(isTRUE(flag)), collapse = ", "))) - # return(FALSE) - # } - # - # - # tmp_x_e <- sapply(tmp_x, "[[", "v") - # tmp_y_e <- sapply(tmp_y, "[[", "v") - # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") - # if(any(flag)){ - # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) - # message(sprintf("v elements: %s", paste(which(flag), collapse = ", "))) - # return(FALSE) - # } - # - # tmp_x_e <- sapply(tmp_x, "[[", "f") - # tmp_y_e <- sapply(tmp_y, "[[", "f") - # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") - # if(any(flag)){ - # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) - # message(sprintf("f elements: %s", paste(which(flag), collapse = ", "))) - # return(FALSE) - # } - # } - - - flag <- all(names(x$styles) %in% names(y$styles)) & all(names(y$styles) %in% names(x$styles)) - if (!flag) { - message("names styles not equal") - failures <- c(failures, "names of styles not equal") - } - - flag <- all(unlist(x$styles) %in% unlist(y$styles)) & all(unlist(y$styles) %in% unlist(x$styles)) - if (!flag) { - message("styles not equal") - failures <- c(failures, "styles not equal") - } - - - flag <- length(x$styleObjects) == length(y$styleObjects) - if (!flag) { - message("styleObjects lengths not equal") - failures <- c(failures, "styleObjects lengths not equal") - } - - - nStyles <- length(x$styleObjects) - if (nStyles > 0) { - for (i in 1:nStyles) { - sx <- x$styleObjects[[i]] - sy <- y$styleObjects[[i]] - - flag <- isTRUE(all.equal(sx$sheet, sy$sheet)) - if (!flag) { - message(sprintf("styleObjects '%s' sheet name not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' sheet name not equal", i)) - } - - - flag <- isTRUE(all.equal(sx$rows, sy$rows)) - if (!flag) { - message(sprintf("styleObjects '%s' rows not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' rows not equal", i)) - } - - flag <- isTRUE(all.equal(sx$cols, sy$cols)) - if (!flag) { - message(sprintf("styleObjects '%s' cols not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' cols not equal", i)) - } - - ## check style class equality - flag <- isTRUE(all.equal(sx$style$fontName, sy$style$fontName)) - if (!flag) { - message(sprintf("styleObjects '%s' fontName not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' fontName not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$fontColour, sy$style$fontColour)) - if (!flag) { - message(sprintf("styleObjects '%s' fontColour not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' fontColour not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$fontSize, sy$style$fontSize)) - if (!flag) { - message(sprintf("styleObjects '%s' fontSize not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' fontSize not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$fontFamily, sy$style$fontFamily)) - if (!flag) { - message(sprintf("styleObjects '%s' fontFamily not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' fontFamily not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$fontDecoration, sy$style$fontDecoration)) - if (!flag) { - message(sprintf("styleObjects '%s' fontDecoration not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' fontDecoration not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderTop, sy$style$borderTop)) - if (!flag) { - message(sprintf("styleObjects '%s' borderTop not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderTop not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderLeft, sy$style$borderLeft)) - if (!flag) { - message(sprintf("styleObjects '%s' borderLeft not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderLeft not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderRight, sy$style$borderRight)) - if (!flag) { - message(sprintf("styleObjects '%s' borderRight not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderRight not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderBottom, sy$style$borderBottom)) - if (!flag) { - message(sprintf("styleObjects '%s' borderBottom not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderBottom not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderTopColour, sy$style$borderTopColour)) - if (!flag) { - message(sprintf("styleObjects '%s' borderTopColour not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderTopColour not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderLeftColour, sy$style$borderLeftColour)) - if (!flag) { - message(sprintf("styleObjects '%s' borderLeftColour not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderLeftColour not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderRightColour, sy$style$borderRightColour)) - if (!flag) { - message(sprintf("styleObjects '%s' borderRightColour not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderRightColour not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$borderBottomColour, sy$style$borderBottomColour)) - if (!flag) { - message(sprintf("styleObjects '%s' borderBottomColour not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' borderBottomColour not equal", i)) - } - - - flag <- isTRUE(all.equal(sx$style$halign, sy$style$halign)) - if (!flag) { - message(sprintf("styleObjects '%s' halign not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' halign not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$valign, sy$style$valign)) - if (!flag) { - message(sprintf("styleObjects '%s' valign not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' valign not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$indent, sy$style$indent)) - if (!flag) { - message(sprintf("styleObjects '%s' indent not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' indent not equal", i)) - } - - - flag <- isTRUE(all.equal(sx$style$textRotation, sy$style$textRotation)) - if (!flag) { - message(sprintf("styleObjects '%s' textRotation not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' textRotation not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$numFmt, sy$style$numFmt)) - if (!flag) { - message(sprintf("styleObjects '%s' numFmt not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' numFmt not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$fill, sy$style$fill)) - if (!flag) { - message(sprintf("styleObjects '%s' fill not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' fill not equal", i)) - } - - flag <- isTRUE(all.equal(sx$style$wrapText, sy$style$wrapText)) - if (!flag) { - message(sprintf("styleObjects '%s' wrapText not equal", i)) - failures <- c(failures, sprintf("styleObjects '%s' wrapText not equal", i)) - } - } - } - - - flag <- all(x$sheet_names %in% y$sheet_names) & all(y$sheet_names %in% x$sheet_names) - if (!flag) { - message("names workbook not equal") - failures <- c(failures, "names workbook not equal") - } - - flag <- all(unlist(x$workbook) %in% unlist(y$workbook)) & all(unlist(y$workbook) %in% unlist(x$workbook)) - if (!flag) { - message("workbook not equal") - failures <- c(failures, "wb$workbook") - } - - flag <- all(unlist(x$workbook.xml.rels) %in% unlist(y$workbook.xml.rels)) & all(unlist(y$workbook.xml.rels) %in% unlist(x$workbook.xml.rels)) - if (!flag) { - message("workbook.xml.rels not equal") - failures <- c(failures, "wb$workbook.xml.rels") - } - - - for (i in 1:nSheets) { - ws_x <- x$worksheets[[i]] - ws_y <- y$worksheets[[i]] - - flag <- all(names(ws_x) %in% names(ws_y)) & all(names(ws_y) %in% names(ws_x)) - if (!flag) { - message(sprintf("names of worksheet elements for sheet %s not equal", i)) - failures <- c(failures, sprintf("names of worksheet elements for sheet %s not equal", i)) - } - - nms <- c( - "sheetPr", "dataValidations", "sheetViews", "cols", "pageMargins", - "extLst", "conditionalFormatting", "oleObjects", - "colBreaks", "dimension", "drawing", "sheetFormatPr", "tableParts", - "mergeCells", "hyperlinks", "headerFooter", "autoFilter", - "rowBreaks", "pageSetup", "freezePane", "legacyDrawingHF", "legacyDrawing" - ) - - for (j in nms) { - flag <- isTRUE(all.equal(gsub(" |\t", "", ws_x[[j]]), gsub(" |\t", "", ws_y[[j]]))) - if (!flag) { - message(sprintf("worksheet '%s', element '%s' not equal", i, j)) - failures <- c(failures, sprintf("worksheet '%s', element '%s' not equal", i, j)) - } - } - } - - - flag <- all(unlist(x$sheetOrder) %in% unlist(y$sheetOrder)) & all(unlist(y$sheetOrder) %in% unlist(x$sheetOrder)) - if (!flag) { - message("sheetOrder not equal") - failures <- c(failures, "sheetOrder not equal") - } - - - flag <- length(x$tables) == length(y$tables) - if (!flag) { - message("length of tables not equal") - failures <- c(failures, "length of tables not equal") - } - - flag <- all(names(x$tables) == names(y$tables)) - if (!flag) { - message("names of tables not equal") - failures <- c(failures, "names of tables not equal") - } - - flag <- all(unlist(x$tables) == unlist(y$tables)) - if (!flag) { - message("tables not equal") - failures <- c(failures, "tables not equal") - } - - - flag <- isTRUE(all.equal(x$tables.xml.rels, y$tables.xml.rels)) - if (!flag) { - message("tables.xml.rels not equal") - failures <- c(failures, "tables.xml.rels not equal") - } - - flag <- x$theme == y$theme - if (!flag) { - message("theme not equal") - failures <- c(failures, "theme not equal") - } - - if (!is.null(failures)) { - return(FALSE) - } - - - # "connections", - # "externalLinks", - # "externalLinksRels", - # "headFoot", - # "pivotTables", - # "pivotTables.xml.rels", - # "pivotDefinitions", - # "pivotRecords", - # "pivotDefinitionsRels", - # "queryTables", - # "slicers", - # "slicerCaches", - # "vbaProject", - - - return(TRUE) -} - - - -#' @name sheetVisible -#' @title Get worksheet visible state. -#' @description DEPRECATED - Use function 'sheetVisibility() -#' @author Alexander Walker -#' @param wb A workbook object -#' @return Character vector of worksheet names. -#' @return TRUE if sheet is visible, FALSE if sheet is hidden -#' @examples -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, sheetName = "S1", visible = FALSE) -#' addWorksheet(wb, sheetName = "S2", visible = TRUE) -#' addWorksheet(wb, sheetName = "S3", visible = FALSE) -#' -#' sheetVisible(wb) -#' sheetVisible(wb)[1] <- TRUE ## show sheet 1 -#' sheetVisible(wb)[2] <- FALSE ## hide sheet 2 -#' @export -sheetVisible <- function(wb) { - warning("This function is deprecated. Use function 'sheetVisibility()'") - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - state <- rep(TRUE, length(wb$workbook$sheets)) - state[grepl("hidden", wb$workbook$sheets)] <- FALSE - - return(state) -} - -#' @rdname sheetVisible -#' @param value a logical vector the same length as sheetVisible(wb) -#' @export -`sheetVisible<-` <- function(wb, value) { - warning("This function is deprecated. Use function 'sheetVisibility()'") - - if (!is.logical(value)) { - stop("value must be a logical vector.") - } - - if (!any(value)) { - stop("A workbook must have atleast 1 visible worksheet.") - } - - value <- as.character(value) - value[value %in% "TRUE"] <- "visible" - value[value %in% "FALSE"] <- "hidden" - - exState <- rep("visible", length(wb$workbook$sheets)) - exState[grepl("hidden", wb$workbook$sheets)] <- "hidden" - - if (length(value) != length(wb$workbook$sheets)) { - stop(sprintf("value vector must have length equal to number of worksheets in Workbook [%s]", length(exState))) - } - - inds <- which(value != exState) - if (length(inds) == 0) { - return(invisible(wb)) - } - - for (i in inds) { - wb$workbook$sheets[i] <- gsub(exState[i], value[i], wb$workbook$sheets[i]) - } - - invisible(wb) -} - - - -#' @name copyWorkbook -#' @title Copy a Workbook object. -#' @description Just a wrapper of wb$copy() -#' @param wb A workbook object -#' @return Workbook -#' @examples -#' -#' wb <- createWorkbook() -#' wb2 <- wb ## does not create a copy -#' wb3 <- copyWorkbook(wb) ## wrapper for wb$copy() -#' -#' addWorksheet(wb, "Sheet1") ## adds worksheet to both wb and wb2 but not wb3 -#' -#' names(wb) -#' names(wb2) -#' names(wb3) -#' @export -copyWorkbook <- function(wb) { - if (!inherits(wb, "Workbook")) { - stop("argument must be a Workbook.") - } - - return(wb$copy()) -} - - - - - -#' @name getTables -#' @title List Excel tables in a workbook -#' @description List Excel tables in a workbook -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @return character vector of table names on the specified sheet -#' @examples -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, sheetName = "Sheet 1") -#' writeDataTable(wb, sheet = "Sheet 1", x = iris) -#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) -#' -#' getTables(wb, sheet = "Sheet 1") -#' @export -getTables <- function(wb, sheet) { - if (!inherits(wb, "Workbook")) { - stop("argument must be a Workbook.") - } - - if (length(sheet) != 1) { - stop("sheet argument must be length 1") - } - - if (length(wb$tables) == 0) { - return(character(0)) - } - - sheet <- wb$validateSheet(sheetName = sheet) - - table_sheets <- attr(wb$tables, "sheet") - tables <- attr(wb$tables, "tableName") - refs <- names(wb$tables) - - refs <- refs[table_sheets == sheet & !grepl("openxlsx_deleted", tables, fixed = TRUE)] - tables <- tables[table_sheets == sheet & !grepl("openxlsx_deleted", tables, fixed = TRUE)] - - if (length(tables) > 0) { - attr(tables, "refs") <- refs - } - - return(tables) -} - - - - - -#' @name removeTable -#' @title Remove an Excel table in a workbook -#' @description List Excel tables in a workbook -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param table Name of table to remove. See \code{\link{getTables}} -#' @return character vector of table names on the specified sheet -#' @examples -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, sheetName = "Sheet 1") -#' addWorksheet(wb, sheetName = "Sheet 2") -#' writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") -#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) -#' -#' -#' removeWorksheet(wb, sheet = 1) ## delete worksheet removes table objects -#' -#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris") -#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) -#' -#' ## removeTable() deletes table object and all data -#' getTables(wb, sheet = 1) -#' removeTable(wb = wb, sheet = 1, table = "iris") -#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) -#' -#' getTables(wb, sheet = 1) -#' removeTable(wb = wb, sheet = 1, table = "iris") -#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) -#' \dontrun{ -#' saveWorkbook(wb = wb, file = "removeTableExample.xlsx", overwrite = TRUE) -#' } -#' -#' @export -removeTable <- function(wb, sheet, table) { - if (!inherits(wb, "Workbook")) { - stop("argument must be a Workbook.") - } - - if (length(sheet) != 1) { - stop("sheet argument must be length 1") - } - - if (length(table) != 1) { - stop("table argument must be length 1") - } - - ## delete table object and all data in it - sheet <- wb$validateSheet(sheetName = sheet) - - if (!table %in% attr(wb$tables, "tableName")) { - stop(sprintf("table '%s' does not exist.", table), call. = FALSE) - } - - ## get existing tables - table_sheets <- attr(wb$tables, "sheet") - table_names <- attr(wb$tables, "tableName") - refs <- names(wb$tables) - - ## delete table object (by flagging as deleted) - inds <- which(table_sheets %in% sheet & table_names %in% table) - table_name_original <- table_names[inds] - - table_names[inds] <- paste0(table_name_original, "_openxlsx_deleted") - attr(wb$tables, "tableName") <- table_names - - ## delete reference from worksheet to table - worksheet_table_names <- attr(wb$worksheets[[sheet]]$tableParts, "tableName") - to_remove <- which(worksheet_table_names == table_name_original) - - wb$worksheets[[sheet]]$tableParts <- wb$worksheets[[sheet]]$tableParts[-to_remove] - attr(wb$worksheets[[sheet]]$tableParts, "tableName") <- worksheet_table_names[-to_remove] - - - ## Now delete data from the worksheet - refs <- strsplit(refs[[inds]], split = ":")[[1]] - rows <- as.integer(gsub("[A-Z]", "", refs)) - rows <- seq(from = rows[1], to = rows[2], by = 1) - - cols <- convertFromExcelRef(refs) - cols <- seq(from = cols[1], to = cols[2], by = 1) - - ## now delete data - deleteData(wb = wb, sheet = sheet, rows = rows, cols = cols, gridExpand = TRUE) - - invisible(0) -} - -#' @name groupColumns -#' @title Group columns -#' @description Group a selection of columns -#' @author Joshua Sturm -#' @param wb A workbook object. -#' @param sheet A name or index of a worksheet. -#' @param cols Indices of cols to group. -#' @param hidden Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE. -#' @details Group columns together, with the option to hide them. -#' -#' NOTE: \code{\link{setColWidths}} has a conflicting \code{hidden} parameter; changing one will update the other. -#' @seealso \code{\link{ungroupColumns}} to ungroup columns. \code{\link{groupRows}} for grouping rows. -#' @export -#' -groupColumns <- function(wb, sheet, cols, hidden = FALSE) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - sheet <- wb$validateSheet(sheet) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - if (any(cols) < 1L) { - stop("Invalid columns selected (<= 0).") - } - - if (!is.logical(hidden)) { - stop("Hidden should be a logical value (TRUE/FALSE).") - } - - if (length(hidden) > length(cols)) { - stop("Hidden argument is of greater length than number of cols.") - } - - levels <- rep("1", length(cols)) - hidden <- rep(hidden, length.out = length(cols)) - - hidden <- hidden[!duplicated(cols)] - levels <- levels[!duplicated(cols)] - cols <- cols[!duplicated(cols)] - cols <- convertFromExcelRef(cols) - - if (length(wb$colWidths[[sheet]]) > 0) { - existing_cols <- names(wb$colWidths[[sheet]]) - existing_hidden <- attr(wb$colWidths[[sheet]], "hidden", exact = TRUE) - - if (any(existing_cols %in% cols)) { - for (i in intersect(existing_cols, cols)) { - width_hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i] - outline_hidden <- as.character(as.integer(hidden))[cols == i] - - if (width_hidden != outline_hidden) { - attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i] <- outline_hidden - } - } - - # cols <- cols[!cols %in% existing_cols] - # hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "name") %in% cols] - - # wb$colOutlineLevels[[sheet]] <- cols - # attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(hidden)) - } - } - - if (length(wb$colOutlineLevels[[sheet]]) > 0) { - existing_cols <- names(wb$colOutlineLevels[[sheet]]) - existing_levels <- unname(wb$colOutlineLevels[[sheet]]) - existing_hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden") - - # check if column is already grouped - flag <- existing_cols %in% cols - if (any(flag)) { - existing_cols <- existing_cols[!flag] - existing_levels <- existing_levels[!flag] - existing_hidden <- existing_hidden[!flag] - } - - all_names <- c(existing_cols, cols) - all_levels <- c(existing_levels, levels) - all_hidden <- c(existing_hidden, as.character(as.integer(hidden))) - - ord <- order(as.integer(all_names)) - all_names <- all_names[ord] - all_levels <- all_levels[ord] - all_hidden <- all_hidden[ord] - - - names(all_levels) <- all_names - wb$colOutlineLevels[[sheet]] <- all_levels - levels <- all_levels - attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(all_hidden)) - hidden <- all_hidden - } else { - names(levels) <- cols - wb$colOutlineLevels[[sheet]] <- levels - attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(hidden)) - } - - invisible(0) -} - -#' @name ungroupColumns -#' @title Ungroup Columns -#' @description Ungroup a selection of columns -#' @author Joshua Sturm -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param cols Indices of columns to ungroup -#' @details If column was previously hidden, it will now be shown -#' @seealso \code{\link{ungroupRows}} To ungroup rows -#' @export - -ungroupColumns <- function(wb, sheet, cols) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - - if (!is.numeric(cols)) { - cols <- convertFromExcelRef(cols) - } - - if (any(cols) < 1L) { - stop("Invalid columns selected (<= 0).") - } - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - customCols <- as.integer(names(wb$colOutlineLevels[[sheet]])) - removeInds <- which(customCols %in% cols) - - # Check if any selected columns are already grouped - if (length(removeInds) > 0) { - remainingCols <- customCols[-removeInds] - if (length(remainingCols) == 0) { - wb$colOutlineLevels[[sheet]] <- list() - wb$worksheets[[sheet]]$sheetFormatPr <- sub(' outlineLevelCol="1"', "", wb$worksheets[[sheet]]$sheetFormatPr) - } else { - rem_widths <- wb$colOutlineLevels[[sheet]][-removeInds] - names(rem_widths) <- as.character(remainingCols) - wb$colOutlineLevels[[sheet]] <- rem_widths - } - } - - if (length(wb$colWidths[[sheet]]) > 0) { - if (any(cols %in% names(wb$colWidths[[sheet]]))) { - attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") %in% cols] <- "0" - } - } -} - -#' @name groupRows -#' @title Group Rows -#' @description Group a selection of rows -#' @author Joshua Sturm -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param rows Indices of rows to group -#' @param hidden Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE -#' @seealso \code{\link{ungroupRows}} to ungroup rows. \code{\link{groupColumns}} for grouping columns. -#' @export - -groupRows <- function(wb, sheet, rows, hidden = FALSE) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - - if (length(hidden) > length(rows)) { - stop("Hidden argument is of greater length than number of rows.") - } - - if (!is.logical(hidden)) { - stop("Hidden should be a logical value (TRUE/FALSE).") - } - - if (any(rows) < 1L) { - stop("Invalid rows entered (<= 0).") - } - - hidden <- rep(as.character(as.integer(hidden)), length.out = length(rows)) - - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - levels <- rep("1", length(rows)) - - # Remove duplicates - hidden <- hidden[!duplicated(rows)] - levels <- levels[!duplicated(rows)] - rows <- rows[!duplicated(rows)] - - names(levels) <- rows - - wb$groupRows(sheet = sheet, rows = rows, hidden = hidden, levels = levels) -} - -#' @name ungroupRows -#' @title Ungroup Rows -#' @description Ungroup a selection of rows -#' @author Joshua Sturm -#' @param wb A workbook object -#' @param sheet A name or index of a worksheet -#' @param rows Indices of rows to ungroup -#' @details If row was previously hidden, it will now be shown -#' @seealso \code{\link{ungroupColumns}} -#' @export - -ungroupRows <- function(wb, sheet, rows) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - sheet <- wb$validateSheet(sheet) - - if (any(rows) < 1L) { - stop("Invalid rows entered (<= 0).") - } - - customRows <- as.integer(names(wb$outlineLevels[[sheet]])) - removeInds <- which(customRows %in% rows) - if (length(removeInds) > 0) { - wb$outlineLevels[[sheet]] <- wb$outlineLevels[[sheet]][-removeInds] - } - - if (length(wb$outlineLevels[[sheet]]) == 0) { - wb$worksheets[[sheet]]$sheetFormatPr <- sub(' outlineLevelRow="1"', "", wb$worksheets[[sheet]]$sheetFormatPr) - } -} - - - - -#' @name addCreator -#' @title Add another author to the meta data of the file. -#' @author Philipp Schauberger -#' @description Just a wrapper of wb$addCreator() -#' @param wb A workbook object -#' @param Creator A string object with the name of the creator -#' @examples -#' -#' wb <- createWorkbook() -#' addCreator(wb, "test") -#' @export -addCreator <- function(wb, Creator) { - if (!inherits(wb, "Workbook")) { - stop("argument must be a Workbook.") - } - - invisible(wb$addCreator(Creator)) -} - -#' @name setLastModifiedBy -#' @title Add another author to the meta data of the file. -#' @author Philipp Schauberger -#' @description Just a wrapper of wb$changeLastModifiedBy() -#' @param wb A workbook object -#' @param LastModifiedBy A string object with the name of the LastModifiedBy-User -#' @examples -#' -#' wb <- createWorkbook() -#' setLastModifiedBy(wb, "test") -#' @export -setLastModifiedBy <- function(wb, LastModifiedBy) { - if (!inherits(wb, "Workbook")) { - stop("argument must be a Workbook.") - } - - invisible(wb$changeLastModifiedBy(LastModifiedBy)) -} - - - -#' @name getCreators -#' @title Add another author to the meta data of the file. -#' @description Just a wrapper of wb$getCreators() -#' Get the names of the -#' @param wb A workbook object -#' @author Philipp Schauberger -#' @return vector of creators -#' @examples -#' -#' wb <- createWorkbook() -#' getCreators(wb) -#' @export -getCreators <- function(wb) { - if (!inherits(wb, "Workbook")) { - stop("argument must be a Workbook.") - } - - return(wb$getCreators()) -} - -#' @name activeSheet -#' @title Get/set active sheet of the workbook -#' @author Philipp Schauberger -#' @description Get and set active sheet of the workbook -#' @param wb A workbook object -#' @return return the active sheet of the workbook -#' @examples -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, sheetName = "S1") -#' addWorksheet(wb, sheetName = "S2") -#' addWorksheet(wb, sheetName = "S3") -#' -#' activeSheet(wb) # default value is the first sheet active -#' activeSheet(wb) <- 1 ## active sheet S1 -#' activeSheet(wb) -#' activeSheet(wb) <- "S2" ## active sheet S2 -#' activeSheet(wb) -#' @export -activeSheet <- function(wb) { - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - - return(wb$ActiveSheet) -} - -#' @rdname activeSheet -#' @param value index of the active sheet or name of the active sheet -#' @export -`activeSheet<-` <- function(wb, value) { - od <- getOption("OutDec") - options("OutDec" = ".") - on.exit(expr = options("OutDec" = od), add = TRUE) - - if (!"Workbook" %in% class(wb)) { - stop("First argument must be a Workbook.") - } - - - - invisible(wb$setactiveSheet(value)) - - invisible(wb) -} + +#' @name createWorkbook +#' @title Create a new Workbook object +#' @description Create a new Workbook object +#' @param creator Creator of the workbook (your name). Defaults to login username +#' @param title Workbook properties title +#' @param subject Workbook properties subject +#' @param category Workbook properties category +#' @author Alexander Walker +#' @return Workbook object +#' @export +#' @seealso [loadWorkbook()] +#' @seealso [saveWorkbook()] +#' @import methods +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook() +#' +#' ## Save workbook to working directory +#' \dontrun{ +#' saveWorkbook(wb, file = "createWorkbookExample.xlsx", overwrite = TRUE) +#' } +#' +#' ## Set Workbook properties +#' wb <- createWorkbook( +#' creator = "Me", +#' title = "title here", +#' subject = "this & that", +#' category = "something" +#' ) +createWorkbook <- function(creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"), Sys.getenv("USER")), + title = NULL, + subject = NULL, + category = NULL) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + ## check all inputs are valid + if (length(creator) > 1) creator <- creator[[1]] + if (length(creator) == 0) creator <- "" + if (!"character" %in% class(creator)) creator <- "" + + if (length(title) > 1) title <- title[[1]] + if (length(subject) > 1) subject <- subject[[1]] + if (length(category) > 1) category <- category[[1]] + + if (!is.null(title)) { + if (!"character" %in% class(title)) { + stop("title must be a string") + } + } + + if (!is.null(subject)) { + if (!"character" %in% class(subject)) { + stop("subject must be a string") + } + } + + if (!is.null(category)) { + if (!"character" %in% class(category)) { + stop("category must be a string") + } + } + + invisible(Workbook$new(creator = creator, title = title, subject = subject, category = category)) +} + + +#' @name saveWorkbook +#' @title save Workbook to file +#' @description save a Workbook object to file +#' @author Alexander Walker, Philipp Schauberger +#' @param wb A Workbook object to write to file +#' @param file A character string naming an xlsx file +#' @param overwrite If `TRUE`, overwrite any existing file. +#' @param returnValue If `TRUE`, returns `TRUE` in case of a success, else `FALSE`. +#' If flag is `FALSE`, then no return value is returned. +#' @seealso [createWorkbook()] +#' @seealso [addWorksheet()] +#' @seealso [loadWorkbook()] +#' @seealso [writeData()] +#' @seealso [writeDataTable()] +#' @export +#' @examples +#' ## Create a new workbook and add a worksheet +#' wb <- createWorkbook("Creator of workbook") +#' addWorksheet(wb, sheetName = "My first worksheet") +#' +#' ## Save workbook to working directory +#' \dontrun{ +#' saveWorkbook(wb, file = "saveWorkbookExample.xlsx", overwrite = TRUE) +#' } +saveWorkbook <- function(wb, file, overwrite = FALSE, returnValue = FALSE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (!is.logical(overwrite)) { + overwrite <- FALSE + } + + if (!is.logical(returnValue)) { + returnValue <- FALSE + } + + if (file.exists(file) & !overwrite) { + stop("File already exists!") + } + + xlsx_file <- wb$saveWorkbook() + + result <- file.copy(from = xlsx_file, to = file, overwrite = overwrite) + + ## delete temporary dir + unlink(dirname(xlsx_file), force = TRUE, recursive = TRUE) + if (returnValue == FALSE) { + invisible(1) + } else { + return(result) + } +} + + +#' @name mergeCells +#' @title Merge cells within a worksheet +#' @description Merge cells within a worksheet +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols Columns to merge +#' @param rows corresponding rows to merge +#' @details As merged region must be rectangular, only min and max of cols and rows are used. +#' @author Alexander Walker +#' @seealso [removeCellMerge()] +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook() +#' +#' ## Add a worksheet +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2") +#' +#' ## Merge cells: Row 2 column C to F (3:6) +#' mergeCells(wb, "Sheet 1", cols = 2, rows = 3:6) +#' +#' ## Merge cells:Rows 10 to 20 columns A to J (1:10) +#' mergeCells(wb, 1, cols = 1:10, rows = 10:20) +#' +#' ## Intersecting merges +#' mergeCells(wb, 2, cols = 1:10, rows = 1) +#' mergeCells(wb, 2, cols = 5:10, rows = 2) +#' mergeCells(wb, 2, cols = c(1, 10), rows = 12) ## equivalent to 1:10 as only min/max are used +#' # mergeCells(wb, 2, cols = 1, rows = c(1,10)) # Throws error because intersects existing merge +#' +#' ## remove merged cells +#' removeCellMerge(wb, 2, cols = 1, rows = 1) # removes any intersecting merges +#' mergeCells(wb, 2, cols = 1, rows = 1:10) # Now this works +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "mergeCellsExample.xlsx", overwrite = TRUE) +#' } +mergeCells <- function(wb, sheet, cols, rows) { + od <- getOption("OutDec") + options("OutDec" = ".") + on.exit(expr = options("OutDec" = od), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (!is.numeric(cols)) { + cols <- convertFromExcelRef(cols) + } + + wb$mergeCells(sheet, startRow = min(rows), endRow = max(rows), startCol = min(cols), endCol = max(cols)) +} + + + +#' @name int2col +#' @title Convert integer to Excel column +#' @description Converts an integer to an Excel column label. +#' @param x A numeric vector +#' @export +#' @examples +#' int2col(1:10) +int2col <- function(x) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!is.numeric(x)) { + stop("x must be numeric.") + } + + convert_to_excel_ref(cols = x, LETTERS = LETTERS) +} + +#' @name col2int +#' @title Convert Excel column to integer +#' @description Converts an Excel column label to an integer. +#' @param x A character vector +#' @export +#' @examples +#' col2int(LETTERS) +col2int <- function(x) { + + if (!is.character(x)) { + stop("x must be character") + } + + as.integer(sapply(x, cell_ref_to_col)) +} + + +#' @name removeCellMerge +#' @title Create a new Workbook object +#' @description Unmerges any merged cells that intersect +#' with the region specified by, min(cols):max(cols) X min(rows):max(rows) +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols vector of column indices +#' @param rows vector of row indices +#' @author Alexander Walker +#' @export +#' @seealso [mergeCells()] +removeCellMerge <- function(wb, sheet, cols, rows) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + cols <- convertFromExcelRef(cols) + rows <- as.integer(rows) + + wb$removeCellMerge(sheet, startRow = min(rows), endRow = max(rows), startCol = min(cols), endCol = max(cols)) +} + + +#' @name sheets +#' @title Returns names of worksheets. +#' @description DEPRECATED. Use names(). +#' @param wb A workbook object +#' @return Name of worksheet(s) for a given index +#' @author Alexander Walker +#' @seealso [names()] to rename a worksheet in a Workbook +#' @details DEPRECATED. Use [names()] +#' @export +#' @examples +#' +#' ## Create a new workbook +#' wb <- createWorkbook() +#' +#' ## Add some worksheets +#' addWorksheet(wb, "Worksheet Name") +#' addWorksheet(wb, "This is worksheet 2") +#' addWorksheet(wb, "The third worksheet") +#' +#' ## Return names of sheets, can not be used for assignment. +#' names(wb) +#' # openXL(wb) +#' +#' names(wb) <- c("A", "B", "C") +#' names(wb) +#' # openXL(wb) +sheets <- function(wb) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + nms <- wb$sheet_names + nms <- replaceXMLEntities(nms) + + return(nms) +} + + + +#' @name addWorksheet +#' @title Add a worksheet to a workbook +#' @description Add a worksheet to a Workbook object +#' @author Alexander Walker +#' @param wb A Workbook object to attach the new worksheet +#' @param sheetName A name for the new worksheet +#' @param gridLines A logical. If `FALSE`, the worksheet grid lines will be hidden. +#' @param tabColour Colour of the worksheet tab. A valid colour (belonging to colours()) or a valid hex colour beginning with "#" +#' @param zoom A numeric between 10 and 400. Worksheet zoom level as a percentage. +#' @param header document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. +#' @param footer document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. +#' @param evenHeader document header for even pages. +#' @param evenFooter document footer for even pages. +#' @param firstHeader document header for first page only. +#' @param firstFooter document footer for first page only. +#' @param visible If FALSE, sheet is hidden else visible. +#' @param paperSize An integer corresponding to a paper size. See ?pageSetup for details. +#' @param orientation One of "portrait" or "landscape" +#' @param hdpi Horizontal DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.hdpi" = X) +#' @param vdpi Vertical DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.vdpi" = X) +#' @details Headers and footers can contain special tags +#' \itemize{ +#' \item{**&\[Page\]**}{ Page number} +#' \item{**&\[Pages\]**}{ Number of pages} +#' \item{**&\[Date\]**}{ Current date} +#' \item{**&\[Time\]**}{ Current time} +#' \item{**&\[Path\]**}{ File path} +#' \item{**&\[File\]**}{ File name} +#' \item{**&\[Tab\]**}{ Worksheet name} +#' } +#' @return XML tree +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook("Fred") +#' +#' ## Add 3 worksheets +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2", gridLines = FALSE) +#' addWorksheet(wb, "Sheet 3", tabColour = "red") +#' addWorksheet(wb, "Sheet 4", gridLines = FALSE, tabColour = "#4F81BD") +#' +#' ## Headers and Footers +#' addWorksheet(wb, "Sheet 5", +#' header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), +#' footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), +#' evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), +#' evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), +#' firstHeader = c("TOP", "OF FIRST", "PAGE"), +#' firstFooter = c("BOTTOM", "OF FIRST", "PAGE") +#' ) +#' +#' addWorksheet(wb, "Sheet 6", +#' header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), +#' footer = c("&[Path]&[File]", NA, "&[Tab]"), +#' firstHeader = c(NA, "Center Header of First Page", NA), +#' firstFooter = c(NA, "Center Footer of First Page", NA) +#' ) +#' +#' addWorksheet(wb, "Sheet 7", +#' header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), +#' footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") +#' ) +#' +#' addWorksheet(wb, "Sheet 8", +#' firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), +#' firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") +#' ) +#' +#' ## Need data on worksheet to see all headers and footers +#' writeData(wb, sheet = 5, 1:400) +#' writeData(wb, sheet = 6, 1:400) +#' writeData(wb, sheet = 7, 1:400) +#' writeData(wb, sheet = 8, 1:400) +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "addWorksheetExample.xlsx", overwrite = TRUE) +#' } +addWorksheet <- function(wb, + sheetName, + gridLines = openxlsx_getOp("gridLines", TRUE), + tabColour = NULL, + zoom = 100, + header = openxlsx_getOp("header"), + footer = openxlsx_getOp("footer"), + evenHeader = openxlsx_getOp("evenHeader"), + evenFooter = openxlsx_getOp("evenFooter"), + firstHeader = openxlsx_getOp("firstHeader"), + firstFooter = openxlsx_getOp("firstFooter"), + visible = TRUE, + paperSize = openxlsx_getOp("paperSize", 9), + orientation = openxlsx_getOp("orientation", "portrait"), + vdpi = openxlsx_getOp("vdpi", 300), + hdpi = openxlsx_getOp("hdpi", 300)) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (inherits(wb, "list")) { + wb <- wb[[1]] + } + + if (!inherits(wb, "Workbook")) { + stop("wb must be a Workbok", call. = FALSE) + } + + # Set NULL defaults + gridLines <- gridLines %||% TRUE + paperSize <- paperSize %||% 9 + orientation <- orientation %||% "portrait" + vdpi <- vdpi %||% 300 + hdpi <- hdpi %||% 300 + + if (tolower(sheetName) %in% tolower(wb$sheet_names)) { + stop(paste0("A worksheet by the name '", sheetName, "' already exists! Sheet names must be unique case-insensitive.")) + } + + if (!is.logical(gridLines) | length(gridLines) > 1) { + stop("gridLines must be a logical of length 1.") + } + + if (nchar(sheetName) > 31) { + stop(paste0("sheetName '", sheetName, "' too long! Max length is 31 characters.")) + } + + if (!is.null(tabColour)) { + tabColour <- validateColour(tabColour, "Invalid tabColour in addWorksheet.") + } + + if (!is.numeric(zoom)) { + stop("zoom must be numeric") + } + + if (!is.character(sheetName)) { + sheetName <- as.character(sheetName) + } + + if (!is.null(header) & length(header) != 3) { + stop("header must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(footer) & length(footer) != 3) { + stop("footer must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(evenHeader) & length(evenHeader) != 3) { + stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(evenFooter) & length(evenFooter) != 3) { + stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(firstHeader) & length(firstHeader) != 3) { + stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(firstFooter) & length(firstFooter) != 3) { + stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.") + } + + visible <- tolower(visible[1]) + if (!visible %in% c("true", "false", "hidden", "visible", "veryhidden")) { + stop("visible must be one of: TRUE, FALSE, 'hidden', 'visible', 'veryHidden'") + } + + orientation <- tolower(orientation) + if (!orientation %in% c("portrait", "landscape")) { + stop("orientation must be 'portrait' or 'landscape'.") + } + + vdpi <- as.integer(vdpi) + if (is.na(vdpi)) { + stop("vdpi must be numeric") + } + + hdpi <- as.integer(hdpi) + if (is.na(hdpi)) { + stop("hdpi must be numeric") + } + + + + ## Invalid XML characters + sheetName <- replaceIllegalCharacters(sheetName) + + invisible(wb$addWorksheet( + sheetName = sheetName, + showGridLines = gridLines, + tabColour = tabColour, + zoom = zoom[1], + oddHeader = headerFooterSub(header), + oddFooter = headerFooterSub(footer), + evenHeader = headerFooterSub(evenHeader), + evenFooter = headerFooterSub(evenFooter), + firstHeader = headerFooterSub(firstHeader), + firstFooter = headerFooterSub(firstFooter), + visible = visible, + paperSize = paperSize, + orientation = orientation, + vdpi = vdpi, + hdpi = hdpi + )) +} + +#' @name cloneWorksheet +#' @title Clone a worksheet to a workbook +#' @description Clone a worksheet to a Workbook object +#' @author Reinhold Kainhofer +#' @param wb A Workbook object to attach the new worksheet +#' @param sheetName A name for the new worksheet +#' @param clonedSheet The name of the existing worksheet to be cloned. +#' @return XML tree +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook("Fred") +#' +#' ## Add 3 worksheets +#' addWorksheet(wb, "Sheet 1") +#' cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "cloneWorksheetExample.xlsx", overwrite = TRUE) +#' } +cloneWorksheet <- function(wb, sheetName, clonedSheet) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (tolower(sheetName) %in% tolower(wb$sheet_names)) { + stop("A worksheet by that name already exists! Sheet names must be unique case-insensitive.") + } + + if (nchar(sheetName) > 31) { + stop("sheetName too long! Max length is 31 characters.") + } + + if (!is.character(sheetName)) { + sheetName <- as.character(sheetName) + } + + ## Invalid XML characters + sheetName <- replaceIllegalCharacters(sheetName) + + invisible(wb$cloneWorksheet(sheetName = sheetName, clonedSheet = clonedSheet)) +} + + +#' @name renameWorksheet +#' @title Rename a worksheet +#' @description Rename a worksheet +#' @author Alexander Walker +#' @param wb A Workbook object containing a worksheet +#' @param sheet The name or index of the worksheet to rename +#' @param newName The new name of the worksheet. No longer than 31 chars. +#' @details DEPRECATED. Use [names()] +#' @export +#' @examples +#' +#' ## Create a new workbook +#' wb <- createWorkbook("CREATOR") +#' +#' ## Add 3 worksheets +#' addWorksheet(wb, "Worksheet Name") +#' addWorksheet(wb, "This is worksheet 2") +#' addWorksheet(wb, "Not the best name") +#' +#' #' ## rename all worksheets +#' names(wb) <- c("A", "B", "C") +#' +#' +#' ## Rename worksheet 1 & 3 +#' renameWorksheet(wb, 1, "New name for sheet 1") +#' names(wb)[[1]] <- "New name for sheet 1" +#' names(wb)[[3]] <- "A better name" +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "renameWorksheetExample.xlsx", overwrite = TRUE) +#' } +renameWorksheet <- function(wb, sheet, newName) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + invisible(wb$setSheetName(sheet, newName)) +} + + +#' @name convertFromExcelRef +#' @title Convert excel column name to integer index +#' @description Convert excel column name to integer index e.g. "J" to 10 +#' @param col An excel column reference +#' @export +#' @examples +#' convertFromExcelRef("DOG") +#' convertFromExcelRef("COW") +#' +#' ## numbers will be removed +#' convertFromExcelRef("R22") +convertFromExcelRef <- function(col) { + + ## increase scipen to avoid writing in scientific + op <- get_set_options() + on.exit(options(op), add = TRUE) + + col <- toupper(col) + charFlag <- grepl("[A-Z]", col) + if (any(charFlag)) { + col[charFlag] <- gsub("[0-9]", "", col[charFlag]) + d <- lapply(strsplit(col[charFlag], split = ""), function(x) match(rev(x), LETTERS)) + col[charFlag] <- unlist(lapply(seq_along(d), function(i) { + sum(d[[i]] * (26^( + seq_along(d[[i]]) - 1))) + })) + } + + col[!charFlag] <- as.integer(col[!charFlag]) + + return(as.integer(col)) +} + + + +#' @name createStyle +#' @title Create a cell style +#' @description Create a new style to apply to worksheet cells +#' @author Alexander Walker +#' @seealso [addStyle()] +#' @param fontName A name of a font. Note the font name is not validated. If fontName is NULL, +#' the workbook base font is used. (Defaults to Calibri) +#' @param fontColour Colour of text in cell. A valid hex colour beginning with "#" +#' or one of colours(). If fontColour is NULL, the workbook base font colours is used. +#' (Defaults to black) +#' @param fontSize Font size. A numeric greater than 0. +#' If fontSize is NULL, the workbook base font size is used. (Defaults to 11) +#' @param numFmt Cell formatting +#' \itemize{ +#' \item{**GENERAL**} +#' \item{**NUMBER**} +#' \item{**CURRENCY**} +#' \item{**ACCOUNTING**} +#' \item{**DATE**} +#' \item{**LONGDATE**} +#' \item{**TIME**} +#' \item{**PERCENTAGE**} +#' \item{**FRACTION**} +#' \item{**SCIENTIFIC**} +#' \item{**TEXT**} +#' \item{**COMMA**{ for comma separated thousands}} +#' \item{For date/datetime styling a combination of d, m, y and punctuation marks} +#' \item{For numeric rounding use "0.00" with the preferred number of decimal places} +#' } +#' +#' @param border Cell border. A vector of "top", "bottom", "left", "right" or a single string). +#' \itemize{ +#' \item{**"top"**}{ Top border} +#' \item{**bottom**}{ Bottom border} +#' \item{**left**}{ Left border} +#' \item{**right**}{ Right border} +#' \item{**TopBottom** or **c("top", "bottom")**}{ Top and bottom border} +#' \item{**LeftRight** or **c("left", "right")**}{ Left and right border} +#' \item{**TopLeftRight** or **c("top", "left", "right")**}{ Top, Left and right border} +#' \item{**TopBottomLeftRight** or **c("top", "bottom", "left", "right")**}{ All borders} +#' } +#' +#' @param borderColour Colour of cell border vector the same length as the number of sides specified in "border" +#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#" +#' +#' @param borderStyle Border line style vector the same length as the number of sides specified in "border" +#' \itemize{ +#' \item{**none**}{ No Border} +#' \item{**thin**}{ thin border} +#' \item{**medium**}{ medium border} +#' \item{**dashed**}{ dashed border} +#' \item{**dotted**}{ dotted border} +#' \item{**thick**}{ thick border} +#' \item{**double**}{ double line border} +#' \item{**hair**}{ Hairline border} +#' \item{**mediumDashed**}{ medium weight dashed border} +#' \item{**dashDot**}{ dash-dot border} +#' \item{**mediumDashDot**}{ medium weight dash-dot border} +#' \item{**dashDotDot**}{ dash-dot-dot border} +#' \item{**mediumDashDotDot**}{ medium weight dash-dot-dot border} +#' \item{**slantDashDot**}{ slanted dash-dot border} +#' } +#' +#' @param bgFill Cell background fill colour. +#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#". +#' -- **Use for conditional formatting styles only.** +#' @param fgFill Cell foreground fill colour. +#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#" +#' +#' @param halign +#' Horizontal alignment of cell contents +#' \itemize{ +#' \item{**left**}{ Left horizontal align cell contents} +#' \item{**right**}{ Right horizontal align cell contents} +#' \item{**center**}{ Center horizontal align cell contents} +#' \item{**justify**}{ Justify horizontal align cell contents} +#' } +#' +#' @param valign A name +#' Vertical alignment of cell contents +#' \itemize{ +#' \item{**top**}{ Top vertical align cell contents} +#' \item{**center**}{ Center vertical align cell contents} +#' \item{**bottom**}{ Bottom vertical align cell contents} +#' } +#' +#' @param textDecoration +#' Text styling. +#' \itemize{ +#' \item{**bold**}{ Bold cell contents} +#' \item{**strikeout**}{ Strikeout cell contents} +#' \item{**italic**}{ Italicise cell contents} +#' \item{**underline**}{ Underline cell contents} +#' \item{**underline2**}{ Double underline cell contents} +#' \item{**accounting**}{ Single accounting underline cell contents} +#' \item{**accounting2**}{ Double accounting underline cell contents} +#' } +#' +#' @param wrapText Logical. If `TRUE` cell contents will wrap to fit in column. +#' @param textRotation Rotation of text in degrees. 255 for vertical text. +#' @param indent Horizontal indentation of cell contents. +#' @param hidden Whether the formula of the cell contents will be hidden (if worksheet protection is turned on) +#' @param locked Whether cell contents are locked (if worksheet protection is turned on) +#' @return A style object +#' @export +#' @examples +#' ## See package vignettes for further examples +#' +#' ## Modify default values of border colour and border line style +#' options("openxlsx.borderColour" = "#4F80BD") +#' options("openxlsx.borderStyle" = "thin") +#' +#' ## Size 18 Arial, Bold, left horz. aligned, fill colour #1A33CC, all borders, +#' style <- createStyle( +#' fontSize = 18, fontName = "Arial", +#' textDecoration = "bold", halign = "left", fgFill = "#1A33CC", border = "TopBottomLeftRight" +#' ) +#' +#' ## Red, size 24, Bold, italic, underline, center aligned Font, bottom border +#' style <- createStyle( +#' fontSize = 24, fontColour = rgb(1, 0, 0), +#' textDecoration = c("bold", "italic", "underline"), +#' halign = "center", valign = "center", border = "Bottom" +#' ) +#' +#' # borderColour is recycled for each border or all colours can be supplied +#' +#' # colour is recycled 3 times for "Top", "Bottom" & "Right" sides. +#' createStyle(border = "TopBottomRight", borderColour = "red") +#' +#' # supply all colours +#' createStyle(border = "TopBottomLeft", borderColour = c("red", "yellow", "green")) +createStyle <- function(fontName = NULL, + fontSize = NULL, + fontColour = NULL, + numFmt = openxlsx_getOp("numFmt", "GENERAL"), + border = NULL, + borderColour = openxlsx_getOp("borderColour", "black"), + borderStyle = openxlsx_getOp("borderStyle", "thin"), + bgFill = NULL, + fgFill = NULL, + halign = NULL, + valign = NULL, + textDecoration = NULL, + wrapText = FALSE, + textRotation = NULL, + indent = NULL, + locked = NULL, + hidden = NULL) { + + ### Error checking + op <- get_set_options() + on.exit(options(op), add = TRUE) + + ## if num fmt is made up of dd, mm, yy + numFmt_original <- numFmt[[1]] + numFmt <- tolower(numFmt_original) + validNumFmt <- c("general", "number", "currency", "accounting", "date", "longdate", "time", "percentage", "scientific", "text", "3", "4", "comma") + + if (numFmt == "date") { + numFmt <- openxlsx_getOp("dateFormat", "date") + } else if (numFmt == "longdate") { + numFmt <- openxlsx_getOp("datetimeFormat", "longdate") + } else if (!numFmt %in% validNumFmt) { + numFmt <- replaceIllegalCharacters(numFmt_original) + } + + numFmtMapping <- list( + list(numFmtId = 0), # GENERAL + list(numFmtId = 2), # NUMBER + list(numFmtId = 164, formatCode = ""$"#,##0.00"), ## CURRENCY + list(numFmtId = 44), # ACCOUNTING + list(numFmtId = 14), # DATE + list(numFmtId = 166, formatCode = "yyyy/mm/dd hh:mm:ss"), # LONGDATE + list(numFmtId = 167), # TIME + list(numFmtId = 10), # PERCENTAGE + list(numFmtId = 11), # SCIENTIFIC + list(numFmtId = 49), # TEXT + list(numFmtId = 3), + list(numFmtId = 4), + list(numFmtId = 3) + ) + + names(numFmtMapping) <- validNumFmt + + ## Validate border line style + if (!is.null(borderStyle)) { + borderStyle <- validateBorderStyle(borderStyle) + } + + if (!is.null(halign)) { + halign <- tolower(halign[[1]]) + if (!halign %in% c("left", "right", "center", "justify")) { + stop("Invalid halign argument!") + } + } + + if (!is.null(valign)) { + valign <- tolower(valign[[1]]) + if (!valign %in% c("top", "bottom", "center")) { + stop("Invalid valign argument!") + } + } + + if (!is.logical(wrapText)) { + stop("Invalid wrapText") + } + + if (!is.null(indent)) { + if (!is.numeric(indent) & !is.integer(indent)) { + stop("indent must be numeric") + } + } + + textDecoration <- tolower(textDecoration) + if (!is.null(textDecoration)) { + if (!all(textDecoration %in% c("bold", "strikeout", "italic", "underline", "underline2", "accounting", "accounting2", ""))) { + stop("Invalid textDecoration!") + } + } + + borderColour <- validateColour(borderColour, "Invalid border colour!") + + if (!is.null(fontColour)) { + fontColour <- validateColour(fontColour, "Invalid font colour!") + } + + if (!is.null(fontSize)) { + if (fontSize < 1) stop("Font size must be greater than 0!") + } + + if (!is.null(locked)) { + if (!is.logical(locked)) stop("Cell attribute locked must be TRUE or FALSE") + } + if (!is.null(hidden)) { + if (!is.logical(hidden)) stop("Cell attribute hidden must be TRUE or FALSE") + } + + + + + + ######################### error checking complete ############################# + style <- Style$new() + + if (!is.null(fontName)) { + style$fontName <- list("val" = fontName) + } + + if (!is.null(fontSize)) { + style$fontSize <- list("val" = fontSize) + } + + if (!is.null(fontColour)) { + style$fontColour <- list("rgb" = fontColour) + } + + style$fontDecoration <- toupper(textDecoration) + + ## background fill + if (is.null(bgFill)) { + # bgFillList <- NULL variable not used + } else { + bgFill <- validateColour(bgFill, "Invalid bgFill colour") + style$fill <- append(style$fill, list(fillBg = list("rgb" = bgFill))) + } + + ## foreground fill + if (is.null(fgFill)) { + # fgFillList <- NULL variable not used + } else { + fgFill <- validateColour(fgFill, "Invalid fgFill colour") + style$fill <- append(style$fill, list(fillFg = list(rgb = fgFill))) + } + + + ## border + if (!is.null(border)) { + border <- toupper(border) + border <- paste(border, collapse = "") + + ## find position of each side in string + sides <- c("LEFT", "RIGHT", "TOP", "BOTTOM") + pos <- sapply(sides, function(x) regexpr(x, border)) + pos <- pos[order(pos, decreasing = FALSE)] + nSides <- sum(pos > 0) + + borderColour <- rep(borderColour, length.out = nSides) + borderStyle <- rep(borderStyle, length.out = nSides) + + pos <- pos[pos > 0] + + if (length(pos) == 0) { + stop("Unknown border argument") + } + + names(borderColour) <- names(pos) + names(borderStyle) <- names(pos) + + if ("LEFT" %in% names(pos)) { + style$borderLeft <- borderStyle[["LEFT"]] + style$borderLeftColour <- list("rgb" = borderColour[["LEFT"]]) + } + + if ("RIGHT" %in% names(pos)) { + style$borderRight <- borderStyle[["RIGHT"]] + style$borderRightColour <- list("rgb" = borderColour[["RIGHT"]]) + } + + if ("TOP" %in% names(pos)) { + style$borderTop <- borderStyle[["TOP"]] + style$borderTopColour <- list("rgb" = borderColour[["TOP"]]) + } + + if ("BOTTOM" %in% names(pos)) { + style$borderBottom <- borderStyle[["BOTTOM"]] + style$borderBottomColour <- list("rgb" = borderColour[["BOTTOM"]]) + } + } + + ## other fields + if (!is.null(halign)) { + style$halign <- halign + } + + if (!is.null(valign)) { + style$valign <- valign + } + + if (!is.null(indent)) { + style$indent <- indent + } + + if (wrapText) { + style$wrapText <- TRUE + } + + if (!is.null(textRotation)) { + if (!is.numeric(textRotation)) { + stop("textRotation must be numeric.") + } + + if (textRotation < 0 & textRotation >= -90) { + textRotation <- (textRotation * -1) + 90 + } + + style$textRotation <- round(textRotation[[1]], 0) + } + + if (numFmt != "general") { + if (numFmt %in% validNumFmt) { + style$numFmt <- numFmtMapping[[numFmt[[1]]]] + } else { + style$numFmt <- list("numFmtId" = 165, formatCode = numFmt) ## Custom numFmt + } + } + + + if (!is.null(locked)) { + style$locked <- locked + } + + if (!is.null(hidden)) { + style$hidden <- hidden + } + + return(style) +} + + + +#' @name addStyle +#' @title Add a style to a set of cells +#' @description Function adds a style to a specified set of cells. +#' @author Alexander Walker +#' @param wb A Workbook object containing a worksheet. +#' @param sheet A worksheet to apply the style to. +#' @param style A style object returned from createStyle() +#' @param rows Rows to apply style to. +#' @param cols columns to apply style to. +#' @param gridExpand If `TRUE`, style will be applied to all combinations of rows and cols. +#' @param stack If `TRUE` the new style is merged with any existing cell styles. If FALSE, any +#' existing style is replaced by the new style. +#' @seealso [createStyle()] +#' @seealso expand.grid +#' @export +#' @examples +#' ## See package vignette for more examples. +#' +#' ## Create a new workbook +#' wb <- createWorkbook("My name here") +#' +#' ## Add a worksheets +#' addWorksheet(wb, "Expenditure", gridLines = FALSE) +#' +#' ## write data to worksheet 1 +#' writeData(wb, sheet = 1, USPersonalExpenditure, rowNames = TRUE) +#' +#' ## create and add a style to the column headers +#' headerStyle <- createStyle( +#' fontSize = 14, fontColour = "#FFFFFF", halign = "center", +#' fgFill = "#4F81BD", border = "TopBottom", borderColour = "#4F81BD" +#' ) +#' +#' ## style for body +#' bodyStyle <- createStyle(border = "TopBottom", borderColour = "#4F81BD") +#' addStyle(wb, sheet = 1, bodyStyle, rows = 2:6, cols = 1:6, gridExpand = TRUE) +#' setColWidths(wb, 1, cols = 1, widths = 21) ## set column width for row names column +#' \dontrun{ +#' saveWorkbook(wb, "addStyleExample.xlsx", overwrite = TRUE) +#' } +addStyle <- function(wb, + sheet, + style, + rows, + cols, + gridExpand = FALSE, + stack = FALSE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + + if (!is.null(style$numFmt) & length(wb$styleObjects) > 0) { + if (style$numFmt$numFmtId == 165) { + maxnumFmtId <- max(c(sapply(wb$styleObjects, function(i) { + as.integer( + max(c(i$style$numFmt$numFmtId, 0)) + ) + }), 165)) + style$numFmt$numFmtId <- maxnumFmtId + 1 + } + } + sheet <- wb$validateSheet(sheet) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (!"Style" %in% class(style)) { + stop("style argument must be a Style object.") + } + + if (!is.logical(stack)) { + stop("stack parameter must be a logical!") + } + + if (length(cols) == 0 | length(rows) == 0) { + return(invisible(0)) + } + + cols <- convertFromExcelRef(cols) + rows <- as.integer(rows) + + ## rows and cols need to be the same length + if (gridExpand) { + n <- length(cols) + cols <- rep.int(cols, times = length(rows)) + rows <- rep(rows, each = n) + } else if (length(rows) == 1 & length(cols) > 1) { + rows <- rep.int(rows, times = length(cols)) + } else if (length(cols) == 1 & length(rows) > 1) { + cols <- rep.int(cols, times = length(rows)) + } else if (length(rows) != length(cols)) { + stop("Length of rows and cols must be equal.") + } + + + wb$addStyle(sheet = sheet, style = style, rows = rows, cols = cols, stack = stack) +} + + +#' @name getCellRefs +#' @title Return excel cell coordinates from (x,y) coordinates +#' @description Return excel cell coordinates from (x,y) coordinates +#' @author Philipp Schauberger, Alexander Walker +#' @param cellCoords A data.frame with two columns coordinate pairs. +#' @return Excel alphanumeric cell reference +#' @examples +#' getCellRefs(data.frame(1, 2)) +#' # "B1" +#' getCellRefs(data.frame(1:3, 2:4)) +#' # "B1" "C2" "D3" +#' @export +getCellRefs <- function(cellCoords) { + if (!"data.frame" %in% class(cellCoords)) { + stop("Provide a data.frame!") + } + + + + if (!("numeric" %in% sapply(cellCoords[, 1], class) | + "integer" %in% sapply(cellCoords[, 1], class)) & + ("numeric" %in% sapply(cellCoords[, 2], class) | + "integer" %in% sapply(cellCoords[, 2], class)) + + ) { + stop("Provide a data.frame containing integers!") + } + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + l <- convert_to_excel_ref(cols = unlist(cellCoords[, 2]), LETTERS = LETTERS) + paste0(l, cellCoords[, 1]) +} + + +#' @name freezePane +#' @title Freeze a worksheet pane +#' @description Freeze a worksheet pane +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param firstActiveRow Top row of active region +#' @param firstActiveCol Furthest left column of active region +#' @param firstRow If `TRUE`, freezes the first row (equivalent to firstActiveRow = 2) +#' @param firstCol If `TRUE`, freezes the first column (equivalent to firstActiveCol = 2) +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook("Kenshin") +#' +#' ## Add some worksheets +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2") +#' addWorksheet(wb, "Sheet 3") +#' addWorksheet(wb, "Sheet 4") +#' +#' ## Freeze Panes +#' freezePane(wb, "Sheet 1", firstActiveRow = 5, firstActiveCol = 3) +#' freezePane(wb, "Sheet 2", firstCol = TRUE) ## shortcut to firstActiveCol = 2 +#' freezePane(wb, 3, firstRow = TRUE) ## shortcut to firstActiveRow = 2 +#' freezePane(wb, 4, firstActiveRow = 1, firstActiveCol = "D") +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "freezePaneExample.xlsx", overwrite = TRUE) +#' } +freezePane <- function(wb, sheet, firstActiveRow = NULL, firstActiveCol = NULL, firstRow = FALSE, firstCol = FALSE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (is.null(firstActiveRow) & is.null(firstActiveCol) & !firstRow & !firstCol) { + return(invisible(0)) + } + + if (!is.logical(firstRow)) { + stop("firstRow must be TRUE/FALSE") + } + + if (!is.logical(firstCol)) { + stop("firstCol must be TRUE/FALSE") + } + + + if (firstRow & !firstCol) { + invisible(wb$freezePanes(sheet, firstRow = firstRow)) + } else if (firstCol & !firstRow) { + invisible(wb$freezePanes(sheet, firstCol = firstCol)) + } else if (firstRow & firstCol) { + invisible(wb$freezePanes(sheet, firstActiveRow = 2L, firstActiveCol = 2L)) + } else { ## else both firstRow and firstCol are FALSE + + ## Convert to numeric if column letter given + if (!is.null(firstActiveRow)) { + firstActiveRow <- convertFromExcelRef(firstActiveRow) + } else { + firstActiveRow <- 1L + } + + if (!is.null(firstActiveCol)) { + firstActiveCol <- convertFromExcelRef(firstActiveCol) + } else { + firstActiveCol <- 1L + } + + invisible(wb$freezePanes(sheet, firstActiveRow = firstActiveRow, firstActiveCol = firstActiveCol, firstRow = firstRow, firstCol = firstCol)) + } +} + + +convert2EMU <- function(d, units) { + if (grepl("in", units)) { + d <- d * 2.54 + } + + if (grepl("mm|milli", units)) { + d <- d / 10 + } + + return(d * 360000) +} + + + + +#' @name insertImage +#' @title Insert an image into a worksheet +#' @description Insert an image into a worksheet +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param file An image file. Valid file types are: jpeg, png, bmp +#' @param width Width of figure. +#' @param height Height of figure. +#' @param startRow Row coordinate of upper left corner of the image +#' @param startCol Column coordinate of upper left corner of the image +#' @param units Units of width and height. Can be "in", "cm" or "px" +#' @param dpi Image resolution used for conversion between units. +#' @importFrom grDevices bmp png jpeg +#' @seealso [insertPlot()] +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook("Ayanami") +#' +#' ## Add some worksheets +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2") +#' addWorksheet(wb, "Sheet 3") +#' +#' ## Insert images +#' img <- system.file("extdata", "einstein.jpg", package = "openxlsx") +#' insertImage(wb, "Sheet 1", img, startRow = 5, startCol = 3, width = 6, height = 5) +#' insertImage(wb, 2, img, startRow = 2, startCol = 2) +#' insertImage(wb, 3, img, width = 15, height = 12, startRow = 3, startCol = "G", units = "cm") +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "insertImageExample.xlsx", overwrite = TRUE) +#' } +insertImage <- function(wb, sheet, file, width = 6, height = 3, startRow = 1, startCol = 1, units = "in", dpi = 300) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!file.exists(file)) { + stop("File does not exist.") + } + + if (!grepl("\\\\|\\/", file)) { + file <- file.path(getwd(), file, fsep = .Platform$file.sep) + } + + units <- tolower(units) + + if (!units %in% c("cm", "in", "px")) { + stop("Invalid units.\nunits must be one of: cm, in, px") + } + + startCol <- convertFromExcelRef(startCol) + startRow <- as.integer(startRow) + + ## convert to inches + if (units == "px") { + width <- width / dpi + height <- height / dpi + } else if (units == "cm") { + width <- width / 2.54 + height <- height / 2.54 + } + + ## Convert to EMUs + widthEMU <- as.integer(round(width * 914400L, 0)) # (EMUs per inch) + heightEMU <- as.integer(round(height * 914400L, 0)) # (EMUs per inch) + + wb$insertImage(sheet, file = file, startRow = startRow, startCol = startCol, width = widthEMU, height = heightEMU) +} + +pixels2ExcelColWidth <- function(pixels) { + if (any(!is.numeric(pixels))) { + stop("All elements of pixels must be numeric") + } + + pixels[pixels == 0] <- 8.43 + pixels[pixels != 0] <- (pixels[pixels != 0] - 12) / 7 + 1 + + pixels +} + + +#' @name setRowHeights +#' @title Set worksheet row heights +#' @description Set worksheet row heights +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param rows Indices of rows to set height +#' @param heights Heights to set rows to specified in Excel column height units. +#' @seealso [removeRowHeights()] +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook() +#' +#' ## Add a worksheet +#' addWorksheet(wb, "Sheet 1") +#' +#' ## set row heights +#' setRowHeights(wb, 1, rows = c(1, 4, 22, 2, 19), heights = c(24, 28, 32, 42, 33)) +#' +#' ## overwrite row 1 height +#' setRowHeights(wb, 1, rows = 1, heights = 40) +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "setRowHeightsExample.xlsx", overwrite = TRUE) +#' } +setRowHeights <- function(wb, sheet, rows, heights) { + sheet <- wb$validateSheet(sheet) + + if (length(rows) > length(heights)) { + heights <- rep(heights, length.out = length(rows)) + } + + if (length(heights) > length(rows)) { + stop("Greater number of height values than rows.") + } + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + ## Remove duplicates + heights <- heights[!duplicated(rows)] + rows <- rows[!duplicated(rows)] + + + heights <- as.character(as.numeric(heights)) + names(heights) <- rows + + wb$setRowHeights(sheet, rows, heights) +} + +#' @name setColWidths +#' @title Set worksheet column widths +#' @description Set worksheet column widths to specific width or "auto". +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols Indices of cols to set width +#' @param widths widths to set cols to specified in Excel column width units or "auto" for automatic sizing. The widths argument is +#' recycled to the length of cols. +#' @param hidden Logical vector. If TRUE the column is hidden. +#' @param ignoreMergedCells Ignore any cells that have been merged with other cells in the calculation of "auto" column widths. +#' @details The global min and max column width for "auto" columns is set by (default values show): +#' \itemize{ +#' \item{options("openxlsx.minWidth" = 3)} +#' \item{options("openxlsx.maxWidth" = 250)} ## This is the maximum width allowed in Excel +#' } +#' +#' NOTE: The calculation of column widths can be slow for large worksheets. +#' +#' NOTE: The `hidden` parameter may conflict with the one set in `groupColumns`; changing one will update the other. +#' +#' @seealso [removeColWidths()] +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- createWorkbook() +#' +#' ## Add a worksheet +#' addWorksheet(wb, "Sheet 1") +#' +#' +#' ## set col widths +#' setColWidths(wb, 1, cols = c(1, 4, 6, 7, 9), widths = c(16, 15, 12, 18, 33)) +#' +#' ## auto columns +#' addWorksheet(wb, "Sheet 2") +#' writeData(wb, sheet = 2, x = iris) +#' setColWidths(wb, sheet = 2, cols = 1:5, widths = "auto") +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "setColWidthsExample.xlsx", overwrite = TRUE) +#' } +#' +setColWidths <- function(wb, sheet, cols, widths = 8.43, hidden = rep(FALSE, length(cols)), ignoreMergedCells = FALSE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + sheet <- wb$validateSheet(sheet) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + widths <- tolower(widths) ## possibly "auto" + if (ignoreMergedCells) { + widths[widths == "auto"] <- "auto2" + } + + # should do nothing if the cols' length is zero + if (length(cols) == 0L) { + return(invisible(0)) + } + + if (length(widths) > length(cols)) { + stop("More widths than columns supplied.") + } + + if (length(hidden) > length(cols)) { + stop("hidden argument is longer than cols.") + } + + if (length(widths) < length(cols)) { + widths <- rep(widths, length.out = length(cols)) + } + + if (length(hidden) < length(cols)) { + hidden <- rep(hidden, length.out = length(cols)) + } + + ## Remove duplicates + widths <- widths[!duplicated(cols)] + hidden <- hidden[!duplicated(cols)] + cols <- cols[!duplicated(cols)] + cols <- convertFromExcelRef(cols) + + if (length(wb$colWidths[[sheet]]) > 0) { + existing_cols <- names(wb$colWidths[[sheet]]) + existing_widths <- unname(wb$colWidths[[sheet]]) + existing_hidden <- attr(wb$colWidths[[sheet]], "hidden") + + ## check for existing custom widths + flag <- existing_cols %in% cols + if (any(flag)) { + existing_cols <- existing_cols[!flag] + existing_widths <- existing_widths[!flag] + existing_hidden <- existing_hidden[!flag] + } + + all_names <- c(existing_cols, cols) + all_widths <- c(existing_widths, widths) + all_hidden <- c(existing_hidden, as.character(as.integer(hidden))) + + ord <- order(as.integer(all_names)) + all_names <- all_names[ord] + all_widths <- all_widths[ord] + all_hidden <- all_hidden[ord] + + + names(all_widths) <- all_names + wb$colWidths[[sheet]] <- all_widths + attr(wb$colWidths[[sheet]], "hidden") <- all_hidden + } else { + names(widths) <- cols + wb$colWidths[[sheet]] <- widths + attr(wb$colWidths[[sheet]], "hidden") <- as.character(as.integer(hidden)) + } + + # Check if any conflicting column outline levels + if (length(wb$colOutlineLevels[[sheet]]) > 0) { + existing_cols <- names(wb$colOutlineLevels[[sheet]]) + + if (any(existing_cols %in% cols)) { + for (i in intersect(existing_cols, cols)) { + width_hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i] + outline_hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "names") == i] + + if (outline_hidden != width_hidden) { + attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "names") == i] <- width_hidden + } + } + + cols <- cols[!cols %in% existing_cols] + hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") %in% cols] + } + } + + invisible(0) +} + + +#' @name removeColWidths +#' @title Remove column widths from a worksheet + +#' @description Remove column widths from a worksheet +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols Indices of columns to remove custom width (if any) from. +#' @seealso [setColWidths()] +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +#' +#' ## remove column widths in columns 1 to 20 +#' removeColWidths(wb, 1, cols = 1:20) +#' \dontrun{ +#' saveWorkbook(wb, "removeColWidthsExample.xlsx", overwrite = TRUE) +#' } +removeColWidths <- function(wb, sheet, cols) { + sheet <- wb$validateSheet(sheet) + + if (!is.numeric(cols)) { + cols <- convertFromExcelRef(cols) + } + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + customCols <- as.integer(names(wb$colWidths[[sheet]])) + removeInds <- which(customCols %in% cols) + if (length(removeInds) > 0) { + remainingCols <- customCols[-removeInds] + if (length(remainingCols) == 0) { + wb$colWidths[[sheet]] <- list() + } else { + rem_widths <- wb$colWidths[[sheet]][-removeInds] + names(rem_widths) <- as.character(remainingCols) + wb$colWidths[[sheet]] <- rem_widths + } + } +} + + + +#' @name removeRowHeights +#' @title Remove custom row heights from a worksheet +#' @description Remove row heights from a worksheet +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param rows Indices of rows to remove custom height (if any) from. +#' @seealso [setRowHeights()] +#' @export +#' @examples +#' ## Create a new workbook +#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +#' +#' ## remove any custom row heights in rows 1 to 10 +#' removeRowHeights(wb, 1, rows = 1:10) +#' \dontrun{ +#' saveWorkbook(wb, "removeRowHeightsExample.xlsx", overwrite = TRUE) +#' } +removeRowHeights <- function(wb, sheet, rows) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + sheet <- wb$validateSheet(sheet) + + customRows <- as.integer(names(wb$rowHeights[[sheet]])) + removeInds <- which(customRows %in% rows) + if (length(removeInds) > 0) { + wb$rowHeights[[sheet]] <- wb$rowHeights[[sheet]][-removeInds] + } +} + + +#' @name insertPlot +#' @title Insert the current plot into a worksheet +#' @author Alexander Walker +#' @description The current plot is saved to a temporary image file using dev.copy. +#' This file is then written to the workbook using insertImage. +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param startRow Row coordinate of upper left corner of figure.` xy[[2]]` when xy is given. +#' @param startCol Column coordinate of upper left corner of figure. `xy[[1]]` when xy is given. +#' @param xy Alternate way to specify startRow and startCol. A vector of length 2 of form (startcol, startRow) +#' @param width Width of figure. Defaults to 6in. +#' @param height Height of figure . Defaults to 4in. +#' @param fileType File type of image +#' @param units Units of width and height. Can be "in", "cm" or "px" +#' @param dpi Image resolution +#' @seealso [insertImage()] +#' @export +#' @importFrom grDevices bmp png jpeg tiff dev.copy dev.list dev.off +#' @examples +#' \dontrun{ +#' ## Create a new workbook +#' wb <- createWorkbook() +#' +#' ## Add a worksheet +#' addWorksheet(wb, "Sheet 1", gridLines = FALSE) +#' +#' ## create plot objects +#' require(ggplot2) +#' p1 <- qplot(mpg, +#' data = mtcars, geom = "density", +#' fill = as.factor(gear), alpha = I(.5), main = "Distribution of Gas Mileage" +#' ) +#' p2 <- qplot(age, circumference, +#' data = Orange, geom = c("point", "line"), colour = Tree +#' ) +#' +#' ## Insert currently displayed plot to sheet 1, row 1, column 1 +#' print(p1) # plot needs to be showing +#' insertPlot(wb, 1, width = 5, height = 3.5, fileType = "png", units = "in") +#' +#' ## Insert plot 2 +#' print(p2) +#' insertPlot(wb, 1, xy = c("J", 2), width = 16, height = 10, fileType = "png", units = "cm") +#' +#' ## Save workbook +#' saveWorkbook(wb, "insertPlotExample.xlsx", overwrite = TRUE) +#' } +insertPlot <- function(wb, sheet, width = 6, height = 4, xy = NULL, + startRow = 1, startCol = 1, fileType = "png", units = "in", dpi = 300) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (is.null(dev.list()[[1]])) { + warning("No plot to insert.") + return() + } + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (!is.null(xy)) { + startCol <- xy[[1]] + startRow <- xy[[2]] + } + + fileType <- tolower(fileType) + units <- tolower(units) + + if (fileType == "jpg") { + fileType <- "jpeg" + } + + if (!fileType %in% c("png", "jpeg", "tiff", "bmp")) { + stop("Invalid file type.\nfileType must be one of: png, jpeg, tiff, bmp") + } + + if (!units %in% c("cm", "in", "px")) { + stop("Invalid units.\nunits must be one of: cm, in, px") + } + + fileName <- tempfile(pattern = "figureImage", fileext = paste0(".", fileType)) + + if (fileType == "bmp") { + dev.copy(bmp, filename = fileName, width = width, height = height, units = units, res = dpi) + } else if (fileType == "jpeg") { + dev.copy(jpeg, filename = fileName, width = width, height = height, units = units, quality = 100, res = dpi) + } else if (fileType == "png") { + dev.copy(png, filename = fileName, width = width, height = height, units = units, res = dpi) + } else if (fileType == "tiff") { + dev.copy(tiff, filename = fileName, width = width, height = height, units = units, compression = "none", res = dpi) + } + + ## write image + invisible(dev.off()) + + insertImage(wb = wb, sheet = sheet, file = fileName, width = width, height = height, startRow = startRow, startCol = startCol, units = units, dpi = dpi) +} + + + +#' @name replaceStyle +#' @title Replace an existing cell style +#' @description Replace an existing cell style +#' @author Alexander Walker +#' @param wb A workbook object +#' @param index Index of style object to replace +#' @param newStyle A style to replace the existing style as position index +#' @description Replace a style object +#' @export +#' @seealso [getStyles()] +#' @examples +#' +#' ## load a workbook +#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +#' +#' ## create a new style and replace style 2 +#' +#' newStyle <- createStyle(fgFill = "#00FF00") +#' +#' ## replace style 2 +#' getStyles(wb)[1:3] ## prints styles +#' replaceStyle(wb, 2, newStyle = newStyle) +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "replaceStyleExample.xlsx", overwrite = TRUE) +#' } +replaceStyle <- function(wb, index, newStyle) { + nStyles <- length(wb$styleObjects) + + if (nStyles == 0) { + stop("Workbook has no existing styles.") + } + + if (index > nStyles) { + stop(sprintf("Invalid index. Workbook only has %s styles.", nStyles)) + } + + if (!all("Style" %in% class(newStyle))) { + stop("Invalid style object.") + } + + wb$styleObjects[[index]]$style <- newStyle +} + + +#' @name getStyles +#' @title Returns a list of all styles in the workbook +#' @description Returns list of style objects in the workbook +#' @param wb A workbook object +#' @export +#' @seealso [replaceStyle()] +#' @examples +#' ## load a workbook +#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +#' getStyles(wb)[1:3] +getStyles <- function(wb) { + nStyles <- length(wb$styleObjects) + + if (nStyles == 0) { + stop("Workbook has no existing styles.") + } + + styles <- lapply(wb$styleObjects, "[[", "style") + + return(styles) +} + + + +#' @name removeWorksheet +#' @title Remove a worksheet from a workbook +#' @description Remove a worksheet from a Workbook object +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @description Remove a worksheet from a workbook +#' @export +#' @examples +#' ## load a workbook +#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +#' +#' ## Remove sheet 2 +#' removeWorksheet(wb, 2) +#' +#' ## save the modified workbook +#' \dontrun{ +#' saveWorkbook(wb, "removeWorksheetExample.xlsx", overwrite = TRUE) +#' } +removeWorksheet <- function(wb, sheet) { + if (class(wb) != "Workbook") { + stop("wb must be a Workbook object!") + } + + if (length(sheet) != 1) { + stop("sheet must have length 1.") + } + + wb$deleteWorksheet(sheet) + + invisible(0) +} + + +#' @name deleteData +#' @title Delete cell data +#' @description Delete contents and styling from a cell. +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param rows Rows to delete data from. +#' @param cols columns to delete data from. +#' @param gridExpand If `TRUE`, all data in rectangle min(rows):max(rows) X min(cols):max(cols) +#' will be removed. +#' @export +#' @examples +#' ## write some data +#' wb <- createWorkbook() +#' addWorksheet(wb, "Worksheet 1") +#' x <- data.frame(matrix(runif(200), ncol = 10)) +#' writeData(wb, sheet = 1, x = x, startCol = 2, startRow = 3, colNames = FALSE) +#' +#' ## delete some data +#' deleteData(wb, sheet = 1, cols = 3:5, rows = 5:7, gridExpand = TRUE) +#' deleteData(wb, sheet = 1, cols = 7:9, rows = 5:7, gridExpand = TRUE) +#' deleteData(wb, sheet = 1, cols = LETTERS, rows = 18, gridExpand = TRUE) +#' \dontrun{ +#' saveWorkbook(wb, "deleteDataExample.xlsx", overwrite = TRUE) +#' } +deleteData <- function(wb, sheet, cols, rows, gridExpand = FALSE) { + sheet <- wb$validateSheet(sheet) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + + wb$worksheets[[sheet]]$sheet_data$delete(rows_in = rows, cols_in = cols, grid_expand = gridExpand) + + + invisible(0) +} + + +#' @name modifyBaseFont +#' @title Modify the default font +#' @description Modify the default font for this workbook +#' @author Alexander Walker +#' @param wb A workbook object +#' @param fontSize font size +#' @param fontColour font colour +#' @param fontName Name of a font +#' @details The font name is not validated in anyway. Excel replaces unknown font names +#' with Arial. Base font is black, size 11, Calibri. +#' @export +#' @examples +#' ## create a workbook +#' wb <- createWorkbook() +#' addWorksheet(wb, "S1") +#' ## modify base font to size 10 Arial Narrow in red +#' modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") +#' +#' writeData(wb, "S1", iris) +#' writeDataTable(wb, "S1", x = iris, startCol = 10) ## font colour does not affect tables +#' \dontrun{ +#' saveWorkbook(wb, "modifyBaseFontExample.xlsx", overwrite = TRUE) +#' } +modifyBaseFont <- function(wb, fontSize = 11, fontColour = "black", fontName = "Calibri") { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (fontSize < 0) stop("Invalid fontSize") + fontColour <- validateColour(fontColour) + + wb$styles$fonts[[1]] <- sprintf('', fontSize, fontColour, fontName) +} + + +#' @name getBaseFont +#' @title Return the workbook default font +#' @description Return the workbook default font +#' @author Alexander Walker +#' @param wb A workbook object +#' @description Returns the base font used in the workbook. +#' @export +#' @examples +#' ## create a workbook +#' wb <- createWorkbook() +#' getBaseFont(wb) +#' +#' ## modify base font to size 10 Arial Narrow in red +#' modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow") +#' +#' getBaseFont(wb) +getBaseFont <- function(wb) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + wb$getBaseFont() +} + + +#' @name setHeaderFooter +#' @title Set document headers and footers +#' @description Set document headers and footers +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param header document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. +#' @param footer document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position. +#' @param evenHeader document header for even pages. +#' @param evenFooter document footer for even pages. +#' @param firstHeader document header for first page only. +#' @param firstFooter document footer for first page only. +#' @details Headers and footers can contain special tags +#' \itemize{ +#' \item{**&\[Page\]**}{ Page number} +#' \item{**&\[Pages\]**}{ Number of pages} +#' \item{**&\[Date\]**}{ Current date} +#' \item{**&\[Time\]**}{ Current time} +#' \item{**&\[Path\]**}{ File path} +#' \item{**&\[File\]**}{ File name} +#' \item{**&\[Tab\]**}{ Worksheet name} +#' } +#' @export +#' @seealso [addWorksheet()] to set headers and footers when adding a worksheet +#' @examples +#' wb <- createWorkbook() +#' +#' addWorksheet(wb, "S1") +#' addWorksheet(wb, "S2") +#' addWorksheet(wb, "S3") +#' addWorksheet(wb, "S4") +#' +#' writeData(wb, 1, 1:400) +#' writeData(wb, 2, 1:400) +#' writeData(wb, 3, 3:400) +#' writeData(wb, 4, 3:400) +#' +#' setHeaderFooter(wb, +#' sheet = "S1", +#' header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"), +#' footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"), +#' evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"), +#' evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"), +#' firstHeader = c("TOP", "OF FIRST", "PAGE"), +#' firstFooter = c("BOTTOM", "OF FIRST", "PAGE") +#' ) +#' +#' setHeaderFooter(wb, +#' sheet = 2, +#' header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"), +#' footer = c("&[Path]&[File]", NA, "&[Tab]"), +#' firstHeader = c(NA, "Center Header of First Page", NA), +#' firstFooter = c(NA, "Center Footer of First Page", NA) +#' ) +#' +#' setHeaderFooter(wb, +#' sheet = 3, +#' header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"), +#' footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2") +#' ) +#' +#' setHeaderFooter(wb, +#' sheet = 4, +#' firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"), +#' firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R") +#' ) +#' \dontrun{ +#' saveWorkbook(wb, "setHeaderFooterExample.xlsx", overwrite = TRUE) +#' } +setHeaderFooter <- function(wb, sheet, + header = NULL, + footer = NULL, + evenHeader = NULL, + evenFooter = NULL, + firstHeader = NULL, + firstFooter = NULL) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + + if (!is.null(header) & length(header) != 3) { + stop("header must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(footer) & length(footer) != 3) { + stop("footer must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(evenHeader) & length(evenHeader) != 3) { + stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(evenFooter) & length(evenFooter) != 3) { + stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(firstHeader) & length(firstHeader) != 3) { + stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.") + } + + if (!is.null(firstFooter) & length(firstFooter) != 3) { + stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.") + } + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + oddHeader <- headerFooterSub(header) + oddFooter <- headerFooterSub(footer) + evenHeader <- headerFooterSub(evenHeader) + evenFooter <- headerFooterSub(evenFooter) + firstHeader <- headerFooterSub(firstHeader) + firstFooter <- headerFooterSub(firstFooter) + + naToNULLList <- function(x) { + lapply(x, function(x) { + if (is.na(x)) { + return(NULL) + } + x + }) + } + + hf <- list( + oddHeader = naToNULLList(oddHeader), + oddFooter = naToNULLList(oddFooter), + evenHeader = naToNULLList(evenHeader), + evenFooter = naToNULLList(evenFooter), + firstHeader = naToNULLList(firstHeader), + firstFooter = naToNULLList(firstFooter) + ) + + if (all(sapply(hf, length) == 0)) { + hf <- NULL + } + + + wb$worksheets[[sheet]]$headerFooter <- hf +} + + + + +#' @name pageSetup +#' @title Set page margins, orientation and print scaling +#' @description Set page margins, orientation and print scaling +#' @author Alexander Walker, Joshua Sturm +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param orientation Page orientation. One of "portrait" or "landscape" +#' @param scale Print scaling. Numeric value between 10 and 400 +#' @param left left page margin in inches +#' @param right right page margin in inches +#' @param top top page margin in inches +#' @param bottom bottom page margin in inches +#' @param header header margin in inches +#' @param footer footer margin in inches +#' @param fitToWidth If `TRUE`, worksheet is scaled to fit to page width on printing. +#' @param fitToHeight If `TRUE`, worksheet is scaled to fit to page height on printing. +#' @param paperSize See details. Default value is 9 (A4 paper). +#' @param printTitleRows Rows to repeat at top of page when printing. Integer vector. +#' @param printTitleCols Columns to repeat at left when printing. Integer vector. +#' @param summaryRow Location of summary rows in groupings. One of "Above" or "Below". +#' @param summaryCol Location of summary columns in groupings. One of "Right" or "Left". +#' @export +#' @details +#' paperSize is an integer corresponding to: +#' \itemize{ +#' \item{**1**}{ Letter paper (8.5 in. by 11 in.)} +#' \item{**2**}{ Letter small paper (8.5 in. by 11 in.)} +#' \item{**3**}{ Tabloid paper (11 in. by 17 in.)} +#' \item{**4**}{ Ledger paper (17 in. by 11 in.)} +#' \item{**5**}{ Legal paper (8.5 in. by 14 in.)} +#' \item{**6**}{ Statement paper (5.5 in. by 8.5 in.)} +#' \item{**7**}{ Executive paper (7.25 in. by 10.5 in.)} +#' \item{**8**}{ A3 paper (297 mm by 420 mm)} +#' \item{**9**}{ A4 paper (210 mm by 297 mm)} +#' \item{**10**}{ A4 small paper (210 mm by 297 mm)} +#' \item{**11**}{ A5 paper (148 mm by 210 mm)} +#' \item{**12**}{ B4 paper (250 mm by 353 mm)} +#' \item{**13**}{ B5 paper (176 mm by 250 mm)} +#' \item{**14**}{ Folio paper (8.5 in. by 13 in.)} +#' \item{**15**}{ Quarto paper (215 mm by 275 mm)} +#' \item{**16**}{ Standard paper (10 in. by 14 in.)} +#' \item{**17**}{ Standard paper (11 in. by 17 in.)} +#' \item{**18**}{ Note paper (8.5 in. by 11 in.)} +#' \item{**19**}{ #9 envelope (3.875 in. by 8.875 in.)} +#' \item{**20**}{ #10 envelope (4.125 in. by 9.5 in.)} +#' \item{**21**}{ #11 envelope (4.5 in. by 10.375 in.)} +#' \item{**22**}{ #12 envelope (4.75 in. by 11 in.)} +#' \item{**23**}{ #14 envelope (5 in. by 11.5 in.)} +#' \item{**24**}{ C paper (17 in. by 22 in.)} +#' \item{**25**}{ D paper (22 in. by 34 in.)} +#' \item{**26**}{ E paper (34 in. by 44 in.)} +#' \item{**27**}{ DL envelope (110 mm by 220 mm)} +#' \item{**28**}{ C5 envelope (162 mm by 229 mm)} +#' \item{**29**}{ C3 envelope (324 mm by 458 mm)} +#' \item{**30**}{ C4 envelope (229 mm by 324 mm)} +#' \item{**31**}{ C6 envelope (114 mm by 162 mm)} +#' \item{**32**}{ C65 envelope (114 mm by 229 mm)} +#' \item{**33**}{ B4 envelope (250 mm by 353 mm)} +#' \item{**34**}{ B5 envelope (176 mm by 250 mm)} +#' \item{**35**}{ B6 envelope (176 mm by 125 mm)} +#' \item{**36**}{ Italy envelope (110 mm by 230 mm)} +#' \item{**37**}{ Monarch envelope (3.875 in. by 7.5 in.).} +#' \item{**38**}{ 6 3/4 envelope (3.625 in. by 6.5 in.)} +#' \item{**39**}{ US standard fanfold (14.875 in. by 11 in.)} +#' \item{**40**}{ German standard fanfold (8.5 in. by 12 in.)} +#' \item{**41**}{ German legal fanfold (8.5 in. by 13 in.)} +#' \item{**42**}{ ISO B4 (250 mm by 353 mm)} +#' \item{**43**}{ Japanese double postcard (200 mm by 148 mm)} +#' \item{**44**}{ Standard paper (9 in. by 11 in.)} +#' \item{**45**}{ Standard paper (10 in. by 11 in.)} +#' \item{**46**}{ Standard paper (15 in. by 11 in.)} +#' \item{**47**}{ Invite envelope (220 mm by 220 mm)} +#' \item{**50**}{ Letter extra paper (9.275 in. by 12 in.)} +#' \item{**51**}{ Legal extra paper (9.275 in. by 15 in.)} +#' \item{**52**}{ Tabloid extra paper (11.69 in. by 18 in.)} +#' \item{**53**}{ A4 extra paper (236 mm by 322 mm)} +#' \item{**54**}{ Letter transverse paper (8.275 in. by 11 in.)} +#' \item{**55**}{ A4 transverse paper (210 mm by 297 mm)} +#' \item{**56**}{ Letter extra transverse paper (9.275 in. by 12 in.)} +#' \item{**57**}{ SuperA/SuperA/A4 paper (227 mm by 356 mm)} +#' \item{**58**}{ SuperB/SuperB/A3 paper (305 mm by 487 mm)} +#' \item{**59**}{ Letter plus paper (8.5 in. by 12.69 in.)} +#' \item{**60**}{ A4 plus paper (210 mm by 330 mm)} +#' \item{**61**}{ A5 transverse paper (148 mm by 210 mm)} +#' \item{**62**}{ JIS B5 transverse paper (182 mm by 257 mm)} +#' \item{**63**}{ A3 extra paper (322 mm by 445 mm)} +#' \item{**64**}{ A5 extra paper (174 mm by 235 mm)} +#' \item{**65**}{ ISO B5 extra paper (201 mm by 276 mm)} +#' \item{**66**}{ A2 paper (420 mm by 594 mm)} +#' \item{**67**}{ A3 transverse paper (297 mm by 420 mm)} +#' \item{**68**}{ A3 extra transverse paper (322 mm by 445 mm)} +#' } +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "S1") +#' addWorksheet(wb, "S2") +#' writeDataTable(wb, 1, x = iris[1:30, ]) +#' writeDataTable(wb, 2, x = iris[1:30, ], xy = c("C", 5)) +#' +#' ## landscape page scaled to 50% +#' pageSetup(wb, sheet = 1, orientation = "landscape", scale = 50) +#' +#' ## portrait page scales to 300% with 0.5in left and right margins +#' pageSetup(wb, sheet = 2, orientation = "portrait", scale = 300, left = 0.5, right = 0.5) +#' +#' +#' ## print titles +#' addWorksheet(wb, "print_title_rows") +#' addWorksheet(wb, "print_title_cols") +#' +#' writeData(wb, "print_title_rows", rbind(iris, iris, iris, iris)) +#' writeData(wb, "print_title_cols", x = rbind(mtcars, mtcars, mtcars), rowNames = TRUE) +#' +#' pageSetup(wb, sheet = "print_title_rows", printTitleRows = 1) ## first row +#' pageSetup(wb, sheet = "print_title_cols", printTitleCols = 1, printTitleRows = 1) +#' \dontrun{ +#' saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) +#' } +pageSetup <- function(wb, sheet, orientation = NULL, scale = 100, + left = 0.7, right = 0.7, top = 0.75, bottom = 0.75, + header = 0.3, footer = 0.3, + fitToWidth = FALSE, fitToHeight = FALSE, paperSize = NULL, + printTitleRows = NULL, printTitleCols = NULL, + summaryRow = NULL, summaryCol = NULL) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + xml <- wb$worksheets[[sheet]]$pageSetup + + if (!is.null(orientation)) { + orientation <- tolower(orientation) + if (!orientation %in% c("portrait", "landscape")) stop("Invalid page orientation.") + } else { + orientation <- ifelse(grepl("landscape", xml), "landscape", "portrait") ## get existing + } + + if (scale < 10 | scale > 400) { + stop("Scale must be between 10 and 400.") + } + + if (!is.null(paperSize)) { + paperSizes <- 1:68 + paperSizes <- paperSizes[!paperSizes %in% 48:49] + if (!paperSize %in% paperSizes) { + stop("paperSize must be an integer in range [1, 68]. See ?pageSetup details.") + } + paperSize <- as.integer(paperSize) + } else { + paperSize <- regmatches(xml, regexpr('(?<=paperSize=")[0-9]+', xml, perl = TRUE)) ## get existing + } + + + ############################## + ## Keep defaults on orientation, hdpi, vdpi, paperSize + hdpi <- regmatches(xml, regexpr('(?<=horizontalDpi=")[0-9]+', xml, perl = TRUE)) + vdpi <- regmatches(xml, regexpr('(?<=verticalDpi=")[0-9]+', xml, perl = TRUE)) + + + ############################## + ## Update + wb$worksheets[[sheet]]$pageSetup <- sprintf( + '', + paperSize, orientation, scale, as.integer(fitToWidth), as.integer(fitToHeight), hdpi, vdpi + ) + + if (fitToHeight | fitToWidth) { + wb$worksheets[[sheet]]$sheetPr <- unique(c(wb$worksheets[[sheet]]$sheetPr, '')) + } + + wb$worksheets[[sheet]]$pageMargins <- + sprintf('', left, right, top, bottom, header, footer) + + validRow <- function(summaryRow) { + return(tolower(summaryRow) %in% c("above", "below")) + } + validCol <- function(summaryCol) { + return(tolower(summaryCol) %in% c("left", "right")) + } + + outlinepr <- "" + + if (!is.null(summaryRow)) { + if (!validRow(summaryRow)) { + stop("Invalid \`summaryRow\` option. Must be one of \"Above\" or \"Below\".") + } else if (tolower(summaryRow) == "above") { + outlinepr <- ' summaryBelow=\"0\"' + } else { + outlinepr <- ' summaryBelow=\"1\"' + } + } + + if (!is.null(summaryCol)) { + if (!validCol(summaryCol)) { + stop("Invalid \`summaryCol\` option. Must be one of \"Left\" or \"Right\".") + } else if (tolower(summaryCol) == "left") { + outlinepr <- paste0(outlinepr, ' summaryRight=\"0\"') + } else { + outlinepr <- paste0(outlinepr, ' summaryRight=\"1\"') + } + } + + if (!stri_isempty(outlinepr)) { + wb$worksheets[[sheet]]$sheetPr <- unique(c(wb$worksheets[[sheet]]$sheetPr, paste0(""))) + } + + ## print Titles + if (!is.null(printTitleRows) & is.null(printTitleCols)) { + if (!is.numeric(printTitleRows)) { + stop("printTitleRows must be numeric.") + } + + wb$createNamedRegion( + ref1 = paste0("$", min(printTitleRows)), + ref2 = paste0("$", max(printTitleRows)), + name = "_xlnm.Print_Titles", + sheet = names(wb)[[sheet]], + localSheetId = sheet - 1L + ) + } else if (!is.null(printTitleCols) & is.null(printTitleRows)) { + if (!is.numeric(printTitleCols)) { + stop("printTitleCols must be numeric.") + } + + cols <- convert_to_excel_ref(cols = range(printTitleCols), LETTERS = LETTERS) + wb$createNamedRegion( + ref1 = paste0("$", cols[1]), + ref2 = paste0("$", cols[2]), + name = "_xlnm.Print_Titles", + sheet = names(wb)[[sheet]], + localSheetId = sheet - 1L + ) + } else if (!is.null(printTitleCols) & !is.null(printTitleRows)) { + if (!is.numeric(printTitleRows)) { + stop("printTitleRows must be numeric.") + } + + if (!is.numeric(printTitleCols)) { + stop("printTitleCols must be numeric.") + } + + cols <- convert_to_excel_ref(cols = range(printTitleCols), LETTERS = LETTERS) + rows <- range(printTitleRows) + + cols <- paste(paste0("$", cols[1]), paste0("$", cols[2]), sep = ":") + rows <- paste(paste0("$", rows[1]), paste0("$", rows[2]), sep = ":") + localSheetId <- sheet - 1L + sheet <- names(wb)[[sheet]] + + wb$workbook$definedNames <- c( + wb$workbook$definedNames, + sprintf('\'%s\'!%s,\'%s\'!%s', localSheetId, sheet, cols, sheet, rows) + ) + } +} + + +#' @name protectWorksheet +#' @title Protect a worksheet from modifications +#' @description Protect or unprotect a worksheet from modifications by the user in the graphical user interface. Replaces an existing protection. +#' @author Reinhold Kainhofer +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param protect Whether to protect or unprotect the sheet (default=TRUE) +#' @param password (optional) password required to unprotect the worksheet +#' @param lockSelectingLockedCells Whether selecting locked cells is locked +#' @param lockSelectingUnlockedCells Whether selecting unlocked cells is locked +#' @param lockFormattingCells Whether formatting cells is locked +#' @param lockFormattingColumns Whether formatting columns is locked +#' @param lockFormattingRows Whether formatting rows is locked +#' @param lockInsertingColumns Whether inserting columns is locked +#' @param lockInsertingRows Whether inserting rows is locked +#' @param lockInsertingHyperlinks Whether inserting hyperlinks is locked +#' @param lockDeletingColumns Whether deleting columns is locked +#' @param lockDeletingRows Whether deleting rows is locked +#' @param lockSorting Whether sorting is locked +#' @param lockAutoFilter Whether auto-filter is locked +#' @param lockPivotTables Whether pivot tables are locked +#' @param lockObjects Whether objects are locked +#' @param lockScenarios Whether scenarios are locked +#' @export +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "S1") +#' writeDataTable(wb, 1, x = iris[1:30, ]) +#' # Formatting cells / columns is allowed , but inserting / deleting columns is protected: +#' protectWorksheet(wb, "S1", +#' protect = TRUE, +#' lockFormattingCells = FALSE, lockFormattingColumns = FALSE, +#' lockInsertingColumns = TRUE, lockDeletingColumns = TRUE +#' ) +#' +#' # Remove the protection +#' protectWorksheet(wb, "S1", protect = FALSE) +#' \dontrun{ +#' saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE) +#' } +protectWorksheet <- function(wb, sheet, protect = TRUE, password = NULL, + lockSelectingLockedCells = NULL, lockSelectingUnlockedCells = NULL, + lockFormattingCells = NULL, lockFormattingColumns = NULL, lockFormattingRows = NULL, + lockInsertingColumns = NULL, lockInsertingRows = NULL, lockInsertingHyperlinks = NULL, + lockDeletingColumns = NULL, lockDeletingRows = NULL, + lockSorting = NULL, lockAutoFilter = NULL, lockPivotTables = NULL, + lockObjects = NULL, lockScenarios = NULL) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + # xml <- wb$worksheets[[sheet]]$sheetProtection variable not used + + props <- c() + + if (!missing(password) && !is.null(password)) { + props["password"] <- hashPassword(password) + } + + if (!missing(lockSelectingLockedCells) && !is.null(lockSelectingLockedCells)) { + props["selectLockedCells"] <- toString(as.numeric(lockSelectingLockedCells)) + } + if (!missing(lockSelectingUnlockedCells) && !is.null(lockSelectingUnlockedCells)) { + props["selectUnlockedCells"] <- toString(as.numeric(lockSelectingUnlockedCells)) + } + if (!missing(lockFormattingCells) && !is.null(lockFormattingCells)) { + props["formatCells"] <- toString(as.numeric(lockFormattingCells)) + } + if (!missing(lockFormattingColumns) && !is.null(lockFormattingColumns)) { + props["formatColumns"] <- toString(as.numeric(lockFormattingColumns)) + } + if (!missing(lockFormattingRows) && !is.null(lockFormattingRows)) { + props["formatRows"] <- toString(as.numeric(lockFormattingRows)) + } + if (!missing(lockInsertingColumns) && !is.null(lockInsertingColumns)) { + props["insertColumns"] <- toString(as.numeric(lockInsertingColumns)) + } + if (!missing(lockInsertingRows) && !is.null(lockInsertingRows)) { + props["insertRows"] <- toString(as.numeric(lockInsertingRows)) + } + if (!missing(lockInsertingHyperlinks) && !is.null(lockInsertingHyperlinks)) { + props["insertHyperlinks"] <- toString(as.numeric(lockInsertingHyperlinks)) + } + if (!missing(lockDeletingColumns) && !is.null(lockDeletingColumns)) { + props["deleteColumns"] <- toString(as.numeric(lockDeletingColumns)) + } + if (!missing(lockDeletingRows) && !is.null(lockDeletingRows)) { + props["deleteRows"] <- toString(as.numeric(lockDeletingRows)) + } + if (!missing(lockSorting) && !is.null(lockSorting)) { + props["sort"] <- toString(as.numeric(lockSorting)) + } + if (!missing(lockAutoFilter) && !is.null(lockAutoFilter)) { + props["autoFilter"] <- toString(as.numeric(lockAutoFilter)) + } + if (!missing(lockPivotTables) && !is.null(lockPivotTables)) { + props["pivotTables"] <- toString(as.numeric(lockPivotTables)) + } + if (!missing(lockObjects) && !is.null(lockObjects)) { + props["objects"] <- toString(as.numeric(lockObjects)) + } + if (!missing(lockScenarios) && !is.null(lockScenarios)) { + props["scenarios"] <- toString(as.numeric(lockScenarios)) + } + + if (protect) { + props["sheet"] <- "1" + wb$worksheets[[sheet]]$sheetProtection <- sprintf("", paste(names(props), '="', props, '"', collapse = " ", sep = "")) + } else { + wb$worksheets[[sheet]]$sheetProtection <- "" + } +} + + + +#' @name protectWorkbook +#' @title Protect a workbook from modifications +#' @description Protect or unprotect a workbook from modifications by the user in the graphical user interface. Replaces an existing protection. +#' @author Reinhold Kainhofer +#' @param wb A workbook object +#' @param protect Whether to protect or unprotect the sheet (default=TRUE) +#' @param password (optional) password required to unprotect the workbook +#' @param lockStructure Whether the workbook structure should be locked +#' @param lockWindows Whether the window position of the spreadsheet should be locked +#' @param type Lock type, default 1. From the xml documentation: 1 - Document is password protected. 2 - Document is recommended to be opened as read-only. 4 - Document is enforced to be opened as read-only. 8 - Document is locked for annotation. +#' @export +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "S1") +#' protectWorkbook(wb, protect = TRUE, password = "Password", lockStructure = TRUE) +#' \dontrun{ +#' saveWorkbook(wb, "WorkBook_Protection.xlsx", overwrite = TRUE) +#' } +#' # Remove the protection +#' protectWorkbook(wb, protect = FALSE) +#' \dontrun{ +#' saveWorkbook(wb, "WorkBook_Protection_unprotected.xlsx", overwrite = TRUE) +#' } +protectWorkbook <- function(wb, protect = TRUE, password = NULL, lockStructure = FALSE, lockWindows = FALSE, type = 1L) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + invisible(wb$protectWorkbook(protect = protect, password = password, lockStructure = lockStructure, lockWindows = lockWindows, type = type)) +} + + + + + +#' @name showGridLines +#' @title Set worksheet gridlines to show or hide. +#' @description Set worksheet gridlines to show or hide. +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param showGridLines A logical. If `FALSE`, grid lines are hidden. +#' @export +#' @examples +#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) +#' names(wb) ## list worksheets in workbook +#' showGridLines(wb, 1, showGridLines = FALSE) +#' showGridLines(wb, "testing", showGridLines = FALSE) +#' \dontrun{ +#' saveWorkbook(wb, "showGridLinesExample.xlsx", overwrite = TRUE) +#' } +showGridLines <- function(wb, sheet, showGridLines = FALSE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + + if (!is.logical(showGridLines)) stop("showGridLines must be a logical") + + + sv <- wb$worksheets[[sheet]]$sheetViews + showGridLines <- as.integer(showGridLines) + ## If attribute exists gsub + if (grepl("showGridLines", sv)) { + sv <- gsub('showGridLines=".?[^"]', sprintf('showGridLines="%s', showGridLines), sv, perl = TRUE) + } else { + sv <- gsub(" length(wb$worksheets))) { + stop("Elements of order are greater than the number of worksheets") + } + + + old_ActiveSheet <- wb$ActiveSheet + + wb$sheetOrder <- value + wb$setactiveSheet(old_ActiveSheet) + + + invisible(wb) +} + + + + +#' @name convertToDate +#' @title Convert from excel date number to R Date type +#' @description Convert from excel date number to R Date type +#' @param x A vector of integers +#' @param origin date. Default value is for Windows Excel 2010 +#' @param ... additional parameters passed to as.Date() +#' @details Excel stores dates as number of days from some origin day +#' @seealso [writeData()] +#' @export +#' @examples +#' ## 2014 April 21st to 25th +#' convertToDate(c(41750, 41751, 41752, 41753, 41754, NA)) +#' convertToDate(c(41750.2, 41751.99, NA, 41753)) +convertToDate <- function(x, origin = "1900-01-01", ...) { + x <- as.numeric(x) + notNa <- !is.na(x) + earlyDate <- x < 60 + if (origin == "1900-01-01") { + x[notNa] <- x[notNa] - 2 + x[earlyDate & notNa] <- x[earlyDate & notNa] + 1 + } + + return(as.Date(x, origin = origin, ...)) +} + + +#' @name convertToDateTime +#' @title Convert from excel time number to R POSIXct type. +#' @description Convert from excel time number to R POSIXct type. +#' @param x A numeric vector +#' @param origin date. Default value is for Windows Excel 2010 +#' @param ... Additional parameters passed to as.POSIXct +#' @details Excel stores dates as number of days from some origin date +#' @export +#' @examples +#' ## 2014-07-01, 2014-06-30, 2014-06-29 +#' x <- c(41821.8127314815, 41820.8127314815, NA, 41819, NaN) +#' convertToDateTime(x) +#' convertToDateTime(x, tz = "Australia/Perth") +#' convertToDateTime(x, tz = "UTC") +convertToDateTime <- function(x, origin = "1900-01-01", ...) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + x <- as.numeric(x) + date <- convertToDate(x, origin) + + x <- x * 86400 + rem <- x %% 86400 + + hours <- as.integer(floor(rem / 3600)) + minutes_fraction <- rem %% 3600 + minutes_whole <- as.integer(floor(minutes_fraction / 60)) + secs <- minutes_fraction %% 60 + + y <- sprintf("%02d:%02d:%06.3f", hours, minutes_whole, secs) + notNA <- !is.na(x) + date_time <- rep(NA, length(x)) + date_time[notNA] <- as.POSIXct(paste(date[notNA], y[notNA]), ...) + + date_time <- .POSIXct(date_time) + + return(date_time) +} + + + +#' @name names +#' @title get or set worksheet names +#' @description get or set worksheet names +#' @aliases names.Workbook +#' @export +#' @method names Workbook +#' @param x A `Workbook` object +#' @examples +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, "S1") +#' addWorksheet(wb, "S2") +#' addWorksheet(wb, "S3") +#' +#' names(wb) +#' names(wb)[[2]] <- "S2a" +#' names(wb) +#' names(wb) <- paste("Sheet", 1:3) +names.Workbook <- function(x) { + nms <- x$sheet_names + nms <- replaceXMLEntities(nms) +} + +#' @rdname names +#' @param value a character vector the same length as wb +#' @export +`names<-.Workbook` <- function(x, value) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (any(duplicated(tolower(value)))) { + stop("Worksheet names must be unique.") + } + + existing_sheets <- x$sheet_names + inds <- which(value != existing_sheets) + + if (length(inds) == 0) { + return(invisible(x)) + } + + if (length(value) != length(x$worksheets)) { + stop(sprintf("names vector must have length equal to number of worksheets in Workbook [%s]", length(existing_sheets))) + } + + if (any(nchar(value) > 31)) { + warning("Worksheet names must less than 32 characters. Truncating names...") + value[nchar(value) > 31] <- sapply(value[nchar(value) > 31], substr, start = 1, stop = 31) + } + + for (i in inds) { + invisible(x$setSheetName(i, value[[i]])) + } + + invisible(x) +} + + + +#' @name createNamedRegion +#' @title Create / delete a named region. +#' @description Create / delete a named region +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param rows Numeric vector specifying rows to include in region +#' @param cols Numeric vector specifying columns to include in region +#' @param name Name for region. A character vector of length 1. Note region names musts be case-insensitive unique. +#' @param overwrite Boolean. Overwrite if exists ? Default to FALSE +#' +#' @details Region is given by: min(cols):max(cols) X min(rows):max(rows) +#' @export +#' @seealso [getNamedRegions()] +#' @examples +#' ## create named regions +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' +#' ## specify region +#' writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) +#' createNamedRegion( +#' wb = wb, +#' sheet = 1, +#' name = "iris", +#' rows = 1:(nrow(iris) + 1), +#' cols = 1:ncol(iris) +#' ) +#' +#' +#' ## using writeData 'name' argument +#' writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) +#' +#' out_file <- tempfile(fileext = ".xlsx") +#' \dontrun{ +#' saveWorkbook(wb, out_file, overwrite = TRUE) +#' +#' ## see named regions +#' getNamedRegions(wb) ## From Workbook object +#' getNamedRegions(out_file) ## From xlsx file +#' +#' ## delete one +#' deleteNamedRegion(wb = wb, name = "iris2") +#' getNamedRegions(wb) +#' +#' ## read named regions +#' df <- read.xlsx(wb, namedRegion = "iris") +#' head(df) +#' +#' df <- read.xlsx(out_file, namedRegion = "iris2") +#' head(df) +#' } +#' +#' @rdname NamedRegion +createNamedRegion <- function(wb, sheet, cols, rows, name, overwrite = FALSE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + sheet <- wb$validateSheet(sheet) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (!is.numeric(rows)) { + stop("rows argument must be a numeric/integer vector") + } + + if (!is.numeric(cols)) { + stop("cols argument must be a numeric/integer vector") + } + + ## check name doesn't already exist + ## named region + + ex_names <- regmatches(wb$workbook$definedNames, regexpr('(?<=name=")[^"]+', wb$workbook$definedNames, perl = TRUE)) + ex_names <- tolower(replaceXMLEntities(ex_names)) + + if (tolower(name) %in% ex_names & !overwrite) { + stop(sprintf("Named region with name '%s' already exists! Use overwrite = TRUE if you want to replace it", name)) + } else if (tolower(name) %in% ex_names & overwrite) { + wb$workbook$definedNames <- wb$workbook$definedNames[!ex_names %in% tolower(name)] + } + + if (grepl("^[A-Z]{1,3}[0-9]+$", name)) { + stop("name cannot look like a cell reference.") + } + + cols <- round(cols) + rows <- round(rows) + + startCol <- min(cols) + endCol <- max(cols) + + startRow <- min(rows) + endRow <- max(rows) + + ref1 <- paste0("$", convert_to_excel_ref(cols = startCol, LETTERS = LETTERS), "$", startRow) + ref2 <- paste0("$", convert_to_excel_ref(cols = endCol, LETTERS = LETTERS), "$", endRow) + + invisible( + wb$createNamedRegion(ref1 = ref1, ref2 = ref2, name = name, sheet = wb$sheet_names[sheet]) + ) +} + + +#' @export +#' @rdname NamedRegion +deleteNamedRegion <- function(wb, name) { + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + ex_names <- regmatches(wb$workbook$definedNames, regexpr('(?<=name=")[^"]+', wb$workbook$definedNames, perl = TRUE)) + ex_names <- tolower(replaceXMLEntities(ex_names)) + + if (tolower(name) %in% ex_names) { + wb$workbook$definedNames <- wb$workbook$definedNames[!ex_names %in% tolower(name)] + } else { + warning(sprintf("Cannot find Named region with name '%s'", name)) + } + + invisible(0) +} + + + + +#' @name getNamedRegions +#' @title Get named regions +#' @description Return a vector of named regions in a xlsx file or +#' Workbook object +#' @param x An xlsx file or Workbook object +#' @export +#' @seealso [createNamedRegion()] +#' @examples +#' ## create named regions +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' +#' ## specify region +#' writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) +#' createNamedRegion( +#' wb = wb, +#' sheet = 1, +#' name = "iris", +#' rows = 1:(nrow(iris) + 1), +#' cols = 1:ncol(iris) +#' ) +#' +#' +#' ## using writeData 'name' argument to create a named region +#' writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) +#' \dontrun{ +#' out_file <- tempfile(fileext = ".xlsx") +#' saveWorkbook(wb, out_file, overwrite = TRUE) +#' +#' ## see named regions +#' getNamedRegions(wb) ## From Workbook object +#' getNamedRegions(out_file) ## From xlsx file +#' +#' ## read named regions +#' df <- read.xlsx(wb, namedRegion = "iris") +#' head(df) +#' +#' df <- read.xlsx(out_file, namedRegion = "iris2") +#' head(df) +#' } +#' +getNamedRegions <- function(x) { + UseMethod("getNamedRegions", x) +} + +#' @export +getNamedRegions.default <- function(x) { + if (!file.exists(x)) { + stop(sprintf("File '%s' does not exist.", x)) + } + + xmlDir <- tempfile() + xmlFiles <- unzip(x, exdir = xmlDir) + + workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) + workbook <- unlist(readUTF8(workbook)) + + dn <- getChildlessNode(xml = removeHeadTag(workbook), tag = "definedName") + if (length(dn) == 0) { + return(NULL) + } + + dn_names <- get_named_regions_from_string(dn = dn) + + unlink(xmlDir, recursive = TRUE, force = TRUE) + + return(dn_names) +} + + +#' @export +getNamedRegions.Workbook <- function(x) { + dn <- x$workbook$definedNames + if (length(dn) == 0) { + return(NULL) + } + + dn_names <- get_named_regions_from_string(dn = dn) + + return(dn_names) +} + + + + + + +#' @name addFilter +#' @title Add column filters +#' @description Add excel column filters to a worksheet +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols columns to add filter to. +#' @param rows A row number. +#' @seealso [writeData()] +#' @details adds filters to worksheet columns, same as filter parameters in writeData. +#' writeDataTable automatically adds filters to first row of a table. +#' NOTE Can only have a single filter per worksheet unless using tables. +#' @export +#' @seealso [addFilter()] +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2") +#' addWorksheet(wb, "Sheet 3") +#' +#' writeData(wb, 1, iris) +#' addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) +#' +#' ## Equivalently +#' writeData(wb, 2, x = iris, withFilter = TRUE) +#' +#' ## Similarly +#' writeDataTable(wb, 3, iris) +#' \dontrun{ +#' saveWorkbook(wb, file = "addFilterExample.xlsx", overwrite = TRUE) +#' } +addFilter <- function(wb, sheet, rows, cols) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + + if (length(rows) != 1) { + stop("row must be a numeric of length 1.") + } + + if (!is.numeric(cols)) { + cols <- convertFromExcelRef(cols) + } + + wb$worksheets[[sheet]]$autoFilter <- sprintf('', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":")) + + invisible(wb) +} + + +#' @name removeFilter +#' @title Remove a worksheet filter +#' @description Removes filters from addFilter() and writeData() +#' @param wb A workbook object +#' @param sheet A vector of names or indices of worksheets +#' @export +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2") +#' addWorksheet(wb, "Sheet 3") +#' +#' writeData(wb, 1, iris) +#' addFilter(wb, 1, row = 1, cols = 1:ncol(iris)) +#' +#' ## Equivalently +#' writeData(wb, 2, x = iris, withFilter = TRUE) +#' +#' ## Similarly +#' writeDataTable(wb, 3, iris) +#' +#' ## remove filters +#' removeFilter(wb, 1:2) ## remove filters +#' removeFilter(wb, 3) ## Does not affect tables! +#' \dontrun{ +#' saveWorkbook(wb, file = "removeFilterExample.xlsx", overwrite = TRUE) +#' } +removeFilter <- function(wb, sheet) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + for (s in sheet) { + s <- wb$validateSheet(s) + wb$worksheets[[s]]$autoFilter <- character(0) + } + + invisible(wb) +} + + + + + + + + + + + +#' @name setHeader +#' @title Set header for all worksheets +#' @description DEPRECATED +#' @author Alexander Walker +#' @param wb A workbook object +#' @param text header text. A character vector of length 1. +#' @param position Position of text in header. One of "left", "center" or "right" +#' @export +#' @examples +#' \dontrun{ +#' wb <- createWorkbook("Edgar Anderson") +#' addWorksheet(wb, "S1") +#' writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) +#' +#' ## set all headers +#' setHeader(wb, "This is a header", position = "center") +#' setHeader(wb, "To the left", position = "left") +#' setHeader(wb, "On the right", position = "right") +#' +#' ## set all footers +#' setFooter(wb, "Center Footer Here", position = "center") +#' setFooter(wb, "Bottom left", position = "left") +#' setFooter(wb, Sys.Date(), position = "right") +#' +#' saveWorkbook(wb, "headerHeaderExample.xlsx", overwrite = TRUE) +#' } +setHeader <- function(wb, text, position = "center") { + warning("This function is deprecated. Use function 'setHeaderFooter()'") + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + position <- tolower(position) + if (!position %in% c("left", "center", "right")) { + stop("Invalid position.") + } + + if (length(text) != 1) { + stop("Text argument must be a character vector of length 1") + } + + # sheet <- wb$validateSheet(1) variable not used + wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "head"] <- + as.character(text) +} + + +#' @name setFooter +#' @title Set footer for all worksheets +#' @description DEPRECATED +#' @author Alexander Walker +#' @param wb A workbook object +#' @param text footer text. A character vector of length 1. +#' @param position Position of text in footer. One of "left", "center" or "right" +#' @export +#' @examples +#' \dontrun{ +#' wb <- createWorkbook("Edgar Anderson") +#' addWorksheet(wb, "S1") +#' writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5)) +#' +#' ## set all headers +#' setHeader(wb, "This is a header", position = "center") +#' setHeader(wb, "To the left", position = "left") +#' setHeader(wb, "On the right", position = "right") +#' +#' ## set all footers +#' setFooter(wb, "Center Footer Here", position = "center") +#' setFooter(wb, "Bottom left", position = "left") +#' setFooter(wb, Sys.Date(), position = "right") +#' +#' saveWorkbook(wb, "headerFooterExample.xlsx", overwrite = TRUE) +#' } +setFooter <- function(wb, text, position = "center") { + warning("This function is deprecated. Use function 'setHeaderFooter()'") + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + position <- tolower(position) + if (!position %in% c("left", "center", "right")) { + stop("Invalid position.") + } + + if (length(text) != 1) { + stop("Text argument must be a character vector of length 1") + } + + # sheet <- wb$validateSheet(1) variable not used + wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "foot"] <- as.character(text) +} + + + + + + + + + + + +#' @name dataValidation +#' @title Add data validation to cells +#' @description Add Excel data validation to cells +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols Contiguous columns to apply conditional formatting to +#' @param rows Contiguous rows to apply conditional formatting to +#' @param type One of 'whole', 'decimal', 'date', 'time', 'textLength', 'list' (see examples) +#' @param operator One of 'between', 'notBetween', 'equal', +#' 'notEqual', 'greaterThan', 'lessThan', 'greaterThanOrEqual', 'lessThanOrEqual' +#' @param value a vector of length 1 or 2 depending on operator (see examples) +#' @param allowBlank logical +#' @param showInputMsg logical +#' @param showErrorMsg logical +#' @export +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2") +#' +#' writeDataTable(wb, 1, x = iris[1:30, ]) +#' +#' dataValidation(wb, 1, +#' col = 1:3, rows = 2:31, type = "whole", +#' operator = "between", value = c(1, 9) +#' ) +#' +#' dataValidation(wb, 1, +#' col = 5, rows = 2:31, type = "textLength", +#' operator = "between", value = c(4, 6) +#' ) +#' +#' +#' ## Date and Time cell validation +#' df <- data.frame( +#' "d" = as.Date("2016-01-01") + -5:5, +#' "t" = as.POSIXct("2016-01-01") + -5:5 * 10000 +#' ) +#' +#' writeData(wb, 2, x = df) +#' dataValidation(wb, 2, +#' col = 1, rows = 2:12, type = "date", +#' operator = "greaterThanOrEqual", value = as.Date("2016-01-01") +#' ) +#' +#' dataValidation(wb, 2, +#' col = 2, rows = 2:12, type = "time", +#' operator = "between", value = df$t[c(4, 8)] +#' ) +#' \dontrun{ +#' saveWorkbook(wb, "dataValidationExample.xlsx", overwrite = TRUE) +#' } +#' +#' +#' ###################################################################### +#' ## If type == 'list' +#' # operator argument is ignored. +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' addWorksheet(wb, "Sheet 2") +#' +#' writeDataTable(wb, sheet = 1, x = iris[1:30, ]) +#' writeData(wb, sheet = 2, x = sample(iris$Sepal.Length, 10)) +#' +#' dataValidation(wb, 1, col = 1, rows = 2:31, type = "list", value = "'Sheet 2'!$A$1:$A$10") +#' +#' # openXL(wb) +dataValidation <- function(wb, sheet, cols, rows, type, operator, value, allowBlank = TRUE, showInputMsg = TRUE, showErrorMsg = TRUE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + ## rows and cols + if (!is.numeric(cols)) { + cols <- convertFromExcelRef(cols) + } + rows <- as.integer(rows) + + ## check length of value + if (length(value) > 2) { + stop("value argument must be length < 2") + } + + valid_types <- c( + "whole", + "decimal", + "date", + "time", ## need to conv + "textLength", + "list" + ) + + if (!tolower(type) %in% tolower(valid_types)) { + stop("Invalid 'type' argument!") + } + + + ## operator == 'between' we leave out + valid_operators <- c( + "between", + "notBetween", + "equal", + "notEqual", + "greaterThan", + "lessThan", + "greaterThanOrEqual", + "lessThanOrEqual" + ) + + if (tolower(type) != "list") { + if (!tolower(operator) %in% tolower(valid_operators)) { + stop("Invalid 'operator' argument!") + } + + operator <- valid_operators[tolower(valid_operators) %in% tolower(operator)][1] + } else { + operator <- "between" ## ignored + } + + if (!is.logical(allowBlank)) { + stop("Argument 'allowBlank' musts be logical!") + } + + if (!is.logical(showInputMsg)) { + stop("Argument 'showInputMsg' musts be logical!") + } + + if (!is.logical(showErrorMsg)) { + stop("Argument 'showErrorMsg' musts be logical!") + } + + ## All inputs validated + + type <- valid_types[tolower(valid_types) %in% tolower(type)][1] + + ## check input combinations + if (type == "date" & !"Date" %in% class(value)) { + stop("If type == 'date' value argument must be a Date vector.") + } + + if (type == "time" & !any(tolower(class(value)) %in% c("posixct", "posixt"))) { + stop("If type == 'date' value argument must be a POSIXct or POSIXlt vector.") + } + + + value <- head(value, 2) + allowBlank <- as.integer(allowBlank[1]) + showInputMsg <- as.integer(showInputMsg[1]) + showErrorMsg <- as.integer(showErrorMsg[1]) + + if (type == "list") { + invisible(wb$dataValidation_list( + sheet = sheet, + startRow = min(rows), + endRow = max(rows), + startCol = min(cols), + endCol = max(cols), + value = value, + allowBlank = allowBlank, + showInputMsg = showInputMsg, + showErrorMsg = showErrorMsg + )) + } else { + invisible(wb$dataValidation( + sheet = sheet, + startRow = min(rows), + endRow = max(rows), + startCol = min(cols), + endCol = max(cols), + type = type, + operator = operator, + value = value, + allowBlank = allowBlank, + showInputMsg = showInputMsg, + showErrorMsg = showErrorMsg + )) + } + + + + invisible(0) +} + + + + + + + + +#' @name getDateOrigin +#' @title Get the date origin an xlsx file is using +#' @description Return the date origin used internally by an xlsx or xlsm file +#' @author Alexander Walker +#' @param xlsxFile An xlsx or xlsm file. +#' @details Excel stores dates as the number of days from either 1904-01-01 or 1900-01-01. This function +#' checks the date origin being used in an Excel file and returns is so it can be used in [convertToDate()] +#' @return One of "1900-01-01" or "1904-01-01". +#' @seealso [convertToDate()] +#' @examples +#' +#' ## create a file with some dates +#' \dontrun{ +#' write.xlsx(as.Date("2015-01-10") - (0:4), file = "getDateOriginExample.xlsx") +#' m <- read.xlsx("getDateOriginExample.xlsx") +#' +#' ## convert to dates +#' do <- getDateOrigin(system.file("extdata", "readTest.xlsx", package = "openxlsx")) +#' convertToDate(m[[1]], do) +#' } +#' @export +getDateOrigin <- function(xlsxFile) { + xlsxFile <- getFile(xlsxFile) + if (!file.exists(xlsxFile)) { + stop("File does not exist.") + } + + if (grepl("\\.xls$|\\.xlm$", xlsxFile)) { + stop("openxlsx can not read .xls or .xlm files!") + } + + ## create temp dir and unzip + xmlDir <- tempfile() + xmlFiles <- unzip(xlsxFile, exdir = xmlDir) + + on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE) + + workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) + workbook <- paste(unlist(readUTF8(workbook)), collapse = "") + + if (grepl('date1904="1"|date1904="true"', workbook, ignore.case = TRUE)) { + origin <- "1904-01-01" + } else { + origin <- "1900-01-01" + } + + return(origin) +} + + + + + + + + +#' @name getSheetNames +#' @title Get names of worksheets +#' @description Returns the worksheet names within an xlsx file +#' @author Alexander Walker +#' @param file An xlsx or xlsm file. +#' @return Character vector of worksheet names. +#' @examples +#' getSheetNames(system.file("extdata", "readTest.xlsx", package = "openxlsx")) +#' @export +getSheetNames <- function(file) { + if (!file.exists(file)) { + stop("file does not exist.") + } + + if (grepl("\\.xls$|\\.xlm$", file)) { + stop("openxlsx can not read .xls or .xlm files!") + } + + ## create temp dir and unzip + xmlDir <- tempfile() + xmlFiles <- unzip(file, exdir = xmlDir) + + on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE) + + workbook <- grep("workbook.xml$", xmlFiles, perl = TRUE, value = TRUE) + workbook <- readUTF8(workbook) + workbook <- removeHeadTag(workbook) + sheets <- unlist(regmatches(workbook, gregexpr("(?<=).*(?=)", workbook, perl = TRUE))) + sheets <- unlist(regmatches(sheets, gregexpr("]*>", sheets, perl = TRUE))) + + ## Some veryHidden sheets do not have a sheet content and their rId is empty. + ## Such sheets need to be filtered out because otherwise their sheet names + ## occur in the list of all sheet names, leading to a wrong association + ## of sheet names with sheet indeces. + sheets <- grep('r:id="[[:blank:]]*"', sheets, invert = TRUE, value = TRUE) + + sheetNames <- unlist(regmatches(sheets, gregexpr('(?<=name=")[^"]+', sheets, perl = TRUE))) + sheetNames <- replaceXMLEntities(sheetNames) + + return(sheetNames) +} + + + + +#' @name sheetVisibility +#' @title Get/set worksheet visible state +#' @description Get and set worksheet visible state +#' @param wb A workbook object +#' @return Character vector of worksheet names. +#' @return Vector of "hidden", "visible", "veryHidden" +#' @examples +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, sheetName = "S1", visible = FALSE) +#' addWorksheet(wb, sheetName = "S2", visible = TRUE) +#' addWorksheet(wb, sheetName = "S3", visible = FALSE) +#' +#' sheetVisibility(wb) +#' sheetVisibility(wb)[1] <- TRUE ## show sheet 1 +#' sheetVisibility(wb)[2] <- FALSE ## hide sheet 2 +#' sheetVisibility(wb)[3] <- "hidden" ## hide sheet 3 +#' sheetVisibility(wb)[3] <- "veryHidden" ## hide sheet 3 from UI +#' @export +sheetVisibility <- function(wb) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + state <- rep("visible", length(wb$workbook$sheets)) + state[grepl("hidden", wb$workbook$sheets)] <- "hidden" + state[grepl("veryHidden", wb$workbook$sheets, ignore.case = TRUE)] <- "veryHidden" + + + return(state) +} + +#' @rdname sheetVisibility +#' @param value a logical/character vector the same length as sheetVisibility(wb) +#' @export +`sheetVisibility<-` <- function(wb, value) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + value <- tolower(as.character(value)) + if (!any(value %in% c("true", "visible"))) { + stop("A workbook must have atleast 1 visible worksheet.") + } + + value[value %in% "true"] <- "visible" + value[value %in% "false"] <- "hidden" + value[value %in% "veryhidden"] <- "veryHidden" + + + exState0 <- regmatches(wb$workbook$sheets, regexpr('(?<=state=")[^"]+', wb$workbook$sheets, perl = TRUE)) + exState <- tolower(exState0) + exState[exState %in% "true"] <- "visible" + exState[exState %in% "hidden"] <- "hidden" + exState[exState %in% "false"] <- "hidden" + exState[exState %in% "veryhidden"] <- "veryHidden" + + if (length(value) != length(wb$workbook$sheets)) { + stop(sprintf("value vector must have length equal to number of worksheets in Workbook [%s]", length(exState))) + } + + inds <- which(value != exState) + if (length(inds) == 0) { + return(invisible(wb)) + } + + for (i in seq_along(wb$worksheets)) { + wb$workbook$sheets[i] <- gsub(exState0[i], value[i], wb$workbook$sheets[i], fixed = TRUE) + } + + invisible(wb) +} + + + + + +#' @name pageBreak +#' @title add a page break to a worksheet +#' @description insert page breaks into a worksheet +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param i row or column number to insert page break. +#' @param type One of "row" or "column" for a row break or column break. +#' @export +#' @seealso [addWorksheet()] +#' @examples +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' writeData(wb, sheet = 1, x = iris) +#' +#' pageBreak(wb, sheet = 1, i = 10, type = "row") +#' pageBreak(wb, sheet = 1, i = 20, type = "row") +#' pageBreak(wb, sheet = 1, i = 2, type = "column") +#' \dontrun{ +#' saveWorkbook(wb, "pageBreakExample.xlsx", TRUE) +#' } +#' ## In Excel: View tab -> Page Break Preview +pageBreak <- function(wb, sheet, i, type = "row") { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + + type <- tolower(type)[1] + if (!type %in% c("row", "column")) { + stop("'type' argument must be 'row' or 'column'.") + } + + if (!is.numeric(i)) { + stop("'i' must be numeric.") + } + i <- round(i) + + if (type == "row") { + wb$worksheets[[sheet]]$rowBreaks <- c( + wb$worksheets[[sheet]]$rowBreaks, + sprintf('', i) + ) + } else if (type == "column") { + wb$worksheets[[sheet]]$colBreaks <- c( + wb$worksheets[[sheet]]$colBreaks, + sprintf('', i) + ) + } + + + # wb$worksheets[[sheet]]$autoFilter <- sprintf('', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":")) + + invisible(wb) +} + + + + + + + + + + + + + + + + + + +#' @name conditionalFormat +#' @title Add conditional formatting to cells +#' @description DEPRECATED! USE [conditionalFormatting()] +#' @author Alexander Walker +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols Columns to apply conditional formatting to +#' @param rows Rows to apply conditional formatting to +#' @param rule The condition under which to apply the formatting or a vector of colours. See examples. +#' @param style A style to apply to those cells that satisfy the rule. A Style object returned from createStyle() +#' @details DEPRECATED! USE [conditionalFormatting()] +#' +#' Valid operators are "<", "<=", ">", ">=", "==", "!=". See Examples. +#' Default style given by: createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +#' @param type Either 'expression', 'colorscale' or 'databar'. If 'expression' the formatting is determined +#' by a formula. If colorScale cells are coloured based on cell value. See examples. +#' @seealso [createStyle()] +#' @export +conditionalFormat <- function(wb, sheet, cols, rows, rule = NULL, style = NULL, type = "expression") { + warning("conditionalFormat() has been deprecated. Use conditionalFormatting().") + ## Rule always applies to top left of sqref, $ determine which cells the rule depends on + ## Rule for "databar" and colourscale are colours of length 2/3 or 1 respectively. + + type <- tolower(type) + if (tolower(type) %in% c("colorscale", "colourscale")) { + type <- "colorScale" + } else if (type == "databar") { + type <- "dataBar" + } else if (type != "expression") { + stop("Invalid type argument. Type must be 'expression', 'colourScale' or 'databar'") + } + + ## rows and cols + if (!is.numeric(cols)) { + cols <- convertFromExcelRef(cols) + } + rows <- as.integer(rows) + + ## check valid rule + if (type == "colorScale") { + if (!length(rule) %in% 2:3) { + stop("rule must be a vector containing 2 or 3 colours if type is 'colorScale'") + } + + rule <- validateColour(rule, errorMsg = "Invalid colour specified in rule.") + dxfId <- NULL + } else if (type == "dataBar") { + + ## If rule is NULL use default colour + if (is.null(rule)) { + rule <- "FF638EC6" + } else { + rule <- validateColour(rule, errorMsg = "Invalid colour specified in rule.") + } + + dxfId <- NULL + } else { ## else type == "expression" + + rule <- toupper(gsub(" ", "", rule)) + rule <- replaceIllegalCharacters(rule) + rule <- gsub("!=", "<>", rule) + rule <- gsub("==", "=", rule) + + if (!grepl("[A-Z]", substr(rule, 1, 2))) { + + ## formula looks like "operatorX" , attach top left cell to rule + rule <- paste0(getCellRefs(data.frame("x" = min(rows), "y" = min(cols))), rule) + } ## else, there is a letter in the formula and apply as is + + if (is.null(style)) { + style <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") + } + + invisible(dxfId <- wb$addDXFS(style)) + } + + + invisible(wb$conditionalFormatCell(sheet, + startRow = min(rows), + endRow = max(rows), + startCol = min(cols), + endCol = max(cols), + dxfId, + formula = rule, + type = type + )) + + invisible(0) +} + + + + +#' @name all.equal +#' @aliases all.equal.Workbook +#' @title Check equality of workbooks +#' @description Check equality of workbooks +#' @method all.equal Workbook +#' @param target A `Workbook` object +#' @param current A `Workbook` object +#' @param ... ignored +all.equal.Workbook <- function(target, current, ...) { + + + # print("Comparing workbooks...") + # ".rels", + # "app", + # "charts", + # "colWidths", + # "Content_Types", + # "core", + # "drawings", + # "drawings_rels", + # "media", + # "rowHeights", + # "workbook", + # "workbook.xml.rels", + # "worksheets", + # "sheetOrder" + # "sharedStrings", + # "tables", + # "tables.xml.rels", + # "theme" + + + ## TODO + # sheet_data + + x <- target + y <- current + + + + + nSheets <- length(names(x)) + failures <- NULL + + flag <- all(names(x$charts) %in% names(y$charts)) & all(names(y$charts) %in% names(x$charts)) + if (!flag) { + message("charts not equal") + failures <- c(failures, "wb$charts") + } + + flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$colWidths[[i]], y$colWidths[[i]])))) + if (!flag) { + message("colWidths not equal") + failures <- c(failures, "wb$colWidths") + } + + flag <- all(x$Content_Types %in% y$Content_Types) & all(y$Content_Types %in% x$Content_Types) + if (!flag) { + message("Content_Types not equal") + failures <- c(failures, "wb$Content_Types") + } + + flag <- all(unlist(x$core) == unlist(y$core)) + if (!flag) { + message("core not equal") + failures <- c(failures, "wb$core") + } + + + flag <- all(unlist(x$drawings) %in% unlist(y$drawings)) & all(unlist(y$drawings) %in% unlist(x$drawings)) + if (!flag) { + message("drawings not equal") + failures <- c(failures, "wb$drawings") + } + + flag <- all(unlist(x$drawings_rels) %in% unlist(y$drawings_rels)) & all(unlist(y$drawings_rels) %in% unlist(x$drawings_rels)) + if (!flag) { + message("drawings_rels not equal") + failures <- c(failures, "wb$drawings_rels") + } + + flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$drawings_rels[[i]], y$drawings_rels[[i]])))) + if (!flag) { + message("drawings_rels not equal") + failures <- c(failures, "wb$drawings_rels") + } + + + + + flag <- all(names(x$media) %in% names(y$media) & names(y$media) %in% names(x$media)) + if (!flag) { + message("media not equal") + failures <- c(failures, "wb$media") + } + + flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$rowHeights[[i]], y$rowHeights[[i]])))) + if (!flag) { + message("rowHeights not equal") + failures <- c(failures, "wb$rowHeights") + } + + flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(names(x$rowHeights[[i]]), names(y$rowHeights[[i]]))))) + if (!flag) { + message("rowHeights not equal") + failures <- c(failures, "wb$rowHeights") + } + + flag <- all(x$sharedStrings %in% y$sharedStrings) & all(y$sharedStrings %in% x$sharedStrings) & (length(x$sharedStrings) == length(y$sharedStrings)) + if (!flag) { + message("sharedStrings not equal") + failures <- c(failures, "wb$sharedStrings") + } + + + + # flag <- sapply(1:nSheets, function(i) isTRUE(all.equal(x$worksheets[[i]]$sheet_data, y$worksheets[[i]]$sheet_data))) + # if(!all(flag)){ + # + # tmp_x <- x$sheet_data[[which(!flag)[[1]]]] + # tmp_y <- y$sheet_data[[which(!flag)[[1]]]] + # + # tmp_x_e <- sapply(tmp_x, "[[", "r") + # tmp_y_e <- sapply(tmp_y, "[[", "r") + # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") + # if(any(flag)){ + # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) + # message(sprintf("r elements: %s", paste(which(flag), collapse = ", "))) + # return(FALSE) + # } + # + # tmp_x_e <- sapply(tmp_x, "[[", "t") + # tmp_y_e <- sapply(tmp_y, "[[", "t") + # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") + # if(any(flag)){ + # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) + # message(sprintf("t elements: %s", paste(which(isTRUE(flag)), collapse = ", "))) + # return(FALSE) + # } + # + # + # tmp_x_e <- sapply(tmp_x, "[[", "v") + # tmp_y_e <- sapply(tmp_y, "[[", "v") + # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") + # if(any(flag)){ + # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) + # message(sprintf("v elements: %s", paste(which(flag), collapse = ", "))) + # return(FALSE) + # } + # + # tmp_x_e <- sapply(tmp_x, "[[", "f") + # tmp_y_e <- sapply(tmp_y, "[[", "f") + # flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "") + # if(any(flag)){ + # message(sprintf("sheet_data %s not equal", which(!flag)[[1]])) + # message(sprintf("f elements: %s", paste(which(flag), collapse = ", "))) + # return(FALSE) + # } + # } + + + flag <- all(names(x$styles) %in% names(y$styles)) & all(names(y$styles) %in% names(x$styles)) + if (!flag) { + message("names styles not equal") + failures <- c(failures, "names of styles not equal") + } + + flag <- all(unlist(x$styles) %in% unlist(y$styles)) & all(unlist(y$styles) %in% unlist(x$styles)) + if (!flag) { + message("styles not equal") + failures <- c(failures, "styles not equal") + } + + + flag <- length(x$styleObjects) == length(y$styleObjects) + if (!flag) { + message("styleObjects lengths not equal") + failures <- c(failures, "styleObjects lengths not equal") + } + + + nStyles <- length(x$styleObjects) + if (nStyles > 0) { + for (i in 1:nStyles) { + sx <- x$styleObjects[[i]] + sy <- y$styleObjects[[i]] + + flag <- isTRUE(all.equal(sx$sheet, sy$sheet)) + if (!flag) { + message(sprintf("styleObjects '%s' sheet name not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' sheet name not equal", i)) + } + + + flag <- isTRUE(all.equal(sx$rows, sy$rows)) + if (!flag) { + message(sprintf("styleObjects '%s' rows not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' rows not equal", i)) + } + + flag <- isTRUE(all.equal(sx$cols, sy$cols)) + if (!flag) { + message(sprintf("styleObjects '%s' cols not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' cols not equal", i)) + } + + ## check style class equality + flag <- isTRUE(all.equal(sx$style$fontName, sy$style$fontName)) + if (!flag) { + message(sprintf("styleObjects '%s' fontName not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' fontName not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$fontColour, sy$style$fontColour)) + if (!flag) { + message(sprintf("styleObjects '%s' fontColour not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' fontColour not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$fontSize, sy$style$fontSize)) + if (!flag) { + message(sprintf("styleObjects '%s' fontSize not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' fontSize not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$fontFamily, sy$style$fontFamily)) + if (!flag) { + message(sprintf("styleObjects '%s' fontFamily not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' fontFamily not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$fontDecoration, sy$style$fontDecoration)) + if (!flag) { + message(sprintf("styleObjects '%s' fontDecoration not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' fontDecoration not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderTop, sy$style$borderTop)) + if (!flag) { + message(sprintf("styleObjects '%s' borderTop not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderTop not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderLeft, sy$style$borderLeft)) + if (!flag) { + message(sprintf("styleObjects '%s' borderLeft not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderLeft not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderRight, sy$style$borderRight)) + if (!flag) { + message(sprintf("styleObjects '%s' borderRight not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderRight not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderBottom, sy$style$borderBottom)) + if (!flag) { + message(sprintf("styleObjects '%s' borderBottom not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderBottom not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderTopColour, sy$style$borderTopColour)) + if (!flag) { + message(sprintf("styleObjects '%s' borderTopColour not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderTopColour not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderLeftColour, sy$style$borderLeftColour)) + if (!flag) { + message(sprintf("styleObjects '%s' borderLeftColour not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderLeftColour not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderRightColour, sy$style$borderRightColour)) + if (!flag) { + message(sprintf("styleObjects '%s' borderRightColour not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderRightColour not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$borderBottomColour, sy$style$borderBottomColour)) + if (!flag) { + message(sprintf("styleObjects '%s' borderBottomColour not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' borderBottomColour not equal", i)) + } + + + flag <- isTRUE(all.equal(sx$style$halign, sy$style$halign)) + if (!flag) { + message(sprintf("styleObjects '%s' halign not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' halign not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$valign, sy$style$valign)) + if (!flag) { + message(sprintf("styleObjects '%s' valign not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' valign not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$indent, sy$style$indent)) + if (!flag) { + message(sprintf("styleObjects '%s' indent not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' indent not equal", i)) + } + + + flag <- isTRUE(all.equal(sx$style$textRotation, sy$style$textRotation)) + if (!flag) { + message(sprintf("styleObjects '%s' textRotation not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' textRotation not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$numFmt, sy$style$numFmt)) + if (!flag) { + message(sprintf("styleObjects '%s' numFmt not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' numFmt not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$fill, sy$style$fill)) + if (!flag) { + message(sprintf("styleObjects '%s' fill not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' fill not equal", i)) + } + + flag <- isTRUE(all.equal(sx$style$wrapText, sy$style$wrapText)) + if (!flag) { + message(sprintf("styleObjects '%s' wrapText not equal", i)) + failures <- c(failures, sprintf("styleObjects '%s' wrapText not equal", i)) + } + } + } + + + flag <- all(x$sheet_names %in% y$sheet_names) & all(y$sheet_names %in% x$sheet_names) + if (!flag) { + message("names workbook not equal") + failures <- c(failures, "names workbook not equal") + } + + flag <- all(unlist(x$workbook) %in% unlist(y$workbook)) & all(unlist(y$workbook) %in% unlist(x$workbook)) + if (!flag) { + message("workbook not equal") + failures <- c(failures, "wb$workbook") + } + + flag <- all(unlist(x$workbook.xml.rels) %in% unlist(y$workbook.xml.rels)) & all(unlist(y$workbook.xml.rels) %in% unlist(x$workbook.xml.rels)) + if (!flag) { + message("workbook.xml.rels not equal") + failures <- c(failures, "wb$workbook.xml.rels") + } + + + for (i in 1:nSheets) { + ws_x <- x$worksheets[[i]] + ws_y <- y$worksheets[[i]] + + flag <- all(names(ws_x) %in% names(ws_y)) & all(names(ws_y) %in% names(ws_x)) + if (!flag) { + message(sprintf("names of worksheet elements for sheet %s not equal", i)) + failures <- c(failures, sprintf("names of worksheet elements for sheet %s not equal", i)) + } + + nms <- c( + "sheetPr", "dataValidations", "sheetViews", "cols", "pageMargins", + "extLst", "conditionalFormatting", "oleObjects", + "colBreaks", "dimension", "drawing", "sheetFormatPr", "tableParts", + "mergeCells", "hyperlinks", "headerFooter", "autoFilter", + "rowBreaks", "pageSetup", "freezePane", "legacyDrawingHF", "legacyDrawing" + ) + + for (j in nms) { + flag <- isTRUE(all.equal(gsub(" |\t", "", ws_x[[j]]), gsub(" |\t", "", ws_y[[j]]))) + if (!flag) { + message(sprintf("worksheet '%s', element '%s' not equal", i, j)) + failures <- c(failures, sprintf("worksheet '%s', element '%s' not equal", i, j)) + } + } + } + + + flag <- all(unlist(x$sheetOrder) %in% unlist(y$sheetOrder)) & all(unlist(y$sheetOrder) %in% unlist(x$sheetOrder)) + if (!flag) { + message("sheetOrder not equal") + failures <- c(failures, "sheetOrder not equal") + } + + + flag <- length(x$tables) == length(y$tables) + if (!flag) { + message("length of tables not equal") + failures <- c(failures, "length of tables not equal") + } + + flag <- all(names(x$tables) == names(y$tables)) + if (!flag) { + message("names of tables not equal") + failures <- c(failures, "names of tables not equal") + } + + flag <- all(unlist(x$tables) == unlist(y$tables)) + if (!flag) { + message("tables not equal") + failures <- c(failures, "tables not equal") + } + + + flag <- isTRUE(all.equal(x$tables.xml.rels, y$tables.xml.rels)) + if (!flag) { + message("tables.xml.rels not equal") + failures <- c(failures, "tables.xml.rels not equal") + } + + flag <- x$theme == y$theme + if (!flag) { + message("theme not equal") + failures <- c(failures, "theme not equal") + } + + if (!is.null(failures)) { + return(FALSE) + } + + + # "connections", + # "externalLinks", + # "externalLinksRels", + # "headFoot", + # "pivotTables", + # "pivotTables.xml.rels", + # "pivotDefinitions", + # "pivotRecords", + # "pivotDefinitionsRels", + # "queryTables", + # "slicers", + # "slicerCaches", + # "vbaProject", + + + return(TRUE) +} + + + +#' @name sheetVisible +#' @title Get worksheet visible state. +#' @description DEPRECATED - Use function 'sheetVisibility() +#' @author Alexander Walker +#' @param wb A workbook object +#' @return Character vector of worksheet names. +#' @return TRUE if sheet is visible, FALSE if sheet is hidden +#' @examples +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, sheetName = "S1", visible = FALSE) +#' addWorksheet(wb, sheetName = "S2", visible = TRUE) +#' addWorksheet(wb, sheetName = "S3", visible = FALSE) +#' +#' sheetVisible(wb) +#' sheetVisible(wb)[1] <- TRUE ## show sheet 1 +#' sheetVisible(wb)[2] <- FALSE ## hide sheet 2 +#' @export +sheetVisible <- function(wb) { + warning("This function is deprecated. Use function 'sheetVisibility()'") + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + state <- rep(TRUE, length(wb$workbook$sheets)) + state[grepl("hidden", wb$workbook$sheets)] <- FALSE + + return(state) +} + +#' @rdname sheetVisible +#' @param value a logical vector the same length as sheetVisible(wb) +#' @export +`sheetVisible<-` <- function(wb, value) { + warning("This function is deprecated. Use function 'sheetVisibility()'") + + if (!is.logical(value)) { + stop("value must be a logical vector.") + } + + if (!any(value)) { + stop("A workbook must have atleast 1 visible worksheet.") + } + + value <- as.character(value) + value[value %in% "TRUE"] <- "visible" + value[value %in% "FALSE"] <- "hidden" + + exState <- rep("visible", length(wb$workbook$sheets)) + exState[grepl("hidden", wb$workbook$sheets)] <- "hidden" + + if (length(value) != length(wb$workbook$sheets)) { + stop(sprintf("value vector must have length equal to number of worksheets in Workbook [%s]", length(exState))) + } + + inds <- which(value != exState) + if (length(inds) == 0) { + return(invisible(wb)) + } + + for (i in inds) { + wb$workbook$sheets[i] <- gsub(exState[i], value[i], wb$workbook$sheets[i]) + } + + invisible(wb) +} + + + +#' @name copyWorkbook +#' @title Copy a Workbook object. +#' @description Just a wrapper of wb$copy() +#' @param wb A workbook object +#' @return Workbook +#' @examples +#' +#' wb <- createWorkbook() +#' wb2 <- wb ## does not create a copy +#' wb3 <- copyWorkbook(wb) ## wrapper for wb$copy() +#' +#' addWorksheet(wb, "Sheet1") ## adds worksheet to both wb and wb2 but not wb3 +#' +#' names(wb) +#' names(wb2) +#' names(wb3) +#' @export +copyWorkbook <- function(wb) { + if (!inherits(wb, "Workbook")) { + stop("argument must be a Workbook.") + } + + return(wb$copy()) +} + + + + + +#' @name getTables +#' @title List Excel tables in a workbook +#' @description List Excel tables in a workbook +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @return character vector of table names on the specified sheet +#' @examples +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, sheetName = "Sheet 1") +#' writeDataTable(wb, sheet = "Sheet 1", x = iris) +#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) +#' +#' getTables(wb, sheet = "Sheet 1") +#' @export +getTables <- function(wb, sheet) { + if (!inherits(wb, "Workbook")) { + stop("argument must be a Workbook.") + } + + if (length(sheet) != 1) { + stop("sheet argument must be length 1") + } + + if (length(wb$tables) == 0) { + return(character(0)) + } + + sheet <- wb$validateSheet(sheetName = sheet) + + table_sheets <- attr(wb$tables, "sheet") + tables <- attr(wb$tables, "tableName") + refs <- names(wb$tables) + + refs <- refs[table_sheets == sheet & !grepl("openxlsx_deleted", tables, fixed = TRUE)] + tables <- tables[table_sheets == sheet & !grepl("openxlsx_deleted", tables, fixed = TRUE)] + + if (length(tables) > 0) { + attr(tables, "refs") <- refs + } + + return(tables) +} + + + + + +#' @name removeTable +#' @title Remove an Excel table in a workbook +#' @description List Excel tables in a workbook +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param table Name of table to remove. See [getTables()] +#' @return character vector of table names on the specified sheet +#' @examples +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, sheetName = "Sheet 1") +#' addWorksheet(wb, sheetName = "Sheet 2") +#' writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") +#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) +#' +#' +#' removeWorksheet(wb, sheet = 1) ## delete worksheet removes table objects +#' +#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris") +#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) +#' +#' ## removeTable() deletes table object and all data +#' getTables(wb, sheet = 1) +#' removeTable(wb = wb, sheet = 1, table = "iris") +#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) +#' +#' getTables(wb, sheet = 1) +#' removeTable(wb = wb, sheet = 1, table = "iris") +#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) +#' \dontrun{ +#' saveWorkbook(wb = wb, file = "removeTableExample.xlsx", overwrite = TRUE) +#' } +#' +#' @export +removeTable <- function(wb, sheet, table) { + if (!inherits(wb, "Workbook")) { + stop("argument must be a Workbook.") + } + + if (length(sheet) != 1) { + stop("sheet argument must be length 1") + } + + if (length(table) != 1) { + stop("table argument must be length 1") + } + + ## delete table object and all data in it + sheet <- wb$validateSheet(sheetName = sheet) + + if (!table %in% attr(wb$tables, "tableName")) { + stop(sprintf("table '%s' does not exist.", table), call. = FALSE) + } + + ## get existing tables + table_sheets <- attr(wb$tables, "sheet") + table_names <- attr(wb$tables, "tableName") + refs <- names(wb$tables) + + ## delete table object (by flagging as deleted) + inds <- which(table_sheets %in% sheet & table_names %in% table) + table_name_original <- table_names[inds] + + table_names[inds] <- paste0(table_name_original, "_openxlsx_deleted") + attr(wb$tables, "tableName") <- table_names + + ## delete reference from worksheet to table + worksheet_table_names <- attr(wb$worksheets[[sheet]]$tableParts, "tableName") + to_remove <- which(worksheet_table_names == table_name_original) + + wb$worksheets[[sheet]]$tableParts <- wb$worksheets[[sheet]]$tableParts[-to_remove] + attr(wb$worksheets[[sheet]]$tableParts, "tableName") <- worksheet_table_names[-to_remove] + + + ## Now delete data from the worksheet + refs <- strsplit(refs[[inds]], split = ":")[[1]] + rows <- as.integer(gsub("[A-Z]", "", refs)) + rows <- seq(from = rows[1], to = rows[2], by = 1) + + cols <- convertFromExcelRef(refs) + cols <- seq(from = cols[1], to = cols[2], by = 1) + + ## now delete data + deleteData(wb = wb, sheet = sheet, rows = rows, cols = cols, gridExpand = TRUE) + + invisible(0) +} + +#' @name groupColumns +#' @title Group columns +#' @description Group a selection of columns +#' @author Joshua Sturm +#' @param wb A workbook object. +#' @param sheet A name or index of a worksheet. +#' @param cols Indices of cols to group. +#' @param hidden Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE. +#' @details Group columns together, with the option to hide them. +#' +#' NOTE: [setColWidths()] has a conflicting `hidden` parameter; changing one will update the other. +#' @seealso [ungroupColumns()] to ungroup columns. [groupRows()] for grouping rows. +#' @export +#' +groupColumns <- function(wb, sheet, cols, hidden = FALSE) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + sheet <- wb$validateSheet(sheet) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + if (any(cols) < 1L) { + stop("Invalid columns selected (<= 0).") + } + + if (!is.logical(hidden)) { + stop("Hidden should be a logical value (TRUE/FALSE).") + } + + if (length(hidden) > length(cols)) { + stop("Hidden argument is of greater length than number of cols.") + } + + levels <- rep("1", length(cols)) + hidden <- rep(hidden, length.out = length(cols)) + + hidden <- hidden[!duplicated(cols)] + levels <- levels[!duplicated(cols)] + cols <- cols[!duplicated(cols)] + cols <- convertFromExcelRef(cols) + + if (length(wb$colWidths[[sheet]]) > 0) { + existing_cols <- names(wb$colWidths[[sheet]]) + existing_hidden <- attr(wb$colWidths[[sheet]], "hidden", exact = TRUE) + + if (any(existing_cols %in% cols)) { + for (i in intersect(existing_cols, cols)) { + width_hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i] + outline_hidden <- as.character(as.integer(hidden))[cols == i] + + if (width_hidden != outline_hidden) { + attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i] <- outline_hidden + } + } + + # cols <- cols[!cols %in% existing_cols] + # hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "name") %in% cols] + + # wb$colOutlineLevels[[sheet]] <- cols + # attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(hidden)) + } + } + + if (length(wb$colOutlineLevels[[sheet]]) > 0) { + existing_cols <- names(wb$colOutlineLevels[[sheet]]) + existing_levels <- unname(wb$colOutlineLevels[[sheet]]) + existing_hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden") + + # check if column is already grouped + flag <- existing_cols %in% cols + if (any(flag)) { + existing_cols <- existing_cols[!flag] + existing_levels <- existing_levels[!flag] + existing_hidden <- existing_hidden[!flag] + } + + all_names <- c(existing_cols, cols) + all_levels <- c(existing_levels, levels) + all_hidden <- c(existing_hidden, as.character(as.integer(hidden))) + + ord <- order(as.integer(all_names)) + all_names <- all_names[ord] + all_levels <- all_levels[ord] + all_hidden <- all_hidden[ord] + + + names(all_levels) <- all_names + wb$colOutlineLevels[[sheet]] <- all_levels + levels <- all_levels + attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(all_hidden)) + hidden <- all_hidden + } else { + names(levels) <- cols + wb$colOutlineLevels[[sheet]] <- levels + attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(hidden)) + } + + invisible(0) +} + +#' @name ungroupColumns +#' @title Ungroup Columns +#' @description Ungroup a selection of columns +#' @author Joshua Sturm +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param cols Indices of columns to ungroup +#' @details If column was previously hidden, it will now be shown +#' @seealso [ungroupRows()] To ungroup rows +#' @export + +ungroupColumns <- function(wb, sheet, cols) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + + if (!is.numeric(cols)) { + cols <- convertFromExcelRef(cols) + } + + if (any(cols) < 1L) { + stop("Invalid columns selected (<= 0).") + } + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + customCols <- as.integer(names(wb$colOutlineLevels[[sheet]])) + removeInds <- which(customCols %in% cols) + + # Check if any selected columns are already grouped + if (length(removeInds) > 0) { + remainingCols <- customCols[-removeInds] + if (length(remainingCols) == 0) { + wb$colOutlineLevels[[sheet]] <- list() + wb$worksheets[[sheet]]$sheetFormatPr <- sub(' outlineLevelCol="1"', "", wb$worksheets[[sheet]]$sheetFormatPr) + } else { + rem_widths <- wb$colOutlineLevels[[sheet]][-removeInds] + names(rem_widths) <- as.character(remainingCols) + wb$colOutlineLevels[[sheet]] <- rem_widths + } + } + + if (length(wb$colWidths[[sheet]]) > 0) { + if (any(cols %in% names(wb$colWidths[[sheet]]))) { + attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") %in% cols] <- "0" + } + } +} + +#' @name groupRows +#' @title Group Rows +#' @description Group a selection of rows +#' @author Joshua Sturm +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param rows Indices of rows to group +#' @param hidden Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE +#' @seealso [ungroupRows()] to ungroup rows. [groupColumns()] for grouping columns. +#' @export + +groupRows <- function(wb, sheet, rows, hidden = FALSE) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + + if (length(hidden) > length(rows)) { + stop("Hidden argument is of greater length than number of rows.") + } + + if (!is.logical(hidden)) { + stop("Hidden should be a logical value (TRUE/FALSE).") + } + + if (any(rows) < 1L) { + stop("Invalid rows entered (<= 0).") + } + + hidden <- rep(as.character(as.integer(hidden)), length.out = length(rows)) + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + levels <- rep("1", length(rows)) + + # Remove duplicates + hidden <- hidden[!duplicated(rows)] + levels <- levels[!duplicated(rows)] + rows <- rows[!duplicated(rows)] + + names(levels) <- rows + + wb$groupRows(sheet = sheet, rows = rows, hidden = hidden, levels = levels) +} + +#' @name ungroupRows +#' @title Ungroup Rows +#' @description Ungroup a selection of rows +#' @author Joshua Sturm +#' @param wb A workbook object +#' @param sheet A name or index of a worksheet +#' @param rows Indices of rows to ungroup +#' @details If row was previously hidden, it will now be shown +#' @seealso [ungroupColumns()] +#' @export + +ungroupRows <- function(wb, sheet, rows) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + sheet <- wb$validateSheet(sheet) + + if (any(rows) < 1L) { + stop("Invalid rows entered (<= 0).") + } + + customRows <- as.integer(names(wb$outlineLevels[[sheet]])) + removeInds <- which(customRows %in% rows) + if (length(removeInds) > 0) { + wb$outlineLevels[[sheet]] <- wb$outlineLevels[[sheet]][-removeInds] + } + + if (length(wb$outlineLevels[[sheet]]) == 0) { + wb$worksheets[[sheet]]$sheetFormatPr <- sub(' outlineLevelRow="1"', "", wb$worksheets[[sheet]]$sheetFormatPr) + } +} + + + + +#' @name addCreator +#' @title Add another author to the meta data of the file. +#' @author Philipp Schauberger +#' @description Just a wrapper of wb$addCreator() +#' @param wb A workbook object +#' @param Creator A string object with the name of the creator +#' @examples +#' +#' wb <- createWorkbook() +#' addCreator(wb, "test") +#' @export +addCreator <- function(wb, Creator) { + if (!inherits(wb, "Workbook")) { + stop("argument must be a Workbook.") + } + + invisible(wb$addCreator(Creator)) +} + +#' @name setLastModifiedBy +#' @title Add another author to the meta data of the file. +#' @author Philipp Schauberger +#' @description Just a wrapper of wb$changeLastModifiedBy() +#' @param wb A workbook object +#' @param LastModifiedBy A string object with the name of the LastModifiedBy-User +#' @examples +#' +#' wb <- createWorkbook() +#' setLastModifiedBy(wb, "test") +#' @export +setLastModifiedBy <- function(wb, LastModifiedBy) { + if (!inherits(wb, "Workbook")) { + stop("argument must be a Workbook.") + } + + invisible(wb$changeLastModifiedBy(LastModifiedBy)) +} + + + +#' @name getCreators +#' @title Add another author to the meta data of the file. +#' @description Just a wrapper of wb$getCreators() +#' Get the names of the +#' @param wb A workbook object +#' @author Philipp Schauberger +#' @return vector of creators +#' @examples +#' +#' wb <- createWorkbook() +#' getCreators(wb) +#' @export +getCreators <- function(wb) { + if (!inherits(wb, "Workbook")) { + stop("argument must be a Workbook.") + } + + return(wb$getCreators()) +} + +#' @name activeSheet +#' @title Get/set active sheet of the workbook +#' @author Philipp Schauberger +#' @description Get and set active sheet of the workbook +#' @param wb A workbook object +#' @return return the active sheet of the workbook +#' @examples +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, sheetName = "S1") +#' addWorksheet(wb, sheetName = "S2") +#' addWorksheet(wb, sheetName = "S3") +#' +#' activeSheet(wb) # default value is the first sheet active +#' activeSheet(wb) <- 1 ## active sheet S1 +#' activeSheet(wb) +#' activeSheet(wb) <- "S2" ## active sheet S2 +#' activeSheet(wb) +#' @export +activeSheet <- function(wb) { + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + + return(wb$ActiveSheet) +} + +#' @rdname activeSheet +#' @param value index of the active sheet or name of the active sheet +#' @export +`activeSheet<-` <- function(wb, value) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!"Workbook" %in% class(wb)) { + stop("First argument must be a Workbook.") + } + + invisible(wb$setactiveSheet(value)) + invisible(wb) +} diff -Nru r-cran-openxlsx-4.2.4/R/writeData.R r-cran-openxlsx-4.2.5/R/writeData.R --- r-cran-openxlsx-4.2.4/R/writeData.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/writeData.R 2021-12-13 12:05:19.000000000 +0000 @@ -1,551 +1,553 @@ -#' @name writeData -#' @title Write an object to a worksheet -#' @author Alexander Walker -#' @import stringi -#' @description Write an object to worksheet with optional styling. -#' @param wb A Workbook object containing a worksheet. -#' @param sheet The worksheet to write to. Can be the worksheet index or name. -#' @param x Object to be written. For classes supported look at the examples. -#' @param startCol A vector specifying the starting column to write to. -#' @param startRow A vector specifying the starting row to write to. -#' @param array A bool if the function written is of type array -#' @param xy An alternative to specifying \code{startCol} and -#' \code{startRow} individually. A vector of the form -#' \code{c(startCol, startRow)}. -#' @param colNames If \code{TRUE}, column names of x are written. -#' @param rowNames If \code{TRUE}, data.frame row names of x are written. -#' @param row.names,col.names Deprecated, please use \code{rowNames}, \code{colNames} instead -#' @param headerStyle Custom style to apply to column names. -#' @param borders Either "\code{none}" (default), "\code{surrounding}", -#' "\code{columns}", "\code{rows}" or \emph{respective abbreviations}. If -#' "\code{surrounding}", a border is drawn around the data. If "\code{rows}", -#' a surrounding border is drawn with a border around each row. If -#' "\code{columns}", a surrounding border is drawn with a border between -#' each column. If "\code{all}" all cell borders are drawn. -#' @param borderColour Colour of cell border. A valid colour (belonging to \code{colours()} or a hex colour code, eg see \href{https://www.webfx.com/web-design/color-picker/}{here}). -#' @param borderStyle Border line style -#' \itemize{ -#' \item{\bold{none}}{ no border} -#' \item{\bold{thin}}{ thin border} -#' \item{\bold{medium}}{ medium border} -#' \item{\bold{dashed}}{ dashed border} -#' \item{\bold{dotted}}{ dotted border} -#' \item{\bold{thick}}{ thick border} -#' \item{\bold{double}}{ double line border} -#' \item{\bold{hair}}{ hairline border} -#' \item{\bold{mediumDashed}}{ medium weight dashed border} -#' \item{\bold{dashDot}}{ dash-dot border} -#' \item{\bold{mediumDashDot}}{ medium weight dash-dot border} -#' \item{\bold{dashDotDot}}{ dash-dot-dot border} -#' \item{\bold{mediumDashDotDot}}{ medium weight dash-dot-dot border} -#' \item{\bold{slantDashDot}}{ slanted dash-dot border} -#' } -#' @param withFilter If \code{TRUE} or \code{NA}, add filters to the column name row. NOTE can only have one filter per worksheet. -#' @param keepNA If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty. -#' @param na.string If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel. -#' @param name If not NULL, a named region is defined. -#' @param sep Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep). -#' @seealso \code{\link{writeDataTable}} -#' @export writeData -#' @details Formulae written using writeFormula to a Workbook object will not get picked up by read.xlsx(). -#' This is because only the formula is written and left to Excel to evaluate the formula when the file is opened in Excel. -#' @rdname writeData -#' @return invisible(0) -#' @examples -#' -#' ## See formatting vignette for further examples. -#' -#' ## Options for default styling (These are the defaults) -#' options("openxlsx.borderColour" = "black") -#' options("openxlsx.borderStyle" = "thin") -#' options("openxlsx.dateFormat" = "mm/dd/yyyy") -#' options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -#' options("openxlsx.numFmt" = NULL) -#' -#' ## Change the default border colour to #4F81BD -#' options("openxlsx.borderColour" = "#4F81BD") -#' -#' -#' ##################################################################################### -#' ## Create Workbook object and add worksheets -#' wb <- createWorkbook() -#' -#' ## Add worksheets -#' addWorksheet(wb, "Cars") -#' addWorksheet(wb, "Formula") -#' -#' -#' x <- mtcars[1:6, ] -#' writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) -#' -#' ##################################################################################### -#' ## Bordering -#' -#' writeData(wb, "Cars", x, -#' rowNames = TRUE, startCol = "O", startRow = 3, -#' borders = "surrounding", borderColour = "black" -#' ) ## black border -#' -#' writeData(wb, "Cars", x, -#' rowNames = TRUE, -#' startCol = 2, startRow = 12, borders = "columns" -#' ) -#' -#' writeData(wb, "Cars", x, -#' rowNames = TRUE, -#' startCol = "O", startRow = 12, borders = "rows" -#' ) -#' -#' -#' ##################################################################################### -#' ## Header Styles -#' -#' hs1 <- createStyle( -#' fgFill = "#DCE6F1", halign = "CENTER", textDecoration = "italic", -#' border = "Bottom" -#' ) -#' -#' writeData(wb, "Cars", x, -#' colNames = TRUE, rowNames = TRUE, startCol = "B", -#' startRow = 23, borders = "rows", headerStyle = hs1, borderStyle = "dashed" -#' ) -#' -#' -#' hs2 <- createStyle( -#' fontColour = "#ffffff", fgFill = "#4F80BD", -#' halign = "center", valign = "center", textDecoration = "bold", -#' border = "TopBottomLeftRight" -#' ) -#' -#' writeData(wb, "Cars", x, -#' colNames = TRUE, rowNames = TRUE, -#' startCol = "O", startRow = 23, borders = "columns", headerStyle = hs2 -#' ) -#' -#' -#' -#' -#' ##################################################################################### -#' ## Hyperlinks -#' ## - vectors/columns with class 'hyperlink' are written as hyperlinks' -#' -#' v <- rep("https://CRAN.R-project.org/", 4) -#' names(v) <- paste0("Hyperlink", 1:4) # Optional: names will be used as display text -#' class(v) <- "hyperlink" -#' writeData(wb, "Cars", x = v, xy = c("B", 32)) -#' -#' -#' ##################################################################################### -#' ## Formulas -#' ## - vectors/columns with class 'formula' are written as formulas' -#' -#' df <- data.frame( -#' x = 1:3, y = 1:3, -#' z = paste0(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), -#' stringsAsFactors = FALSE -#' ) -#' -#' class(df$z) <- c(class(df$z), "formula") -#' -#' writeData(wb, sheet = "Formula", x = df) -#' -#' -#' ##################################################################################### -#' ## Save workbook -#' ## Open in excel without saving file: openXL(wb) -#' \dontrun{ -#' saveWorkbook(wb, "writeDataExample.xlsx", overwrite = TRUE) -#' } -writeData <- function( - wb, - sheet, - x, - startCol = 1, - startRow = 1, - array = FALSE, - xy = NULL, - colNames = TRUE, - rowNames = FALSE, - headerStyle = openxlsx_getOp("headerStyle"), - borders = openxlsx_getOp("borders", "none"), - borderColour = openxlsx_getOp("borderColour", "black"), - borderStyle = openxlsx_getOp("borderStyle", "thin"), - withFilter = openxlsx_getOp("withFilter", FALSE), - keepNA = openxlsx_getOp("keepNA", FALSE), - na.string = openxlsx_getOp("na.string"), - name = NULL, - sep = ", ", - col.names, - row.names -) { - - op <- get_set_options() - on.exit(options(op), add = TRUE) - - if (!missing(row.names)) { - warning("Please use 'rowNames' instead of 'row.names'", call. = FALSE) - rowNames <- row.names - } - - if (!missing(col.names)) { - warning("Please use 'colNames' instead of 'col.names'", call. = FALSE) - colNames <- col.names - } - - # Set NULLs - borders <- borders %||% "none" - borderColour <- borderColour %||% "black" - borderStyle <- borderStyle %||% "thin" - withFilter <- withFilter %||% FALSE - keepNA <- keepNA %||% FALSE - - if (is.null(x)) { - return(invisible(0)) - } - - ## All input conversions/validations - if (!is.null(xy)) { - if (length(xy) != 2) { - stop("xy parameter must have length 2") - } - startCol <- xy[[1]] - startRow <- xy[[2]] - } - - ## convert startRow and startCol - if (!is.numeric(startCol)) { - startCol <- convertFromExcelRef(startCol) - } - - startRow <- as.integer(startRow) - - assert_class(wb, "Workbook") - assert_true_false(colNames) - assert_true_false(rowNames) - assert_character1(sep) - assert_class(headerStyle, "Style", or_null = TRUE) - - ## borderColours validation - borderColour <- validateColour(borderColour, "Invalid border colour") - borderStyle <- validateBorderStyle(borderStyle)[[1]] - - ## special case - vector of hyperlinks - hlinkNames <- NULL - if (inherits(x, "hyperlink")) { - hlinkNames <- names(x) - colNames <- FALSE - } - - ## special case - formula - if (inherits(x, "formula")) { - x <- data.frame("X" = x, stringsAsFactors = FALSE) - class(x[[1]]) <- ifelse(array, "array_formula", "formula") - colNames <- FALSE - } - - ## named region - if (!is.null(name)) { ## validate name - ex_names <- regmatches(wb$workbook$definedNames, regexpr('(?<=name=")[^"]+', wb$workbook$definedNames, perl = TRUE)) - ex_names <- replaceXMLEntities(ex_names) - - if (name %in% ex_names) { - stop(sprintf("Named region with name '%s' already exists!", name)) - } else if (grepl("^[A-Z]{1,3}[0-9]+$", name)) { - stop("name cannot look like a cell reference.") - } - } - - if (is.vector(x) | is.factor(x) | inherits(x, "Date")) { - colNames <- FALSE - } ## this will go to coerce.default and rowNames will be ignored - - ## Coerce to data.frame - x <- openxlsxCoerce(x = x, rowNames = rowNames) - - nCol <- ncol(x) - nRow <- nrow(x) - - ## If no rows and not writing column names return as nothing to write - if (nRow == 0 & !colNames) { - return(invisible(0)) - } - - ## If no columns and not writing row names return as nothing to write - if (nCol == 0 & !rowNames) { - return(invisible(0)) - } - - colClasses <- lapply(x, function(x) tolower(class(x))) - colClasss2 <- colClasses - colClasss2[vapply( - colClasses, - function(i) inherits(i, "formula") & inherits(i, "hyperlink"), - NA - )] <- "formula" - - if (is.numeric(sheet)) { - sheetX <- wb$validateSheet(sheet) - } else { - sheetX <- wb$validateSheet(replaceXMLEntities(sheet)) - sheet <- replaceXMLEntities(sheet) - } - - if (wb$isChartSheet[[sheetX]]) { - stop("Cannot write to chart sheet.") - } - - ## Check not overwriting existing table headers - wb$check_overwrite_tables( - sheet = sheet, - new_rows = c(startRow, startRow + nRow - 1L + colNames), - new_cols = c(startCol, startCol + nCol - 1L), - check_table_header_only = TRUE, - error_msg = "Cannot overwrite table headers. Avoid writing over the header row or see getTables() & removeTables() to remove the table object." - ) - - ## write autoFilter, can only have a single filter per worksheet - if (withFilter) { - coords <- data.frame( - x = c(startRow, startRow + nRow + colNames - 1L), - y = c(startCol, startCol + nCol - 1L) - ) - - ref <- stri_join(getCellRefs(coords), collapse = ":") - wb$worksheets[[sheetX]]$autoFilter <- sprintf('', ref) - l <- convert_to_excel_ref(cols = unlist(coords[, 2]), LETTERS = LETTERS) - dfn <- sprintf("'%s'!%s", names(wb)[sheetX], stri_join("$", l, "$", coords[, 1], collapse = ":")) - - dn <- sprintf('', sheetX - 1L, dfn) - - if (length(wb$workbook$definedNames) > 0) { - ind <- grepl('name="_xlnm._FilterDatabase"', wb$workbook$definedNames) - if (length(ind) > 0) { - wb$workbook$definedNames[ind] <- dn - } - } else { - wb$workbook$definedNames <- dn - } - } - - ## write data.frame - wb$writeData( - df = x, - colNames = colNames, - sheet = sheet, - startCol = startCol, - startRow = startRow, - colClasses = colClasss2, - hlinkNames = hlinkNames, - keepNA = keepNA, - na.string = na.string, - list_sep = sep - ) - - ## header style - if (inherits(headerStyle, "Style") & colNames) { - addStyle( - wb = wb, - sheet = sheet, - style = headerStyle, - rows = startRow, - cols = 0:(nCol - 1) + startCol, - gridExpand = TRUE, - stack = TRUE - ) - } - - ## If we don't have any rows to write return - if (nRow == 0) { - return(invisible(0)) - } - - ## named region - if (!is.null(name)) { - ref1 <- stri_join("$", convert_to_excel_ref(cols = startCol, LETTERS = LETTERS), "$", startRow) - ref2 <- stri_join("$", convert_to_excel_ref(cols = startCol + nCol - 1L, LETTERS = LETTERS), "$", startRow + nRow - 1L + colNames) - wb$createNamedRegion(ref1 = ref1, ref2 = ref2, name = name, sheet = wb$sheet_names[wb$validateSheet(sheet)]) - } - - ## hyperlink style, if no borders - borders <- match.arg(borders, c("none", "surrounding", "rows", "columns", "all")) - - if (borders == "none") { - invisible( - classStyles( - wb, - sheet = sheet, - startRow = startRow, - startCol = startCol, - colNames = colNames, - nRow = nrow(x), - colClasses = colClasses, - stack = TRUE - ) - ) - } else if (borders == "surrounding") { - wb$surroundingBorders( - colClasses, - sheet = sheet, - startRow = startRow + colNames, - startCol = startCol, - nRow = nRow, nCol = nCol, - borderColour = list("rgb" = borderColour), - borderStyle = borderStyle - ) - } else if (borders == "rows") { - wb$rowBorders( - colClasses, - sheet = sheet, - startRow = startRow + colNames, - startCol = startCol, - nRow = nRow, nCol = nCol, - borderColour = list("rgb" = borderColour), - borderStyle = borderStyle - ) - } else if (borders == "columns") { - wb$columnBorders( - colClasses, - sheet = sheet, - startRow = startRow + colNames, - startCol = startCol, - nRow = nRow, nCol = nCol, - borderColour = list("rgb" = borderColour), - borderStyle = borderStyle - ) - } else if (borders == "all") { - wb$allBorders( - colClasses, - sheet = sheet, - startRow = startRow + colNames, - startCol = startCol, - nRow = nRow, nCol = nCol, - borderColour = list("rgb" = borderColour), - borderStyle = borderStyle - ) - } - - invisible(0) -} - - -#' @name writeFormula -#' @title Write a character vector as an Excel Formula -#' @author Alexander Walker -#' @description Write a a character vector containing Excel formula to a worksheet. -#' @details Currently only the english version of functions are supported. Please don't use the local translation. -#' The examples below show a small list of possible formulas: -#' \itemize{ -#' \item{SUM(B2:B4)} -#' \item{AVERAGE(B2:B4)} -#' \item{MIN(B2:B4)} -#' \item{MAX(B2:B4)} -#' \item{...} -#' -#' } -#' @param wb A Workbook object containing a worksheet. -#' @param sheet The worksheet to write to. Can be the worksheet index or name. -#' @param x A character vector. -#' @param startCol A vector specifying the starting column to write to. -#' @param startRow A vector specifying the starting row to write to. -#' @param array A bool if the function written is of type array -#' @param xy An alternative to specifying \code{startCol} and -#' \code{startRow} individually. A vector of the form -#' \code{c(startCol, startRow)}. -#' @seealso \code{\link{writeData}} -#' @export writeFormula -#' @rdname writeFormula -#' @examples -#' -#' ## There are 3 ways to write a formula -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet 1") -#' writeData(wb, "Sheet 1", x = iris) -#' -#' ## SEE int2col() to convert int to Excel column label -#' -#' ## 1. - As a character vector using writeFormula -#' -#' v <- c("SUM(A2:A151)", "AVERAGE(B2:B151)") ## skip header row -#' writeFormula(wb, sheet = 1, x = v, startCol = 10, startRow = 2) -#' writeFormula(wb, 1, x = "A2 + B2", startCol = 10, startRow = 10) -#' -#' -#' ## 2. - As a data.frame column with class "formula" using writeData -#' -#' df <- data.frame( -#' x = 1:3, -#' y = 1:3, -#' z = paste(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), -#' z2 = sprintf("ADDRESS(1,%s)", 1:3), -#' stringsAsFactors = FALSE -#' ) -#' -#' class(df$z) <- c(class(df$z), "formula") -#' class(df$z2) <- c(class(df$z2), "formula") -#' -#' addWorksheet(wb, "Sheet 2") -#' writeData(wb, sheet = 2, x = df) -#' -#' -#' -#' ## 3. - As a vector with class "formula" using writeData -#' -#' v2 <- c("SUM(A2:A4)", "AVERAGE(B2:B4)", "MEDIAN(C2:C4)") -#' class(v2) <- c(class(v2), "formula") -#' -#' writeData(wb, sheet = 2, x = v2, startCol = 10, startRow = 2) -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "writeFormulaExample.xlsx", overwrite = TRUE) -#' } -#' -#' -#' ## 4. - Writing internal hyperlinks -#' -#' wb <- createWorkbook() -#' addWorksheet(wb, "Sheet1") -#' addWorksheet(wb, "Sheet2") -#' writeFormula(wb, "Sheet1", x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")') -#' -#' ## Save workbook -#' \dontrun{ -#' saveWorkbook(wb, "writeFormulaHyperlinkExample.xlsx", overwrite = TRUE) -#' } -#' -writeFormula <- function( - wb, - sheet, - x, - startCol = 1, - startRow = 1, - array = FALSE, - xy = NULL -) { - - if (!is.character(x)) { - stop("x must be a character vector.") - } - - dfx <- data.frame("X" = x, stringsAsFactors = FALSE) - class(dfx$X) <- c("character", ifelse(array, "array_formula", "formula")) - - if (any(grepl("^(=|)HYPERLINK\\(", x, ignore.case = TRUE))) { - class(dfx$X) <- c("character", "formula", "hyperlink") - } - - writeData( - wb = wb, - sheet = sheet, - x = dfx, - startCol = startCol, - startRow = startRow, - array = array, - xy = xy, - colNames = FALSE, - rowNames = FALSE - ) - - invisible(0) -} +#' @name writeData +#' @title Write an object to a worksheet +#' @author Alexander Walker +#' @import stringi +#' @description Write an object to worksheet with optional styling. +#' @param wb A Workbook object containing a worksheet. +#' @param sheet The worksheet to write to. Can be the worksheet index or name. +#' @param x Object to be written. For classes supported look at the examples. +#' @param startCol A vector specifying the starting column to write to. +#' @param startRow A vector specifying the starting row to write to. +#' @param array A bool if the function written is of type array +#' @param xy An alternative to specifying `startCol` and +#' `startRow` individually. A vector of the form +#' `c(startCol, startRow)`. +#' @param colNames If `TRUE`, column names of x are written. +#' @param rowNames If `TRUE`, data.frame row names of x are written. +#' @param row.names,col.names Deprecated, please use `rowNames`, `colNames` instead +#' @param headerStyle Custom style to apply to column names. +#' @param borders Either "`none`" (default), "`surrounding`", +#' "`columns`", "`rows`" or *respective abbreviations*. If +#' "`surrounding`", a border is drawn around the data. If "`rows`", +#' a surrounding border is drawn with a border around each row. If +#' "`columns`", a surrounding border is drawn with a border between +#' each column. If "`all`" all cell borders are drawn. +#' @param borderColour Colour of cell border. A valid colour (belonging to `colours()` or a hex colour code, eg see [here](https://www.w3schools.com/web-design/color-picker/)). +#' @param borderStyle Border line style +#' \itemize{ +#' \item{**none**}{ no border} +#' \item{**thin**}{ thin border} +#' \item{**medium**}{ medium border} +#' \item{**dashed**}{ dashed border} +#' \item{**dotted**}{ dotted border} +#' \item{**thick**}{ thick border} +#' \item{**double**}{ double line border} +#' \item{**hair**}{ hairline border} +#' \item{**mediumDashed**}{ medium weight dashed border} +#' \item{**dashDot**}{ dash-dot border} +#' \item{**mediumDashDot**}{ medium weight dash-dot border} +#' \item{**dashDotDot**}{ dash-dot-dot border} +#' \item{**mediumDashDotDot**}{ medium weight dash-dot-dot border} +#' \item{**slantDashDot**}{ slanted dash-dot border} +#' } +#' @param withFilter If `TRUE` or `NA`, add filters to the column name row. NOTE can only have one filter per worksheet. +#' @param keepNA If `TRUE`, NA values are converted to #N/A (or `na.string`, if not NULL) in Excel, else NA cells will be empty. +#' @param na.string If not NULL, and if `keepNA` is `TRUE`, NA values are converted to this string in Excel. +#' @param name If not NULL, a named region is defined. +#' @param sep Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep). +#' @seealso [writeDataTable()] +#' @export writeData +#' @details Formulae written using writeFormula to a Workbook object will not get picked up by read.xlsx(). +#' This is because only the formula is written and left to Excel to evaluate the formula when the file is opened in Excel. +#' @rdname writeData +#' @return invisible(0) +#' @examples +#' +#' ## See formatting vignette for further examples. +#' +#' ## Options for default styling (These are the defaults) +#' options("openxlsx.borderColour" = "black") +#' options("openxlsx.borderStyle" = "thin") +#' options("openxlsx.dateFormat" = "mm/dd/yyyy") +#' options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +#' options("openxlsx.numFmt" = NULL) +#' +#' ## Change the default border colour to #4F81BD +#' options("openxlsx.borderColour" = "#4F81BD") +#' +#' +#' ##################################################################################### +#' ## Create Workbook object and add worksheets +#' wb <- createWorkbook() +#' +#' ## Add worksheets +#' addWorksheet(wb, "Cars") +#' addWorksheet(wb, "Formula") +#' +#' +#' x <- mtcars[1:6, ] +#' writeData(wb, "Cars", x, startCol = 2, startRow = 3, rowNames = TRUE) +#' +#' ##################################################################################### +#' ## Bordering +#' +#' writeData(wb, "Cars", x, +#' rowNames = TRUE, startCol = "O", startRow = 3, +#' borders = "surrounding", borderColour = "black" +#' ) ## black border +#' +#' writeData(wb, "Cars", x, +#' rowNames = TRUE, +#' startCol = 2, startRow = 12, borders = "columns" +#' ) +#' +#' writeData(wb, "Cars", x, +#' rowNames = TRUE, +#' startCol = "O", startRow = 12, borders = "rows" +#' ) +#' +#' +#' ##################################################################################### +#' ## Header Styles +#' +#' hs1 <- createStyle( +#' fgFill = "#DCE6F1", halign = "CENTER", textDecoration = "italic", +#' border = "Bottom" +#' ) +#' +#' writeData(wb, "Cars", x, +#' colNames = TRUE, rowNames = TRUE, startCol = "B", +#' startRow = 23, borders = "rows", headerStyle = hs1, borderStyle = "dashed" +#' ) +#' +#' +#' hs2 <- createStyle( +#' fontColour = "#ffffff", fgFill = "#4F80BD", +#' halign = "center", valign = "center", textDecoration = "bold", +#' border = "TopBottomLeftRight" +#' ) +#' +#' writeData(wb, "Cars", x, +#' colNames = TRUE, rowNames = TRUE, +#' startCol = "O", startRow = 23, borders = "columns", headerStyle = hs2 +#' ) +#' +#' +#' +#' +#' ##################################################################################### +#' ## Hyperlinks +#' ## - vectors/columns with class 'hyperlink' are written as hyperlinks' +#' +#' v <- rep("https://CRAN.R-project.org/", 4) +#' names(v) <- paste0("Hyperlink", 1:4) # Optional: names will be used as display text +#' class(v) <- "hyperlink" +#' writeData(wb, "Cars", x = v, xy = c("B", 32)) +#' +#' +#' ##################################################################################### +#' ## Formulas +#' ## - vectors/columns with class 'formula' are written as formulas' +#' +#' df <- data.frame( +#' x = 1:3, y = 1:3, +#' z = paste0(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), +#' stringsAsFactors = FALSE +#' ) +#' +#' class(df$z) <- c(class(df$z), "formula") +#' +#' writeData(wb, sheet = "Formula", x = df) +#' +#' +#' ##################################################################################### +#' ## Save workbook +#' ## Open in excel without saving file: openXL(wb) +#' \dontrun{ +#' saveWorkbook(wb, "writeDataExample.xlsx", overwrite = TRUE) +#' } +writeData <- function( + wb, + sheet, + x, + startCol = 1, + startRow = 1, + array = FALSE, + xy = NULL, + colNames = TRUE, + rowNames = FALSE, + headerStyle = openxlsx_getOp("headerStyle"), + borders = openxlsx_getOp("borders", "none"), + borderColour = openxlsx_getOp("borderColour", "black"), + borderStyle = openxlsx_getOp("borderStyle", "thin"), + withFilter = openxlsx_getOp("withFilter", FALSE), + keepNA = openxlsx_getOp("keepNA", FALSE), + na.string = openxlsx_getOp("na.string"), + name = NULL, + sep = ", ", + col.names, + row.names +) { + + x <- force(x) + + op <- get_set_options() + on.exit(options(op), add = TRUE) + + if (!missing(row.names)) { + warning("Please use 'rowNames' instead of 'row.names'", call. = FALSE) + rowNames <- row.names + } + + if (!missing(col.names)) { + warning("Please use 'colNames' instead of 'col.names'", call. = FALSE) + colNames <- col.names + } + + # Set NULLs + borders <- borders %||% "none" + borderColour <- borderColour %||% "black" + borderStyle <- borderStyle %||% "thin" + withFilter <- withFilter %||% FALSE + keepNA <- keepNA %||% FALSE + + if (is.null(x)) { + return(invisible(0)) + } + + ## All input conversions/validations + if (!is.null(xy)) { + if (length(xy) != 2) { + stop("xy parameter must have length 2") + } + startCol <- xy[[1]] + startRow <- xy[[2]] + } + + ## convert startRow and startCol + if (!is.numeric(startCol)) { + startCol <- convertFromExcelRef(startCol) + } + + startRow <- as.integer(startRow) + + assert_class(wb, "Workbook") + assert_true_false(colNames) + assert_true_false(rowNames) + assert_character1(sep) + assert_class(headerStyle, "Style", or_null = TRUE) + + ## borderColours validation + borderColour <- validateColour(borderColour, "Invalid border colour") + borderStyle <- validateBorderStyle(borderStyle)[[1]] + + ## special case - vector of hyperlinks + hlinkNames <- NULL + if (inherits(x, "hyperlink")) { + hlinkNames <- names(x) + colNames <- FALSE + } + + ## special case - formula + if (inherits(x, "formula")) { + x <- data.frame("X" = x, stringsAsFactors = FALSE) + class(x[[1]]) <- ifelse(array, "array_formula", "formula") + colNames <- FALSE + } + + ## named region + if (!is.null(name)) { ## validate name + ex_names <- regmatches(wb$workbook$definedNames, regexpr('(?<=name=")[^"]+', wb$workbook$definedNames, perl = TRUE)) + ex_names <- replaceXMLEntities(ex_names) + + if (name %in% ex_names) { + stop(sprintf("Named region with name '%s' already exists!", name)) + } else if (grepl("^[A-Z]{1,3}[0-9]+$", name)) { + stop("name cannot look like a cell reference.") + } + } + + if (is.vector(x) | is.factor(x) | inherits(x, "Date")) { + colNames <- FALSE + } ## this will go to coerce.default and rowNames will be ignored + + ## Coerce to data.frame + x <- openxlsxCoerce(x = x, rowNames = rowNames) + + nCol <- ncol(x) + nRow <- nrow(x) + + ## If no rows and not writing column names return as nothing to write + if (nRow == 0 & !colNames) { + return(invisible(0)) + } + + ## If no columns and not writing row names return as nothing to write + if (nCol == 0 & !rowNames) { + return(invisible(0)) + } + + colClasses <- lapply(x, function(x) tolower(class(x))) + colClasss2 <- colClasses + colClasss2[vapply( + colClasses, + function(i) inherits(i, "formula") & inherits(i, "hyperlink"), + NA + )] <- "formula" + + if (is.numeric(sheet)) { + sheetX <- wb$validateSheet(sheet) + } else { + sheetX <- wb$validateSheet(replaceXMLEntities(sheet)) + sheet <- replaceXMLEntities(sheet) + } + + if (wb$isChartSheet[[sheetX]]) { + stop("Cannot write to chart sheet.") + } + + ## Check not overwriting existing table headers + wb$check_overwrite_tables( + sheet = sheet, + new_rows = c(startRow, startRow + nRow - 1L + colNames), + new_cols = c(startCol, startCol + nCol - 1L), + check_table_header_only = TRUE, + error_msg = "Cannot overwrite table headers. Avoid writing over the header row or see getTables() & removeTables() to remove the table object." + ) + + ## write autoFilter, can only have a single filter per worksheet + if (withFilter) { + coords <- data.frame( + x = c(startRow, startRow + nRow + colNames - 1L), + y = c(startCol, startCol + nCol - 1L) + ) + + ref <- stri_join(getCellRefs(coords), collapse = ":") + wb$worksheets[[sheetX]]$autoFilter <- sprintf('', ref) + l <- convert_to_excel_ref(cols = unlist(coords[, 2]), LETTERS = LETTERS) + dfn <- sprintf("'%s'!%s", names(wb)[sheetX], stri_join("$", l, "$", coords[, 1], collapse = ":")) + + dn <- sprintf('', sheetX - 1L, dfn) + + if (length(wb$workbook$definedNames) > 0) { + ind <- grepl('name="_xlnm._FilterDatabase"', wb$workbook$definedNames) + if (length(ind) > 0) { + wb$workbook$definedNames[ind] <- dn + } + } else { + wb$workbook$definedNames <- dn + } + } + + ## write data.frame + wb$writeData( + df = x, + colNames = colNames, + sheet = sheet, + startCol = startCol, + startRow = startRow, + colClasses = colClasss2, + hlinkNames = hlinkNames, + keepNA = keepNA, + na.string = na.string, + list_sep = sep + ) + + ## header style + if (inherits(headerStyle, "Style") & colNames) { + addStyle( + wb = wb, + sheet = sheet, + style = headerStyle, + rows = startRow, + cols = 0:(nCol - 1) + startCol, + gridExpand = TRUE, + stack = TRUE + ) + } + + ## If we don't have any rows to write return + if (nRow == 0) { + return(invisible(0)) + } + + ## named region + if (!is.null(name)) { + ref1 <- stri_join("$", convert_to_excel_ref(cols = startCol, LETTERS = LETTERS), "$", startRow) + ref2 <- stri_join("$", convert_to_excel_ref(cols = startCol + nCol - 1L, LETTERS = LETTERS), "$", startRow + nRow - 1L + colNames) + wb$createNamedRegion(ref1 = ref1, ref2 = ref2, name = name, sheet = wb$sheet_names[wb$validateSheet(sheet)]) + } + + ## hyperlink style, if no borders + borders <- match.arg(borders, c("none", "surrounding", "rows", "columns", "all")) + + if (borders == "none") { + invisible( + classStyles( + wb, + sheet = sheet, + startRow = startRow, + startCol = startCol, + colNames = colNames, + nRow = nrow(x), + colClasses = colClasses, + stack = TRUE + ) + ) + } else if (borders == "surrounding") { + wb$surroundingBorders( + colClasses, + sheet = sheet, + startRow = startRow + colNames, + startCol = startCol, + nRow = nRow, nCol = nCol, + borderColour = list("rgb" = borderColour), + borderStyle = borderStyle + ) + } else if (borders == "rows") { + wb$rowBorders( + colClasses, + sheet = sheet, + startRow = startRow + colNames, + startCol = startCol, + nRow = nRow, nCol = nCol, + borderColour = list("rgb" = borderColour), + borderStyle = borderStyle + ) + } else if (borders == "columns") { + wb$columnBorders( + colClasses, + sheet = sheet, + startRow = startRow + colNames, + startCol = startCol, + nRow = nRow, nCol = nCol, + borderColour = list("rgb" = borderColour), + borderStyle = borderStyle + ) + } else if (borders == "all") { + wb$allBorders( + colClasses, + sheet = sheet, + startRow = startRow + colNames, + startCol = startCol, + nRow = nRow, nCol = nCol, + borderColour = list("rgb" = borderColour), + borderStyle = borderStyle + ) + } + + invisible(0) +} + + +#' @name writeFormula +#' @title Write a character vector as an Excel Formula +#' @author Alexander Walker +#' @description Write a a character vector containing Excel formula to a worksheet. +#' @details Currently only the english version of functions are supported. Please don't use the local translation. +#' The examples below show a small list of possible formulas: +#' \itemize{ +#' \item{SUM(B2:B4)} +#' \item{AVERAGE(B2:B4)} +#' \item{MIN(B2:B4)} +#' \item{MAX(B2:B4)} +#' \item{...} +#' +#' } +#' @param wb A Workbook object containing a worksheet. +#' @param sheet The worksheet to write to. Can be the worksheet index or name. +#' @param x A character vector. +#' @param startCol A vector specifying the starting column to write to. +#' @param startRow A vector specifying the starting row to write to. +#' @param array A bool if the function written is of type array +#' @param xy An alternative to specifying `startCol` and +#' `startRow` individually. A vector of the form +#' `c(startCol, startRow)`. +#' @seealso [writeData()] [makeHyperlinkString()] +#' @export writeFormula +#' @rdname writeFormula +#' @examples +#' +#' ## There are 3 ways to write a formula +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet 1") +#' writeData(wb, "Sheet 1", x = iris) +#' +#' ## SEE int2col() to convert int to Excel column label +#' +#' ## 1. - As a character vector using writeFormula +#' +#' v <- c("SUM(A2:A151)", "AVERAGE(B2:B151)") ## skip header row +#' writeFormula(wb, sheet = 1, x = v, startCol = 10, startRow = 2) +#' writeFormula(wb, 1, x = "A2 + B2", startCol = 10, startRow = 10) +#' +#' +#' ## 2. - As a data.frame column with class "formula" using writeData +#' +#' df <- data.frame( +#' x = 1:3, +#' y = 1:3, +#' z = paste(paste0("A", 1:3 + 1L), paste0("B", 1:3 + 1L), sep = " + "), +#' z2 = sprintf("ADDRESS(1,%s)", 1:3), +#' stringsAsFactors = FALSE +#' ) +#' +#' class(df$z) <- c(class(df$z), "formula") +#' class(df$z2) <- c(class(df$z2), "formula") +#' +#' addWorksheet(wb, "Sheet 2") +#' writeData(wb, sheet = 2, x = df) +#' +#' +#' +#' ## 3. - As a vector with class "formula" using writeData +#' +#' v2 <- c("SUM(A2:A4)", "AVERAGE(B2:B4)", "MEDIAN(C2:C4)") +#' class(v2) <- c(class(v2), "formula") +#' +#' writeData(wb, sheet = 2, x = v2, startCol = 10, startRow = 2) +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "writeFormulaExample.xlsx", overwrite = TRUE) +#' } +#' +#' +#' ## 4. - Writing internal hyperlinks +#' +#' wb <- createWorkbook() +#' addWorksheet(wb, "Sheet1") +#' addWorksheet(wb, "Sheet2") +#' writeFormula(wb, "Sheet1", x = '=HYPERLINK("#Sheet2!B3", "Text to Display - Link to Sheet2")') +#' +#' ## Save workbook +#' \dontrun{ +#' saveWorkbook(wb, "writeFormulaHyperlinkExample.xlsx", overwrite = TRUE) +#' } +#' +writeFormula <- function( + wb, + sheet, + x, + startCol = 1, + startRow = 1, + array = FALSE, + xy = NULL +) { + + if (!is.character(x)) { + stop("x must be a character vector.") + } + + dfx <- data.frame("X" = x, stringsAsFactors = FALSE) + class(dfx$X) <- c("character", ifelse(array, "array_formula", "formula")) + + if (any(grepl("^(=|)HYPERLINK\\(", x, ignore.case = TRUE))) { + class(dfx$X) <- c("character", "formula", "hyperlink") + } + + writeData( + wb = wb, + sheet = sheet, + x = dfx, + startCol = startCol, + startRow = startRow, + array = array, + xy = xy, + colNames = FALSE, + rowNames = FALSE + ) + + invisible(0) +} diff -Nru r-cran-openxlsx-4.2.4/R/writeDataTable.R r-cran-openxlsx-4.2.5/R/writeDataTable.R --- r-cran-openxlsx-4.2.4/R/writeDataTable.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/writeDataTable.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,324 +1,323 @@ - -#' @name writeDataTable -#' @title Write to a worksheet as an Excel table -#' @description Write to a worksheet and format as an Excel table -#' @param wb A Workbook object containing a -#' worksheet. -#' @param sheet The worksheet to write to. Can be the worksheet index or name. -#' @param x A dataframe. -#' @param startCol A vector specifying the starting column to write df -#' @param startRow A vector specifying the starting row to write df -#' @param xy An alternative to specifying startCol and startRow individually. -#' A vector of the form c(startCol, startRow) -#' @param colNames If \code{TRUE}, column names of x are written. -#' @param rowNames If \code{TRUE}, row names of x are written. -#' @param row.names,col.names Deprecated, please use \code{rowNames}, \code{colNames} instead -#' @param tableStyle Any excel table style name or "none" (see "formatting" vignette). -#' @param tableName name of table in workbook. The table name must be unique. -#' @param headerStyle Custom style to apply to column names. -#' @param withFilter If \code{TRUE} or \code{NA}, columns with have filters in the first row. -#' @param keepNA If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty. -#' @param na.string If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel. -#' @param sep Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep). -#' @param stack If \code{TRUE} the new style is merged with any existing cell styles. If FALSE, any -#' existing style is replaced by the new style. -#' \cr\cr -#' \cr\bold{The below options correspond to Excel table options:} -#' \cr -#' \if{html}{\figure{tableoptions.png}{options: width="40\%" alt="Figure: table_options.png"}} -#' \if{latex}{\figure{tableoptions.pdf}{options: width=7cm}} -#' -#' @param firstColumn logical. If TRUE, the first column is bold -#' @param lastColumn logical. If TRUE, the last column is bold -#' @param bandedRows logical. If TRUE, rows are colour banded -#' @param bandedCols logical. If TRUE, the columns are colour banded -#' @details columns of x with class Date/POSIXt, currency, accounting, -#' hyperlink, percentage are automatically styled as dates, currency, accounting, -#' hyperlinks, percentages respectively. -#' @seealso \code{\link{addWorksheet}} -#' @seealso \code{\link{writeData}} -#' @seealso \code{\link{removeTable}} -#' @seealso \code{\link{getTables}} -#' @importFrom stats na.omit -#' @export -#' @examples -#' ## see package vignettes for further examples. -#' -#' ##################################################################################### -#' ## Create Workbook object and add worksheets -#' wb <- createWorkbook() -#' addWorksheet(wb, "S1") -#' addWorksheet(wb, "S2") -#' addWorksheet(wb, "S3") -#' -#' -#' ##################################################################################### -#' ## -- write data.frame as an Excel table with column filters -#' ## -- default table style is "TableStyleMedium2" -#' -#' writeDataTable(wb, "S1", x = iris) -#' -#' writeDataTable(wb, "S2", -#' x = mtcars, xy = c("B", 3), rowNames = TRUE, -#' tableStyle = "TableStyleLight9" -#' ) -#' -#' df <- data.frame( -#' "Date" = Sys.Date() - 0:19, -#' "T" = TRUE, "F" = FALSE, -#' "Time" = Sys.time() - 0:19 * 60 * 60, -#' "Cash" = paste("$", 1:20), "Cash2" = 31:50, -#' "hLink" = "https://CRAN.R-project.org/", -#' "Percentage" = seq(0, 1, length.out = 20), -#' "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE -#' ) -#' -#' ## openxlsx will apply default Excel styling for these classes -#' class(df$Cash) <- c(class(df$Cash), "currency") -#' class(df$Cash2) <- c(class(df$Cash2), "accounting") -#' class(df$hLink) <- "hyperlink" -#' class(df$Percentage) <- c(class(df$Percentage), "percentage") -#' class(df$TinyNumbers) <- c(class(df$TinyNumbers), "scientific") -#' -#' writeDataTable(wb, "S3", x = df, startRow = 4, rowNames = TRUE, tableStyle = "TableStyleMedium9") -#' -#' ##################################################################################### -#' ## Additional Header Styling and remove column filters -#' -#' writeDataTable(wb, -#' sheet = 1, x = iris, startCol = 7, headerStyle = createStyle(textRotation = 45), -#' withFilter = FALSE -#' ) -#' -#' -#' ##################################################################################### -#' ## Save workbook -#' ## Open in excel without saving file: openXL(wb) -#' \dontrun{ -#' saveWorkbook(wb, "writeDataTableExample.xlsx", overwrite = TRUE) -#' } -#' -#' -#' -#' -#' -#' ##################################################################################### -#' ## Pre-defined table styles gallery -#' -#' wb <- createWorkbook(paste0("tableStylesGallery.xlsx")) -#' addWorksheet(wb, "Style Samples") -#' for (i in 1:21) { -#' style <- paste0("TableStyleLight", i) -#' writeDataTable(wb, -#' x = data.frame(style), sheet = 1, -#' tableStyle = style, startRow = 1, startCol = i * 3 - 2 -#' ) -#' } -#' -#' for (i in 1:28) { -#' style <- paste0("TableStyleMedium", i) -#' writeDataTable(wb, -#' x = data.frame(style), sheet = 1, -#' tableStyle = style, startRow = 4, startCol = i * 3 - 2 -#' ) -#' } -#' -#' for (i in 1:11) { -#' style <- paste0("TableStyleDark", i) -#' writeDataTable(wb, -#' x = data.frame(style), sheet = 1, -#' tableStyle = style, startRow = 7, startCol = i * 3 - 2 -#' ) -#' } -#' -#' ## openXL(wb) -#' \dontrun{ -#' saveWorkbook(wb, file = "tableStylesGallery.xlsx", overwrite = TRUE) -#' } -#' -writeDataTable <- function( - wb, - sheet, - x, - startCol = 1, - startRow = 1, - xy = NULL, - colNames = TRUE, - rowNames = FALSE, - tableStyle = openxlsx_getOp("tableStyle", "TableStyleLight9"), - tableName = NULL, - headerStyle = openxlsx_getOp("headerStyle"), - withFilter = openxlsx_getOp("withFilter", TRUE), - keepNA = openxlsx_getOp("keepNA", FALSE), - na.string = openxlsx_getOp("na.string"), - sep = ", ", - stack = FALSE, - firstColumn = openxlsx_getOp("firstColumn", FALSE), - lastColumn = openxlsx_getOp("lastColumn", FALSE), - bandedRows = openxlsx_getOp("bandedRows", TRUE), - bandedCols = openxlsx_getOp("bandedCols", FALSE), - col.names, - row.names - ) { - op <- get_set_options() - on.exit(options(op), add = TRUE) - - ## increase scipen to avoid writing in scientific - - if (!missing(row.names)) { - warning("Please use 'rowNames' instead of 'row.names'", call. = FALSE) - row.names <- rowNames - } - - if (!missing(col.names)) { - warning("Please use 'colNames' instead of 'col.names'", call. = FALSE) - colNames <- col.names - } - - # Set NULLs - withFilter <- withFilter %||% TRUE - keepNA <- keepNA %||% FALSE - firstColumn <- firstColumn %||% FALSE - lastColumn <- lastColumn %||% FALSE - bandedRows <- bandedRows %||% TRUE - bandedCols <- bandedCols %||% FALSE - withFilter <- withFilter %||% TRUE - - if (!is.null(xy)) { - if (length(xy) != 2) { - stop("xy parameter must have length 2") - } - startCol <- xy[[1]] - startRow <- xy[[2]] - } - - # Assert parameters - assert_class(wb, "Workbook") - assert_class(x, "data.frame") - assert_true_false(colNames) - assert_true_false(rowNames) - assert_class(headerStyle, "Style", or_null = TRUE) - assert_true_false(withFilter) - assert_character1(sep) - assert_true_false(firstColumn) - assert_true_false(lastColumn) - assert_true_false(bandedRows) - assert_true_false(bandedCols) - - if (is.null(tableName)) { - tableName <- sprintf("Table%i", length(wb$tables) + 3L) - } else { - tableName <- wb$validate_table_name(tableName) - } - - ## convert startRow and startCol - if (!is.numeric(startCol)) { - startCol <- convertFromExcelRef(startCol) - } - startRow <- as.integer(startRow) - - ## Coordinates for each section - if (rowNames) { - x <- cbind(data.frame("row names" = rownames(x)), as.data.frame(x)) - } - - ## If 0 rows append a blank row - - tableStyle <- validate_StyleName(tableStyle) - - ## header style - if (inherits(headerStyle, "Style")) { - addStyle( - wb = wb, - sheet = sheet, - style = headerStyle, - rows = startRow, - cols = 0:(ncol(x) - 1L) + startCol, - gridExpand = TRUE - ) - } - - showColNames <- colNames - - if (colNames) { - colNames <- colnames(x) - assert_unique(colNames, case_sensitive = FALSE) - - ## zero char names are invalid - char0 <- nchar(colNames) == 0 - if (any(char0)) { - colNames[char0] <- colnames(x)[char0] <- paste0("Column", which(char0)) - } - } else { - colNames <- paste0("Column", seq_along(x)) - names(x) <- colNames - } - - ## If zero rows, append an empty row (prevent XML from corrupting) - if (nrow(x) == 0) { - x <- rbind( - as.data.frame(x), - matrix("", nrow = 1, ncol = ncol(x), dimnames = list(character(), colnames(x))) - ) - names(x) <- colNames - } - - ref1 <- paste0(convert_to_excel_ref(cols = startCol, LETTERS = LETTERS), startRow) - ref2 <- paste0(convert_to_excel_ref(cols = startCol + ncol(x) - 1, LETTERS = LETTERS), startRow + nrow(x)) - ref <- paste(ref1, ref2, sep = ":") - - ## check not overwriting another table - wb$check_overwrite_tables( - sheet = sheet, - new_rows = c(startRow, startRow + nrow(x) - 1L + 1L), ## + header - new_cols = c(startCol, startCol + ncol(x) - 1L) - ) - - - ## column class styling - # consider not using lowercase and instead use inherits(x, class) - colClasses <- lapply(x, function(x) tolower(class(x))) - classStyles( - wb, - sheet = sheet, - startRow = startRow, - startCol = startCol, - colNames = TRUE, - nRow = nrow(x), - colClasses = colClasses, - stack = stack - ) - - ## write data to worksheet - wb$writeData( - df = x, - colNames = TRUE, - sheet = sheet, - startRow = startRow, - startCol = startCol, - colClasses = colClasses, - hlinkNames = NULL, - keepNA = keepNA, - na.string = na.string, - list_sep = sep - ) - - ## replace invalid XML characters - colNames <- replaceIllegalCharacters(colNames) - - ## create table.xml and assign an id to worksheet tables - wb$buildTable( - sheet = sheet, - colNames = colNames, - ref = ref, - showColNames = showColNames, - tableStyle = tableStyle, - tableName = tableName, - withFilter = withFilter[1], - totalsRowCount = 0L, - showFirstColumn = firstColumn[1], - showLastColumn = lastColumn[1], - showRowStripes = bandedRows[1], - showColumnStripes = bandedCols[1] - ) -} + +#' @name writeDataTable +#' @title Write to a worksheet as an Excel table +#' @description Write to a worksheet and format as an Excel table +#' @param wb A Workbook object containing a +#' worksheet. +#' @param sheet The worksheet to write to. Can be the worksheet index or name. +#' @param x A dataframe. +#' @param startCol A vector specifying the starting column to write df +#' @param startRow A vector specifying the starting row to write df +#' @param xy An alternative to specifying startCol and startRow individually. +#' A vector of the form c(startCol, startRow) +#' @param colNames If `TRUE`, column names of x are written. +#' @param rowNames If `TRUE`, row names of x are written. +#' @param row.names,col.names Deprecated, please use `rowNames`, `colNames` instead +#' @param tableStyle Any excel table style name or "none" (see "formatting" vignette). +#' @param tableName name of table in workbook. The table name must be unique. +#' @param headerStyle Custom style to apply to column names. +#' @param withFilter If `TRUE` or `NA`, columns with have filters in the first row. +#' @param keepNA If `TRUE`, NA values are converted to #N/A (or `na.string`, if not NULL) in Excel, else NA cells will be empty. +#' @param na.string If not NULL, and if `keepNA` is `TRUE`, NA values are converted to this string in Excel. +#' @param sep Only applies to list columns. The separator used to collapse list columns to a character vector e.g. sapply(x$list_column, paste, collapse = sep). +#' @param stack If `TRUE` the new style is merged with any existing cell styles. If FALSE, any +#' existing style is replaced by the new style. +#' \cr\cr +#' \cr**The below options correspond to Excel table options:** +#' \cr +#' \if{html}{\figure{tableoptions.png}{options: width="40\%" alt="Figure: table_options.png"}} +#' \if{latex}{\figure{tableoptions.pdf}{options: width=7cm}} +#' +#' @param firstColumn logical. If TRUE, the first column is bold +#' @param lastColumn logical. If TRUE, the last column is bold +#' @param bandedRows logical. If TRUE, rows are colour banded +#' @param bandedCols logical. If TRUE, the columns are colour banded +#' @details columns of x with class Date/POSIXt, currency, accounting, +#' hyperlink, percentage are automatically styled as dates, currency, accounting, +#' hyperlinks, percentages respectively. +#' @seealso [addWorksheet()] +#' @seealso [writeData()] +#' @seealso [removeTable()] +#' @seealso [getTables()] +#' @export +#' @examples +#' ## see package vignettes for further examples. +#' +#' ##################################################################################### +#' ## Create Workbook object and add worksheets +#' wb <- createWorkbook() +#' addWorksheet(wb, "S1") +#' addWorksheet(wb, "S2") +#' addWorksheet(wb, "S3") +#' +#' +#' ##################################################################################### +#' ## -- write data.frame as an Excel table with column filters +#' ## -- default table style is "TableStyleMedium2" +#' +#' writeDataTable(wb, "S1", x = iris) +#' +#' writeDataTable(wb, "S2", +#' x = mtcars, xy = c("B", 3), rowNames = TRUE, +#' tableStyle = "TableStyleLight9" +#' ) +#' +#' df <- data.frame( +#' "Date" = Sys.Date() - 0:19, +#' "T" = TRUE, "F" = FALSE, +#' "Time" = Sys.time() - 0:19 * 60 * 60, +#' "Cash" = paste("$", 1:20), "Cash2" = 31:50, +#' "hLink" = "https://CRAN.R-project.org/", +#' "Percentage" = seq(0, 1, length.out = 20), +#' "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE +#' ) +#' +#' ## openxlsx will apply default Excel styling for these classes +#' class(df$Cash) <- c(class(df$Cash), "currency") +#' class(df$Cash2) <- c(class(df$Cash2), "accounting") +#' class(df$hLink) <- "hyperlink" +#' class(df$Percentage) <- c(class(df$Percentage), "percentage") +#' class(df$TinyNumbers) <- c(class(df$TinyNumbers), "scientific") +#' +#' writeDataTable(wb, "S3", x = df, startRow = 4, rowNames = TRUE, tableStyle = "TableStyleMedium9") +#' +#' ##################################################################################### +#' ## Additional Header Styling and remove column filters +#' +#' writeDataTable(wb, +#' sheet = 1, x = iris, startCol = 7, headerStyle = createStyle(textRotation = 45), +#' withFilter = FALSE +#' ) +#' +#' +#' ##################################################################################### +#' ## Save workbook +#' ## Open in excel without saving file: openXL(wb) +#' \dontrun{ +#' saveWorkbook(wb, "writeDataTableExample.xlsx", overwrite = TRUE) +#' } +#' +#' +#' +#' +#' +#' ##################################################################################### +#' ## Pre-defined table styles gallery +#' +#' wb <- createWorkbook(paste0("tableStylesGallery.xlsx")) +#' addWorksheet(wb, "Style Samples") +#' for (i in 1:21) { +#' style <- paste0("TableStyleLight", i) +#' writeDataTable(wb, +#' x = data.frame(style), sheet = 1, +#' tableStyle = style, startRow = 1, startCol = i * 3 - 2 +#' ) +#' } +#' +#' for (i in 1:28) { +#' style <- paste0("TableStyleMedium", i) +#' writeDataTable(wb, +#' x = data.frame(style), sheet = 1, +#' tableStyle = style, startRow = 4, startCol = i * 3 - 2 +#' ) +#' } +#' +#' for (i in 1:11) { +#' style <- paste0("TableStyleDark", i) +#' writeDataTable(wb, +#' x = data.frame(style), sheet = 1, +#' tableStyle = style, startRow = 7, startCol = i * 3 - 2 +#' ) +#' } +#' +#' ## openXL(wb) +#' \dontrun{ +#' saveWorkbook(wb, file = "tableStylesGallery.xlsx", overwrite = TRUE) +#' } +#' +writeDataTable <- function( + wb, + sheet, + x, + startCol = 1, + startRow = 1, + xy = NULL, + colNames = TRUE, + rowNames = FALSE, + tableStyle = openxlsx_getOp("tableStyle", "TableStyleLight9"), + tableName = NULL, + headerStyle = openxlsx_getOp("headerStyle"), + withFilter = openxlsx_getOp("withFilter", TRUE), + keepNA = openxlsx_getOp("keepNA", FALSE), + na.string = openxlsx_getOp("na.string"), + sep = ", ", + stack = FALSE, + firstColumn = openxlsx_getOp("firstColumn", FALSE), + lastColumn = openxlsx_getOp("lastColumn", FALSE), + bandedRows = openxlsx_getOp("bandedRows", TRUE), + bandedCols = openxlsx_getOp("bandedCols", FALSE), + col.names, + row.names + ) { + op <- get_set_options() + on.exit(options(op), add = TRUE) + + ## increase scipen to avoid writing in scientific + + if (!missing(row.names)) { + warning("Please use 'rowNames' instead of 'row.names'", call. = FALSE) + row.names <- rowNames + } + + if (!missing(col.names)) { + warning("Please use 'colNames' instead of 'col.names'", call. = FALSE) + colNames <- col.names + } + + # Set NULLs + withFilter <- withFilter %||% TRUE + keepNA <- keepNA %||% FALSE + firstColumn <- firstColumn %||% FALSE + lastColumn <- lastColumn %||% FALSE + bandedRows <- bandedRows %||% TRUE + bandedCols <- bandedCols %||% FALSE + withFilter <- withFilter %||% TRUE + + if (!is.null(xy)) { + if (length(xy) != 2) { + stop("xy parameter must have length 2") + } + startCol <- xy[[1]] + startRow <- xy[[2]] + } + + # Assert parameters + assert_class(wb, "Workbook") + assert_class(x, "data.frame") + assert_true_false(colNames) + assert_true_false(rowNames) + assert_class(headerStyle, "Style", or_null = TRUE) + assert_true_false(withFilter) + assert_character1(sep) + assert_true_false(firstColumn) + assert_true_false(lastColumn) + assert_true_false(bandedRows) + assert_true_false(bandedCols) + + if (is.null(tableName)) { + tableName <- sprintf("Table%i", length(wb$tables) + 3L) + } else { + tableName <- wb$validate_table_name(tableName) + } + + ## convert startRow and startCol + if (!is.numeric(startCol)) { + startCol <- convertFromExcelRef(startCol) + } + startRow <- as.integer(startRow) + + ## Coordinates for each section + if (rowNames) { + x <- cbind(data.frame("row names" = rownames(x)), as.data.frame(x)) + } + + ## If 0 rows append a blank row + + tableStyle <- validate_StyleName(tableStyle) + + ## header style + if (inherits(headerStyle, "Style")) { + addStyle( + wb = wb, + sheet = sheet, + style = headerStyle, + rows = startRow, + cols = 0:(ncol(x) - 1L) + startCol, + gridExpand = TRUE + ) + } + + showColNames <- colNames + + if (colNames) { + colNames <- colnames(x) + assert_unique(colNames, case_sensitive = FALSE) + + ## zero char names are invalid + char0 <- nchar(colNames) == 0 + if (any(char0)) { + colNames[char0] <- colnames(x)[char0] <- paste0("Column", which(char0)) + } + } else { + colNames <- paste0("Column", seq_along(x)) + names(x) <- colNames + } + + ## If zero rows, append an empty row (prevent XML from corrupting) + if (nrow(x) == 0) { + x <- rbind( + as.data.frame(x), + matrix("", nrow = 1, ncol = ncol(x), dimnames = list(character(), colnames(x))) + ) + names(x) <- colNames + } + + ref1 <- paste0(convert_to_excel_ref(cols = startCol, LETTERS = LETTERS), startRow) + ref2 <- paste0(convert_to_excel_ref(cols = startCol + ncol(x) - 1, LETTERS = LETTERS), startRow + nrow(x)) + ref <- paste(ref1, ref2, sep = ":") + + ## check not overwriting another table + wb$check_overwrite_tables( + sheet = sheet, + new_rows = c(startRow, startRow + nrow(x) - 1L + 1L), ## + header + new_cols = c(startCol, startCol + ncol(x) - 1L) + ) + + + ## column class styling + # consider not using lowercase and instead use inherits(x, class) + colClasses <- lapply(x, function(x) tolower(class(x))) + classStyles( + wb, + sheet = sheet, + startRow = startRow, + startCol = startCol, + colNames = TRUE, + nRow = nrow(x), + colClasses = colClasses, + stack = stack + ) + + ## write data to worksheet + wb$writeData( + df = x, + colNames = TRUE, + sheet = sheet, + startRow = startRow, + startCol = startCol, + colClasses = colClasses, + hlinkNames = NULL, + keepNA = keepNA, + na.string = na.string, + list_sep = sep + ) + + ## replace invalid XML characters + colNames <- replaceIllegalCharacters(colNames) + + ## create table.xml and assign an id to worksheet tables + wb$buildTable( + sheet = sheet, + colNames = colNames, + ref = ref, + showColNames = showColNames, + tableStyle = tableStyle, + tableName = tableName, + withFilter = withFilter[1], + totalsRowCount = 0L, + showFirstColumn = firstColumn[1], + showLastColumn = lastColumn[1], + showRowStripes = bandedRows[1], + showColumnStripes = bandedCols[1] + ) +} diff -Nru r-cran-openxlsx-4.2.4/R/writexlsx.R r-cran-openxlsx-4.2.5/R/writexlsx.R --- r-cran-openxlsx-4.2.4/R/writexlsx.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/writexlsx.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,128 +1,66 @@ - - -#' @name write.xlsx -#' @title write data to an xlsx file -#' @description write a data.frame or list of data.frames to an xlsx file -#' @author Alexander Walker, Jordan Mark Barbone -#' @inheritParams buildWorkbook -#' @param file A file path to save the xlsx file -#' @param overwrite If `TRUE` will save over `file` if present (default: `FALSE`) -#' -#' \itemize{ -#' \item{createWorkbook} -#' \item{addWorksheet} -#' \item{writeData} -#' \item{freezePane} -#' \item{saveWorkbook} -#' } -#' -#' see details. -#' @details Optional parameters are: -#' -#' \bold{createWorkbook Parameters} -#' \itemize{ -#' \item{\bold{creator}}{ A string specifying the workbook author} -#' } -#' -#' \bold{addWorksheet Parameters} -#' \itemize{ -#' \item{\bold{sheetName}}{ Name of the worksheet} -#' \item{\bold{gridLines}}{ A logical. If \code{FALSE}, the worksheet grid lines will be hidden.} -#' \item{\bold{tabColour}}{ Colour of the worksheet tab. A valid colour (belonging to colours()) -#' or a valid hex colour beginning with "#".} -#' \item{\bold{zoom}}{ A numeric between 10 and 400. Worksheet zoom level as a percentage.} -#' } -#' -#' \bold{writeData/writeDataTable Parameters} -#' \itemize{ -#' \item{\bold{startCol}}{ A vector specifying the starting column(s) to write df} -#' \item{\bold{startRow}}{ A vector specifying the starting row(s) to write df} -#' \item{\bold{xy}}{ An alternative to specifying startCol and startRow individually. -#' A vector of the form c(startCol, startRow)} -#' \item{\bold{colNames or col.names}}{ If \code{TRUE}, column names of x are written.} -#' \item{\bold{rowNames or row.names}}{ If \code{TRUE}, row names of x are written.} -#' \item{\bold{headerStyle}}{ Custom style to apply to column names.} -#' \item{\bold{borders}}{ Either "surrounding", "columns" or "rows" or NULL. If "surrounding", a border is drawn around the -#' data. If "rows", a surrounding border is drawn a border around each row. If "columns", a surrounding border is drawn with a border -#' between each column. If "\code{all}" all cell borders are drawn.} -#' \item{\bold{borderColour}}{ Colour of cell border} -#' \item{\bold{borderStyle}}{ Border line style.} -#' \item{\bold{keepNA}} {If \code{TRUE}, NA values are converted to #N/A (or \code{na.string}, if not NULL) in Excel, else NA cells will be empty. Defaults to FALSE.} -#' \item{\bold{na.string}} {If not NULL, and if \code{keepNA} is \code{TRUE}, NA values are converted to this string in Excel. Defaults to NULL.} -#' } -#' -#' \bold{freezePane Parameters} -#' \itemize{ -#' \item{\bold{firstActiveRow}} {Top row of active region to freeze pane.} -#' \item{\bold{firstActiveCol}} {Furthest left column of active region to freeze pane.} -#' \item{\bold{firstRow}} {If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2)} -#' \item{\bold{firstCol}} {If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2)} -#' } -#' -#' \bold{colWidths Parameters} -#' \itemize{ -#' \item{\bold{colWidths}} {May be a single value for all columns (or "auto"), or a list of vectors that will be recycled for each sheet (see examples)} -#' } -#' -#' -#' \bold{saveWorkbook Parameters} -#' \itemize{ -#' \item{\bold{overwrite}}{ Overwrite existing file (Defaults to TRUE as with write.table)} -#' } -#' -#' -#' columns of x with class Date or POSIXt are automatically -#' styled as dates and datetimes respectively. -#' @seealso \code{\link{addWorksheet}} -#' @seealso \code{\link{writeData}} -#' @seealso \code{\link{createStyle}} for style parameters -#' @seealso \code{\link{buildWorkbook}} -#' @return A workbook object -#' @examples -#' -#' ## write to working directory -#' options("openxlsx.borderColour" = "#4F80BD") ## set default border colour -#' \dontrun{ -#' write.xlsx(iris, file = "writeXLSX1.xlsx", colNames = TRUE, borders = "columns") -#' write.xlsx(iris, file = "writeXLSX2.xlsx", colNames = TRUE, borders = "surrounding") -#' } -#' -#' -#' hs <- createStyle( -#' textDecoration = "BOLD", fontColour = "#FFFFFF", fontSize = 12, -#' fontName = "Arial Narrow", fgFill = "#4F80BD" -#' ) -#' \dontrun{ -#' write.xlsx(iris, -#' file = "writeXLSX3.xlsx", -#' colNames = TRUE, borders = "rows", headerStyle = hs -#' ) -#' } -#' -#' ## Lists elements are written to individual worksheets, using list names as sheet names if available -#' l <- list("IRIS" = iris, "MTCATS" = mtcars, matrix(runif(1000), ncol = 5)) -#' \dontrun{ -#' write.xlsx(l, "writeList1.xlsx", colWidths = c(NA, "auto", "auto")) -#' } -#' -#' ## different sheets can be given different parameters -#' \dontrun{ -#' write.xlsx(l, "writeList2.xlsx", -#' startCol = c(1, 2, 3), startRow = 2, -#' asTable = c(TRUE, TRUE, FALSE), withFilter = c(TRUE, FALSE, FALSE) -#' ) -#' } -#' -#' # specify column widths for multiple sheets -#' \dontrun{ -#' write.xlsx(l, "writeList2.xlsx", colWidths = 20) -#' write.xlsx(l, "writeList2.xlsx", colWidths = list(100, 200, 300)) -#' write.xlsx(l, "writeList2.xlsx", colWidths = list(rep(10, 5), rep(8, 11), rep(5, 5))) -#' } -#' -#' @export -write.xlsx <- function(x, file, asTable = FALSE, overwrite = FALSE, ...) { - wb <- buildWorkbook(x, asTable = asTable, ...) - saveWorkbook(wb, file = file, overwrite = overwrite) - invisible(wb) -} + + +#' @name write.xlsx +#' @title write data to an xlsx file +#' @description write a data.frame or list of data.frames to an xlsx file +#' @author Alexander Walker, Jordan Mark Barbone +#' @inheritParams buildWorkbook +#' @param file A file path to save the xlsx file +#' @param overwrite Overwrite existing file (Defaults to `TRUE` as with `write.table`) +#' @param ... Additional arguments passed to [buildWorkbook()]; see details +#' +#' @inheritSection buildWorkbook Optional Parameters +#' +#' @seealso [addWorksheet()] +#' @seealso [writeData()] +#' @seealso [createStyle()] for style parameters +#' @seealso [buildWorkbook()] +#' @return A workbook object +#' @examples +#' +#' ## write to working directory +#' options("openxlsx.borderColour" = "#4F80BD") ## set default border colour +#' \dontrun{ +#' write.xlsx(iris, file = "writeXLSX1.xlsx", colNames = TRUE, borders = "columns") +#' write.xlsx(iris, file = "writeXLSX2.xlsx", colNames = TRUE, borders = "surrounding") +#' } +#' +#' +#' hs <- createStyle( +#' textDecoration = "BOLD", fontColour = "#FFFFFF", fontSize = 12, +#' fontName = "Arial Narrow", fgFill = "#4F80BD" +#' ) +#' \dontrun{ +#' write.xlsx(iris, +#' file = "writeXLSX3.xlsx", +#' colNames = TRUE, borders = "rows", headerStyle = hs +#' ) +#' } +#' +#' ## Lists elements are written to individual worksheets, using list names as sheet names if available +#' l <- list("IRIS" = iris, "MTCATS" = mtcars, matrix(runif(1000), ncol = 5)) +#' \dontrun{ +#' write.xlsx(l, "writeList1.xlsx", colWidths = c(NA, "auto", "auto")) +#' } +#' +#' ## different sheets can be given different parameters +#' \dontrun{ +#' write.xlsx(l, "writeList2.xlsx", +#' startCol = c(1, 2, 3), startRow = 2, +#' asTable = c(TRUE, TRUE, FALSE), withFilter = c(TRUE, FALSE, FALSE) +#' ) +#' } +#' +#' # specify column widths for multiple sheets +#' \dontrun{ +#' write.xlsx(l, "writeList2.xlsx", colWidths = 20) +#' write.xlsx(l, "writeList2.xlsx", colWidths = list(100, 200, 300)) +#' write.xlsx(l, "writeList2.xlsx", colWidths = list(rep(10, 5), rep(8, 11), rep(5, 5))) +#' } +#' +#' @export +write.xlsx <- function(x, file, asTable = FALSE, overwrite = TRUE, ...) { + wb <- buildWorkbook(x, asTable = asTable, ...) + saveWorkbook(wb, file = file, overwrite = overwrite) + invisible(wb) +} diff -Nru r-cran-openxlsx-4.2.4/R/zzz.R r-cran-openxlsx-4.2.5/R/zzz.R --- r-cran-openxlsx-4.2.4/R/zzz.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/R/zzz.R 2021-12-13 08:14:43.000000000 +0000 @@ -1,7 +1,7 @@ -.onAttach <- function(libname, pkgname) { - op <- options() - toset <- !(names(op.openxlsx) %in% names(op)) - if (any(toset)) { - options(op.openxlsx[toset]) - } -} +.onAttach <- function(libname, pkgname) { + op <- options() + toset <- !(names(op.openxlsx) %in% names(op)) + if (any(toset)) { + options(op.openxlsx[toset]) + } +} diff -Nru r-cran-openxlsx-4.2.4/README.md r-cran-openxlsx-4.2.5/README.md --- r-cran-openxlsx-4.2.4/README.md 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/README.md 2021-12-13 08:14:43.000000000 +0000 @@ -1,50 +1,42 @@ -[openxlsx](https://ycphs.github.io/openxlsx/) -======== - - - -[![codecov](https://codecov.io/gh/ycphs/openxlsx/branch/master/graph/badge.svg)](https://codecov.io/gh/ycphs/openxlsx) -[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/openxlsx)](https://cran.r-project.org/package=openxlsx) -[![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/openxlsx)](https://cran.r-project.org/package=openxlsx) -![R-CMD-check](https://github.com/ycphs/openxlsx/workflows/R-CMD-check/badge.svg?branch=master) - - - - -This [R](https://www.R-project.org/) package simplifies the creation of `.xlsx` files by providing -a high level interface to writing, styling and editing worksheets. Through the use of [`Rcpp`](https://CRAN.R-project.org/package=Rcpp), read/write times are comparable to the [`xlsx`](https://CRAN.R-project.org/package=xlsx) and -[`XLConnect`](https://CRAN.R-project.org/package=XLConnect) packages with the added benefit of removing the dependency on -Java. - -## Installation - -### Stable version - -Current stable version is available on -[CRAN](https://CRAN.R-project.org/) via - -```R -install.packages("openxlsx", dependencies = TRUE) -``` - -### Development version -```R -install.packages(c("Rcpp", "devtools"), dependencies = TRUE) -require(devtools) -install_github("ycphs/openxlsx") -``` - -## Bug/feature request -Please let me know which version of openxlsx you are using when posting bug reports. -```R -packageVersion("openxlsx") -``` - - - -## News -[Here](https://raw.githubusercontent.com/ycphs/openxlsx/master/NEWS.md). - - -## Authors and Contributors for the current release -[@awalker89](https://github.com/awalker89), [@aavanesy](https://github.com/aavanesy), [@ale275](https://github.com/ale275), [@alexb523](https://github.com/alexb523), [@david-f1976](https://github.com/david-f1976), [@davidgohel](https://github.com/davidgohel), [@dovrosenberg](https://github.com/dovrosenberg), [@JoshuaSturm](https://github.com/JoshuaSturm), [@SHAESEN2](https://github.com/SHAESEN2), [@soliac](https://github.com/soliac), [@theclue](https://github.com/theclue), and [@ycphs](https://github.com/ycphs) +[openxlsx](https://ycphs.github.io/openxlsx/) +======== + + +[![codecov](https://codecov.io/gh/ycphs/openxlsx/branch/master/graph/badge.svg)](https://app.codecov.io/gh/ycphs/openxlsx) +[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/openxlsx)](https://cran.r-project.org/package=openxlsx) +[![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/openxlsx)](https://cran.r-project.org/package=openxlsx) +![R-CMD-check](https://github.com/ycphs/openxlsx/workflows/R-CMD-check/badge.svg?branch=master) + + + + +This [R](https://www.R-project.org/) package simplifies the creation of `.xlsx` files by providing +a high level interface to writing, styling and editing worksheets. Through the use of [`Rcpp`](https://CRAN.R-project.org/package=Rcpp), read/write times are comparable to the [`xlsx`](https://CRAN.R-project.org/package=xlsx) and +[`XLConnect`](https://CRAN.R-project.org/package=XLConnect) packages with the added benefit of removing the dependency on +Java. + +## Installation + +### Stable version + +Current stable version is available on [CRAN](https://CRAN.R-project.org/) via + +```R +install.packages("openxlsx", dependencies = TRUE) +``` + +### Development version +```R +install.packages(c("Rcpp", "remotes"), dependencies = TRUE) +remotes::install_github("ycphs/openxlsx") +``` + +## Bug/feature request +Please let me know which version of openxlsx you are using when posting bug reports. +```R +packageVersion("openxlsx") +``` + +## News +[Here](https://raw.githubusercontent.com/ycphs/openxlsx/master/NEWS.md). + diff -Nru r-cran-openxlsx-4.2.4/src/load_workbook.cpp r-cran-openxlsx-4.2.5/src/load_workbook.cpp --- r-cran-openxlsx-4.2.4/src/load_workbook.cpp 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/src/load_workbook.cpp 2021-12-13 08:14:44.000000000 +0000 @@ -472,6 +472,14 @@ has_v = true; } + // find tag and end tag + endPos = cell.find("", 0); + if(endPos != std::string::npos){ + pos = cell.find("", pos); + v[j] = cell.substr(pos + 4, endPos - pos - 4); // skip and + while( begPos != std::string::npos ) { + endPos = xml.find(endTag, begPos); + if(begPos == std::string::npos || endPos == std::string::npos) break; res = xml.substr(begPos, (endPos - begPos) + endTag.length()); - - // check if last 2 characters are "/>" - // or - if (res.substr( res.length() - 2 ).compare("/>") != 0) { - // check - endTag = ""; - } - - // try with - while( 1 ) { + if (res.length() == 0) break; + + auto itr = 0; + // check if we have either , , or . We have to avoid + // + while ( + res.substr(begTag.length(),1).compare(" ") != 0 && // + res.substr(begTag.length(),1).compare("/") != 0 && // + res.substr(begTag.length(),1).compare(">") != 0 // + ) { + if (itr == 0) begPos = begPos + begTag.length(); + if(begPos == std::string::npos || endPos == std::string::npos) break; + + Rcpp::checkUserInterrupt(); + begPos = xml.find(begTag, begPos); endPos = xml.find(endTag, begPos); - - if(begPos == std::string::npos) - break; - - // read from initial "<" to final ">" + + if(begPos == std::string::npos || endPos == std::string::npos) break; res = xml.substr(begPos, (endPos - begPos) + endTag.length()); + + ++itr; + } + + // if we have we need to find the matching closing tag + bool closingtag = false; + if (res.substr( res.length() - 2 ).compare("/>") != 0) { + // this node has + temp_endTag = ""; + closingtag = true; + } else { + temp_endTag = endTag; + } + + // if we have a closing tag, we need to reposition the endPos. Previously + // it was at the end of . Now we search for + if (closingtag) { + endPos = xml.find(temp_endTag, begPos); + if(begPos == std::string::npos || endPos == std::string::npos) break; - begPos = endPos + endTag.length(); - r.push_back(res); + // read from initial "<" to final ">" + res = xml.substr(begPos, (endPos - begPos) + temp_endTag.length()); + if (res.length() == 0) break; } + + if(begPos == std::string::npos || endPos == std::string::npos) break; + + begPos = endPos + temp_endTag.length(); + begPos = xml.find(begTag, begPos); + r.push_back(res); + + if(begPos == std::string::npos || endPos == std::string::npos) break; } - - - CharacterVector out = wrap(r); - return markUTF8(out); - -} + CharacterVector out = wrap(r); + return markUTF8(out); +} // [[Rcpp::export]] diff -Nru r-cran-openxlsx-4.2.4/src/RcppExports.cpp r-cran-openxlsx-4.2.5/src/RcppExports.cpp --- r-cran-openxlsx-4.2.4/src/RcppExports.cpp 2021-06-08 08:15:32.000000000 +0000 +++ r-cran-openxlsx-4.2.5/src/RcppExports.cpp 2021-12-13 08:38:11.000000000 +0000 @@ -5,6 +5,11 @@ using namespace Rcpp; +#ifdef RCPP_USE_GLOBAL_ROSTREAM +Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); +Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); +#endif + // calc_column_widths SEXP calc_column_widths(Reference sheet_data, std::vector sharedStrings, IntegerVector autoColumns, NumericVector widths, float baseFontCharWidth, float minW, float maxW); RcppExport SEXP _openxlsx_calc_column_widths(SEXP sheet_dataSEXP, SEXP sharedStringsSEXP, SEXP autoColumnsSEXP, SEXP widthsSEXP, SEXP baseFontCharWidthSEXP, SEXP minWSEXP, SEXP maxWSEXP) { diff -Nru r-cran-openxlsx-4.2.4/src/read_workbook.cpp r-cran-openxlsx-4.2.5/src/read_workbook.cpp --- r-cran-openxlsx-4.2.4/src/read_workbook.cpp 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/src/read_workbook.cpp 2021-12-13 08:14:44.000000000 +0000 @@ -153,10 +153,6 @@ //read in file std::string buf; - // ifstream file; - // file.open(xmlFile.c_str()); - // while (file >> buf) - // xml += buf + ' '; std::string xml = read_file_newline(xmlFile); std::string xml2 = ""; std::string rtag = "r="; @@ -264,8 +260,11 @@ // count cells with children int ocs = 0; + // can not use pos for start, as the xml and pos were changed string::size_type start = 0; - while((start = xml.find("", start)) != string::npos){ + + // get number of nodes, start is only required for this while loop + while((start = xml.find("", pos + 8); // have to atleast pass + cell = xml.substr(pos, nextPos - pos); + + // Pull out ref + pos = cell.find("r=", 0); // find r=" + endPos = cell.find(tagEnd, pos + 3); // find next " + r[j] = cell.substr(pos + 3, endPos - pos - 3).c_str(); + + buf = cell.substr(pos + 3, endPos - pos - 3); + + buf.erase(std::remove_if(buf.begin(), buf.end(), ::isalpha), buf.end()); + - if(vPos < nextPos){ + // Pull out style + pos = cell.find(" s=", 0); // find s=" + if(pos != std::string::npos){ + endPos = cell.find(tagEnd, pos + 4); // find next " + s[j] = cell.substr(pos + 4, endPos - pos - 4); + } + + // find tag and end tag + endPos = cell.find("", 0); + if(endPos != std::string::npos){ + pos = cell.find("", pos); + v[j] = cell.substr(pos + 1, endPos - pos - 1); + has_v = true; + } + + // find tag and end tag + endPos = cell.find("", 0); + if(endPos != std::string::npos){ + pos = cell.find("", pos); + v[j] = cell.substr(pos + 4, endPos - pos - 4); // skip and ", pos_f + 3); + // if(endPos == std::string::npos){ + // endPos = cell.find("/>", pos_f + 3); + // f[j] = cell.substr(pos_f, endPos - pos_f + 2); + // }else{ + // f[j] = cell.substr(pos_f, endPos - pos_f + 4); + // } + has_f = true; + + // do we really have t + if(pos_t < pos_f){ + endPos = cell.find(tagEnd, pos_t + 4); // find next " + t[j] = cell.substr(pos_t + 4, endPos - pos_t - 4); } - // Pull out style - if(getDates){ - pos = cell.find(stag, 0); // find s=" - if(pos != std::string::npos){ - endPos = cell.find(tagEnd, pos + 4); // find next " - s[i] = cell.substr(pos + 4, endPos - pos - 4).c_str(); - } + + }else if(pos_t != std::string::npos){ // only have t + + endPos = cell.find(tagEnd, pos_t + 4); // find next " + t[j] = cell.substr(pos_t + 4, endPos - pos_t - 4); + + + }else if(pos_f != std::string::npos){ // only have f + + // endPos = cell.find("", pos_f + 3); + // if(endPos == std::string::npos){ + // endPos = cell.find("/>", pos_f + 3); + // f[j] = cell.substr(pos_f, endPos - pos_f + 2); + // }else{ + // f[j] = cell.substr(pos_f, endPos - pos_f + 4); + // } + has_f = true; + + } + + /* since we return only a data frame, we do the preparation here */ + if(t[j] == "s"){ + + auto ss_ind = atoi(v[j]); + v[j] = sharedStrings[ss_ind]; + + if(v[j] == "openxlsx_na_vlu"){ + v[j] = NA_STRING; } + string_refs[j] = r[j]; - // If the value is s or shared we replace with sharedString - // If it's b we replace with "TRUE" or "FALSE" - // If the value is str it's already a string - if(t[i] == "e"){ - - v[i] = NA_STRING; - + }else if(t[j] == "e") { + v[j] = NA_STRING; // exception from loadWorkbook + }else if(t[j] == "b"){ + if(v[j] == "1"){ + v[j] = "TRUE"; }else{ - - // find tag and end tag - endPos = cell.find(vtagEnd, 0); - if(endPos != std::string::npos){ - pos = cell.find("", pos); - v[i] = cell.substr(pos + 1, endPos - pos - 1); - } - - - // possible values for t are n, s, shared, b, str, e - - // do replacement - if(t[i] == "s"){ - - ss_ind = atoi(v[i]); - v[i] = sharedStrings[ss_ind]; - - if(v[i] == "openxlsx_na_vlu"){ - v[i] = NA_STRING; - } - - string_refs[i] = r[i]; - - }else if(t[i] == "b"){ - if(v[i] == "1"){ - v[i] = "TRUE"; - }else{ - v[i] = "FALSE"; - } - string_refs[i] = r[i]; - - }else if(t[i] == "str"){ - string_refs[i] = r[i]; - } + v[j] = "FALSE"; } + string_refs[j] = r[j]; - i++; // INCREMENT OVER OCCURENCES + }else if((t[j] == "str") || (t[j] == "inlineStr")){ + string_refs[j] = r[j]; } + /* preparation is finished */ + + if(has_f & (!has_v) & (t[j] != "n")){ + + v[j] = NA_STRING; + + }else if(has_f & !has_v){ + + t[j] = NA_STRING; + v[j] = NA_STRING; + + }else if(has_f | has_v){ + + }else{ //only have s and r + t[j] = NA_STRING; + v[j] = NA_STRING; + } + + j++; // INCREMENT OVER OCCURENCES pos = nextPos; + pos_t = nextPos; + pos_f = nextPos; - } - } // end of while loop over occurences - // END OF CELL AND ATTRIBUTION GATHERING + + } // end of while loop over occurences + } // END OF CELL AND ATTRIBUTION GATHERING string_refs = string_refs[!is_na(string_refs)]; diff -Nru r-cran-openxlsx-4.2.4/src/write_data.cpp r-cran-openxlsx-4.2.5/src/write_data.cpp --- r-cran-openxlsx-4.2.4/src/write_data.cpp 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/src/write_data.cpp 2021-12-13 08:14:44.000000000 +0000 @@ -34,6 +34,8 @@ t_res[i] = 3; }else if(t[i] == "e"){ t_res[i] = 4; + }else if(t[i] == "inlineStr"){ + t_res[i] = 5; } } @@ -72,6 +74,8 @@ t_res[i] = "str"; }else if(t[i] == 4){ t_res[i] = "e"; + }else if(t[i] == 5){ + t_res[i] = "inlineStr"; }else{ t_res[i] = "s"; } diff -Nru r-cran-openxlsx-4.2.4/src/write_file_2.cpp r-cran-openxlsx-4.2.5/src/write_file_2.cpp --- r-cran-openxlsx-4.2.4/src/write_file_2.cpp 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/src/write_file_2.cpp 2021-12-13 08:14:44.000000000 +0000 @@ -106,10 +106,12 @@ if(!CharacterVector::is_na(cell_types[j-1])){ //If we have a c value we might have an f value - if(CharacterVector::is_na(cell_fn[j-1])){ // no function - - cell_xml += "\" t=\"" + cell_types[j-1] + "\">" + cell_value[j-1] + ""; - + if(CharacterVector::is_na(cell_fn[j-1])){ // no function: v or is + if(Rcpp::as(cell_types[j-1]).compare("inlineStr") == 0){ + cell_xml += "\" t=\"" + cell_types[j-1] + "\">" + "" + cell_value[j-1] + ""; + }else{ + cell_xml += "\" t=\"" + cell_types[j-1] + "\">" + cell_value[j-1] + ""; + } }else{ if(CharacterVector::is_na(cell_value[j-1])){ // If v is NA cell_xml += "\" t=\"" + cell_types[j-1] + "\">" + cell_fn[j-1] + ""; diff -Nru r-cran-openxlsx-4.2.4/src/write_file.cpp r-cran-openxlsx-4.2.5/src/write_file.cpp --- r-cran-openxlsx-4.2.4/src/write_file.cpp 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/src/write_file.cpp 2021-12-13 08:14:44.000000000 +0000 @@ -71,8 +71,11 @@ //If we have a c value we might have an f value (cval[3] is f) if(CharacterVector::is_na(cell_fn[j])){ // no function - - cell_xml += "\" t=\"" + cell_types[j] + "\">" + cell_value[j] + ""; + if(Rcpp::as(cell_types[j]).compare("inlineStr") == 0){ + cell_xml += "\" t=\"" + cell_types[j] + "\">" + "" + cell_value[j] + ""; + }else{ + cell_xml += "\" t=\"" + cell_types[j] + "\">" + cell_value[j] + ""; + } }else{ if(CharacterVector::is_na(cell_value[j])){ // If v is NA diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-activeSheet.R r-cran-openxlsx-4.2.5/tests/testthat/test-activeSheet.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-activeSheet.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-activeSheet.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,33 +1,33 @@ - -context("active Sheet ") - - -test_that("get and set active sheet of a workbook", { - - tempFile1 <- temp_xlsx("temp1") - tempFile2 <- temp_xlsx("temp2") - tempFile3 <- temp_xlsx("temp3") - wbook <- createWorkbook() - addWorksheet(wbook, sheetName = "S1") - addWorksheet(wbook, sheetName = "S2") - addWorksheet(wbook, sheetName = "S3") - - - saveWorkbook(wbook,tempFile1) - # default value is the first sheet active - expect_equal(activeSheet(wbook),1) - expect_equal(activeSheet(wbook),loadWorkbook(tempFile1)$ActiveSheet) - - activeSheet(wbook) <- 1 ## active sheet S1 - saveWorkbook(wbook,tempFile2) - expect_equal(activeSheet(wbook),1) - expect_equal(activeSheet(wbook),loadWorkbook(tempFile2)$ActiveSheet) - activeSheet(wbook) <- "S2" ## active sheet S2 - saveWorkbook(wbook,tempFile3) - expect(activeSheet(wbook),2) - expect_equal(activeSheet(wbook),loadWorkbook(tempFile3)$ActiveSheet) - - unlink(tempFile1, recursive = TRUE, force = TRUE) - unlink(tempFile2, recursive = TRUE, force = TRUE) - unlink(tempFile3, recursive = TRUE, force = TRUE) -}) + +context("active Sheet ") + + +test_that("get and set active sheet of a workbook", { + + tempFile1 <- temp_xlsx("temp1") + tempFile2 <- temp_xlsx("temp2") + tempFile3 <- temp_xlsx("temp3") + wbook <- createWorkbook() + addWorksheet(wbook, sheetName = "S1") + addWorksheet(wbook, sheetName = "S2") + addWorksheet(wbook, sheetName = "S3") + + + saveWorkbook(wbook,tempFile1) + # default value is the first sheet active + expect_equal(activeSheet(wbook),1) + expect_equal(activeSheet(wbook),loadWorkbook(tempFile1)$ActiveSheet) + + activeSheet(wbook) <- 1 ## active sheet S1 + saveWorkbook(wbook,tempFile2) + expect_equal(activeSheet(wbook),1) + expect_equal(activeSheet(wbook),loadWorkbook(tempFile2)$ActiveSheet) + activeSheet(wbook) <- "S2" ## active sheet S2 + saveWorkbook(wbook,tempFile3) + expect(activeSheet(wbook),2) + expect_equal(activeSheet(wbook),loadWorkbook(tempFile3)$ActiveSheet) + + unlink(tempFile1, recursive = TRUE, force = TRUE) + unlink(tempFile2, recursive = TRUE, force = TRUE) + unlink(tempFile3, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-border_parsing.R r-cran-openxlsx-4.2.5/tests/testthat/test-border_parsing.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-border_parsing.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-border_parsing.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,321 +1,321 @@ - - - -context("Style Parsing") - - - -test_that("parsing border xml", { - wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) - styles <- getStyles(wb = wb) - - - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, "medium", - "medium", "medium", "medium", NULL, NULL, NULL, NULL, NULL, - NULL, NULL, NULL, NULL, "thin", NULL, "thin", "thin", NULL, - "thin", "thin", "thin", "thin", "thin", "thin", "thin", NULL, - "thin", "thin", "medium", "medium", "medium", "medium", "thin", - "medium", "medium", "thin", NULL, "medium", "medium", "medium", - "thin", "thin", "medium", "medium", "thin", "thin", "thick", - NULL, "thick", "thick", "thick", NULL, NULL, NULL, NULL, - NULL, "medium", "medium", NULL, "medium", "mediumDashed", - "mediumDashed", "mediumDashed", NULL, NULL, NULL, NULL, NULL, - NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderBottom")) - - - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, - NULL, NULL, NULL, NULL, NULL, "thin", "thin", "thin", NULL, - NULL, NULL, NULL, "medium", NULL, NULL, NULL, NULL, NULL, - "thin", NULL, "thin", "thick", NULL, "medium", "thin", "thin", - "thin", "thin", "thick", "thick", "thin", "thin", "thin", - "medium", "medium", "thin", "thick", "thick", "medium", "thin", - "thick", "thick", "medium", "thin", "thin", "medium", "thin", - "thin", "thin", "medium", "medium", "medium", NULL, NULL, - NULL, NULL, NULL, NULL, "mediumDashed", "mediumDashed", "mediumDashed", - NULL, NULL, NULL, NULL, NULL, NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderTop")) - - - - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, NULL, "medium", NULL, "medium", - NULL, NULL, NULL, NULL, NULL, NULL, "thin", NULL, NULL, "thin", - NULL, NULL, "thin", "medium", NULL, NULL, NULL, NULL, "thin", - "thin", "thin", NULL, "thin", NULL, NULL, NULL, "thin", "medium", - "thin", "thin", "thin", "thin", "medium", "thin", "thin", - NULL, "thin", "thick", "thin", "thick", "thick", "thin", - "thin", "thin", "thin", "thick", NULL, "thin", "thin", "thin", - "medium", NULL, NULL, "medium", NULL, "medium", NULL, "medium", - NULL, "mediumDashed", NULL, NULL, NULL, NULL, NULL, NULL, - NULL, NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderLeft")) - - - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, "medium", NULL, "medium", - NULL, NULL, NULL, "medium", NULL, NULL, NULL, NULL, NULL, - "thin", NULL, NULL, "thin", NULL, NULL, NULL, "thin", NULL, - "thin", NULL, "thin", "thin", "thin", "thin", "thick", NULL, - "thick", "medium", "thin", "thin", "thin", "thin", "medium", - "thin", "thin", "medium", NULL, "medium", "thin", "thin", - "medium", "medium", "thin", "thick", "medium", "medium", - "thin", "medium", "thin", NULL, "thick", NULL, NULL, "medium", - NULL, "medium", NULL, NULL, NULL, "medium", NULL, NULL, "mediumDashed", - NULL, NULL, NULL, NULL, NULL, NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderRight")) - - - - ## COLOURS - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), NULL, NULL, NULL, - NULL, NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - NULL, structure(list(theme = "6"), .Names = "theme"), structure(list( - theme = "6" - ), .Names = "theme"), NULL, structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), NULL, structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "3" - ), .Names = "theme"), structure(list(theme = "3"), .Names = "theme"), - structure(list(theme = "3"), .Names = "theme"), structure(list( - theme = "6" - ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), - structure(list(theme = "6"), .Names = "theme"), structure(list( - theme = "6" - ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), - NULL, structure(list(theme = "6"), .Names = "theme"), structure(list( - theme = "7\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "7\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "9\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - NULL, structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - NULL, NULL, NULL, NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, NULL, NULL, NULL, NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderBottomColour")) - - - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, - NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - structure(list(theme = "6"), .Names = "theme"), structure(list( - theme = "6" - ), .Names = "theme"), NULL, NULL, NULL, NULL, - structure(list(indexed = "64"), .Names = "indexed"), NULL, - NULL, NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "6" - ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(theme = "7\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, NULL, NULL, NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, NULL, NULL, NULL, NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderTopColour")) - - - - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), NULL, - NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), NULL, structure(list( - indexed = "64" - ), .Names = "indexed"), NULL, NULL, NULL, - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "3" - ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "6" - ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), NULL, - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderLeftColour")) - - - - expected_borders <- list( - NULL, NULL, NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - NULL, structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - NULL, structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(theme = "3"), .Names = "theme"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - theme = "6" - ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "6" - ), .Names = "theme"), NULL, structure(list( - theme = "6" - ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "7\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "7\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), - structure(list(indexed = "64"), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), structure(list( - indexed = "64" - ), .Names = "indexed"), NULL, structure(list( - theme = "5\" tint=\"-0.249977111117893" - ), .Names = "theme"), - NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), - NULL, NULL, NULL, NULL, NULL, NULL - ) - - expect_equal(expected_borders, sapply(styles, "[[", "borderRightColour")) -}) + + + +context("Style Parsing") + + + +test_that("parsing border xml", { + wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) + styles <- getStyles(wb = wb) + + + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, "medium", + "medium", "medium", "medium", NULL, NULL, NULL, NULL, NULL, + NULL, NULL, NULL, NULL, "thin", NULL, "thin", "thin", NULL, + "thin", "thin", "thin", "thin", "thin", "thin", "thin", NULL, + "thin", "thin", "medium", "medium", "medium", "medium", "thin", + "medium", "medium", "thin", NULL, "medium", "medium", "medium", + "thin", "thin", "medium", "medium", "thin", "thin", "thick", + NULL, "thick", "thick", "thick", NULL, NULL, NULL, NULL, + NULL, "medium", "medium", NULL, "medium", "mediumDashed", + "mediumDashed", "mediumDashed", NULL, NULL, NULL, NULL, NULL, + NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderBottom")) + + + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, + NULL, NULL, NULL, NULL, NULL, "thin", "thin", "thin", NULL, + NULL, NULL, NULL, "medium", NULL, NULL, NULL, NULL, NULL, + "thin", NULL, "thin", "thick", NULL, "medium", "thin", "thin", + "thin", "thin", "thick", "thick", "thin", "thin", "thin", + "medium", "medium", "thin", "thick", "thick", "medium", "thin", + "thick", "thick", "medium", "thin", "thin", "medium", "thin", + "thin", "thin", "medium", "medium", "medium", NULL, NULL, + NULL, NULL, NULL, NULL, "mediumDashed", "mediumDashed", "mediumDashed", + NULL, NULL, NULL, NULL, NULL, NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderTop")) + + + + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, NULL, "medium", NULL, "medium", + NULL, NULL, NULL, NULL, NULL, NULL, "thin", NULL, NULL, "thin", + NULL, NULL, "thin", "medium", NULL, NULL, NULL, NULL, "thin", + "thin", "thin", NULL, "thin", NULL, NULL, NULL, "thin", "medium", + "thin", "thin", "thin", "thin", "medium", "thin", "thin", + NULL, "thin", "thick", "thin", "thick", "thick", "thin", + "thin", "thin", "thin", "thick", NULL, "thin", "thin", "thin", + "medium", NULL, NULL, "medium", NULL, "medium", NULL, "medium", + NULL, "mediumDashed", NULL, NULL, NULL, NULL, NULL, NULL, + NULL, NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderLeft")) + + + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, "medium", NULL, "medium", + NULL, NULL, NULL, "medium", NULL, NULL, NULL, NULL, NULL, + "thin", NULL, NULL, "thin", NULL, NULL, NULL, "thin", NULL, + "thin", NULL, "thin", "thin", "thin", "thin", "thick", NULL, + "thick", "medium", "thin", "thin", "thin", "thin", "medium", + "thin", "thin", "medium", NULL, "medium", "thin", "thin", + "medium", "medium", "thin", "thick", "medium", "medium", + "thin", "medium", "thin", NULL, "thick", NULL, NULL, "medium", + NULL, "medium", NULL, NULL, NULL, "medium", NULL, NULL, "mediumDashed", + NULL, NULL, NULL, NULL, NULL, NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderRight")) + + + + ## COLOURS + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), NULL, NULL, NULL, + NULL, NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + NULL, structure(list(theme = "6"), .Names = "theme"), structure(list( + theme = "6" + ), .Names = "theme"), NULL, structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), NULL, structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "3" + ), .Names = "theme"), structure(list(theme = "3"), .Names = "theme"), + structure(list(theme = "3"), .Names = "theme"), structure(list( + theme = "6" + ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), + structure(list(theme = "6"), .Names = "theme"), structure(list( + theme = "6" + ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), + NULL, structure(list(theme = "6"), .Names = "theme"), structure(list( + theme = "7\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "7\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "9\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + NULL, structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + NULL, NULL, NULL, NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, NULL, NULL, NULL, NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderBottomColour")) + + + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, + NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + structure(list(theme = "6"), .Names = "theme"), structure(list( + theme = "6" + ), .Names = "theme"), NULL, NULL, NULL, NULL, + structure(list(indexed = "64"), .Names = "indexed"), NULL, + NULL, NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "6" + ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(theme = "7\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, NULL, NULL, NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, NULL, NULL, NULL, NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderTopColour")) + + + + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), NULL, + NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), NULL, structure(list( + indexed = "64" + ), .Names = "indexed"), NULL, NULL, NULL, + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "3" + ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "6" + ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), NULL, + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderLeftColour")) + + + + expected_borders <- list( + NULL, NULL, NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, NULL, NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, NULL, NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + NULL, NULL, NULL, structure(list(theme = "6"), .Names = "theme"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + NULL, structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + NULL, structure(list(theme = "5\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(theme = "3"), .Names = "theme"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + theme = "6" + ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "6" + ), .Names = "theme"), NULL, structure(list( + theme = "6" + ), .Names = "theme"), structure(list(indexed = "64"), .Names = "indexed"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "7\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "7\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(theme = "9\" tint=\"-0.249977111117893"), .Names = "theme"), + structure(list(indexed = "64"), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), structure(list( + indexed = "64" + ), .Names = "indexed"), NULL, structure(list( + theme = "5\" tint=\"-0.249977111117893" + ), .Names = "theme"), + NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, structure("9\" tint=\"-0.249977111117893", .Names = "theme"), + NULL, NULL, NULL, NULL, NULL, NULL + ) + + expect_equal(expected_borders, sapply(styles, "[[", "borderRightColour")) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-build_workbook.R r-cran-openxlsx-4.2.5/tests/testthat/test-build_workbook.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-build_workbook.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-build_workbook.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,42 +1,42 @@ -test_that("buildWorkbook() accepts tableName [187]", { - x <- data.frame(a = 1, b = 2) - - # default name - wb <- buildWorkbook(x, asTable = TRUE) - expect_equal(attr(wb$tables, "tableName"), "Table3") - - # define 1/2 table name - wb <- buildWorkbook(x, asTable = TRUE, tableName = "table_x") - expect_equal(attr(wb$tables, "tableName"), "table_x") - - # define 2/2 table names - wb <- buildWorkbook(list(x, x), asTable = TRUE, tableName = c("table_x", "table_y")) - expect_equal(attr(wb$tables, "tableName"), c("table_x", "table_y")) - - # try to define 1/2 table names - expect_error(buildWorkbook(list(x, x), asTable = TRUE, tableName = "table_x")) -}) - -test_that("row.name and col.name are deprecated", { - x <- data.frame(a = 1) - - expect_warning( - buildWorkbook(x, file = temp_xlsx(), row.names = TRUE, overwrite = TRUE), - "Please use 'rowNames' instead of 'row.names'" - ) - - expect_warning( - buildWorkbook(x, file = temp_xlsx(), row.names = TRUE, overwrite = TRUE, asTable = TRUE), - "Please use 'rowNames' instead of 'row.names'" - ) - - expect_warning( - buildWorkbook(x, file = temp_xlsx(), col.names = TRUE, overwrite = TRUE), - "Please use 'colNames' instead of 'col.names'" - ) - - expect_warning( - buildWorkbook(x, file = temp_xlsx(), col.names = TRUE, overwrite = TRUE, asTable = TRUE), - "Please use 'colNames' instead of 'col.names'" - ) -}) +test_that("buildWorkbook() accepts tableName [187]", { + x <- data.frame(a = 1, b = 2) + + # default name + wb <- buildWorkbook(x, asTable = TRUE) + expect_equal(attr(wb$tables, "tableName"), "Table3") + + # define 1/2 table name + wb <- buildWorkbook(x, asTable = TRUE, tableName = "table_x") + expect_equal(attr(wb$tables, "tableName"), "table_x") + + # define 2/2 table names + wb <- buildWorkbook(list(x, x), asTable = TRUE, tableName = c("table_x", "table_y")) + expect_equal(attr(wb$tables, "tableName"), c("table_x", "table_y")) + + # try to define 1/2 table names + expect_error(buildWorkbook(list(x, x), asTable = TRUE, tableName = "table_x")) +}) + +test_that("row.name and col.name are deprecated", { + x <- data.frame(a = 1) + + expect_warning( + buildWorkbook(x, file = temp_xlsx(), row.names = TRUE, overwrite = TRUE), + "Please use 'rowNames' instead of 'row.names'" + ) + + expect_warning( + buildWorkbook(x, file = temp_xlsx(), row.names = TRUE, overwrite = TRUE, asTable = TRUE), + "Please use 'rowNames' instead of 'row.names'" + ) + + expect_warning( + buildWorkbook(x, file = temp_xlsx(), col.names = TRUE, overwrite = TRUE), + "Please use 'colNames' instead of 'col.names'" + ) + + expect_warning( + buildWorkbook(x, file = temp_xlsx(), col.names = TRUE, overwrite = TRUE, asTable = TRUE), + "Please use 'colNames' instead of 'col.names'" + ) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-cloneWorksheet.R r-cran-openxlsx-4.2.5/tests/testthat/test-cloneWorksheet.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-cloneWorksheet.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-cloneWorksheet.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,32 +1,32 @@ - - -context("clone Worksheet") - - -test_that("clone Worksheet with data", { - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - writeData(wb, "Sheet 1", 1) - cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") - - - file_name <- system.file("extdata", "cloneWorksheetExample.xlsx", package = "openxlsx") - refwb <- loadWorkbook(file = file_name) - - expect_equal(sheets(wb), sheets(refwb)) - expect_equal(worksheetOrder(wb), worksheetOrder(refwb)) -}) - -test_that("clone empty Worksheet", { - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - - cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") - - - file_name <- system.file("extdata", "cloneEmptyWorksheetExample.xlsx", package = "openxlsx") - refwb <- loadWorkbook(file = file_name) - - expect_equal(sheets(wb), sheets(refwb)) - expect_equal(worksheetOrder(wb), worksheetOrder(refwb)) -}) + + +context("clone Worksheet") + + +test_that("clone Worksheet with data", { + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + writeData(wb, "Sheet 1", 1) + cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") + + + file_name <- system.file("extdata", "cloneWorksheetExample.xlsx", package = "openxlsx") + refwb <- loadWorkbook(file = file_name) + + expect_equal(sheets(wb), sheets(refwb)) + expect_equal(worksheetOrder(wb), worksheetOrder(refwb)) +}) + +test_that("clone empty Worksheet", { + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1") + + + file_name <- system.file("extdata", "cloneEmptyWorksheetExample.xlsx", package = "openxlsx") + refwb <- loadWorkbook(file = file_name) + + expect_equal(sheets(wb), sheets(refwb)) + expect_equal(worksheetOrder(wb), worksheetOrder(refwb)) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-CommentClass.R r-cran-openxlsx-4.2.5/tests/testthat/test-CommentClass.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-CommentClass.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-CommentClass.R 2021-12-13 08:14:44.000000000 +0000 @@ -0,0 +1,18 @@ +test_that("createComment() works", { + # error checking + expect_error(createComment("hi", width = 1), NA) + expect_error(createComment("hi", width = 1L), NA) + expect_error(createComment("hi", width = 1:2), "width") + + expect_error(createComment("hi", height = 1), NA) + expect_error(createComment("hi", height = 1L), NA) + expect_error(createComment("hi", height = 1:2), "height") + + expect_error(createComment("hi", visible = NULL)) + expect_error(createComment("hi", visible = c(TRUE, FALSE)), "visible") + + expect_error(createComment("hi", author = 1)) + expect_error(createComment("hi", author = c("a", "a")), "author") + + expect_s4_class(createComment("hello"), "Comment") +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-conditionalFormatting.R r-cran-openxlsx-4.2.5/tests/testthat/test-conditionalFormatting.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-conditionalFormatting.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-conditionalFormatting.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,59 +1,59 @@ - -context("Testing 'topN' and 'bottomN' conditions in conditionalFormatting") -TNBN_test_data <- data.frame(col1 = 1:10, - col2 = 1:10, - col3 = seq(10, 100, 10), - col4 = seq(10, 100, 10), - col5 = 1:10, - col6 = 1:10) - -bg_blue <- createStyle(bgFill = "skyblue") - -wb <- createWorkbook() -sht <- "TopN_BottomN_TEST" -addWorksheet(wb, sht) -writeData(wb, sht, TNBN_test_data) -conditionalFormatting(wb, sht, cols = 1, rows = 2:11, type = "topN", rank = 3, style = bg_blue, percent = FALSE) -conditionalFormatting(wb, sht, cols = 2, rows = 2:11, type = "bottomN", rank = 3, style = bg_blue, percent = FALSE) -conditionalFormatting(wb, sht, cols = 3, rows = 2:11, type = "topN", rank = 50, style = bg_blue, percent = TRUE) -conditionalFormatting(wb, sht, cols = 4, rows = 2:11, type = "bottomN", rank = 50, style = bg_blue, percent = TRUE) -conditionalFormatting(wb, sht, cols = 5, rows = 2:11, type = "topN", rank = 3, style = bg_blue) -conditionalFormatting(wb, sht, cols = 6, rows = 2:11, type = "bottomN", rank = 3, style = bg_blue) - -test_that("Number of conditionalFormatting rules added equal to 6", { - expect_equal(object = length(wb$worksheets[[1]]$conditionalFormatting), expected = 6) -}) - -test_that("topN conditions do not have the 'bottom' argument", { - expect_false(object = grepl(paste('bottom'), wb$worksheets[[1]]$conditionalFormatting[1])) - expect_false(object = grepl(paste('bottom'), wb$worksheets[[1]]$conditionalFormatting[3])) -}) - -test_that("bottomN conditions have the 'bottom' argument set to '1'", { - expect_true(object = grepl(paste('bottom="1"'), wb$worksheets[[1]]$conditionalFormatting[2])) - expect_true(object = grepl(paste('bottom="1"'), wb$worksheets[[1]]$conditionalFormatting[4])) -}) - -test_that("topN/bottomN rank conditions have the 'percent=FALSE' argument set to '0'", { - expect_true(object = grepl(paste('percent="0"'), wb$worksheets[[1]]$conditionalFormatting[1])) - expect_true(object = grepl(paste('percent="0"'), wb$worksheets[[1]]$conditionalFormatting[2])) -}) - -test_that("topN/bottomN rank conditions do not have the 'percent' argument is set to 'NULL'", { - expect_true(object = grepl(paste('percent="NULL"'), wb$worksheets[[1]]$conditionalFormatting[5])) - expect_true(object = grepl(paste('percent="NULL"'), wb$worksheets[[1]]$conditionalFormatting[6])) -}) - -test_that("topN/bottomN percent conditions have the 'percent' argument set to '1'", { - expect_true(object = grepl(paste('percent="1"'), wb$worksheets[[1]]$conditionalFormatting[3])) - expect_true(object = grepl(paste('percent="1"'), wb$worksheets[[1]]$conditionalFormatting[4])) -}) - -test_that("topN/bottomN conditions correspond to 'top10' type", { - expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[1])) - expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[2])) - expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[3])) - expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[4])) - expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[5])) - expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[6])) -}) + +context("Testing 'topN' and 'bottomN' conditions in conditionalFormatting") +TNBN_test_data <- data.frame(col1 = 1:10, + col2 = 1:10, + col3 = seq(10, 100, 10), + col4 = seq(10, 100, 10), + col5 = 1:10, + col6 = 1:10) + +bg_blue <- createStyle(bgFill = "skyblue") + +wb <- createWorkbook() +sht <- "TopN_BottomN_TEST" +addWorksheet(wb, sht) +writeData(wb, sht, TNBN_test_data) +conditionalFormatting(wb, sht, cols = 1, rows = 2:11, type = "topN", rank = 3, style = bg_blue, percent = FALSE) +conditionalFormatting(wb, sht, cols = 2, rows = 2:11, type = "bottomN", rank = 3, style = bg_blue, percent = FALSE) +conditionalFormatting(wb, sht, cols = 3, rows = 2:11, type = "topN", rank = 50, style = bg_blue, percent = TRUE) +conditionalFormatting(wb, sht, cols = 4, rows = 2:11, type = "bottomN", rank = 50, style = bg_blue, percent = TRUE) +conditionalFormatting(wb, sht, cols = 5, rows = 2:11, type = "topN", rank = 3, style = bg_blue) +conditionalFormatting(wb, sht, cols = 6, rows = 2:11, type = "bottomN", rank = 3, style = bg_blue) + +test_that("Number of conditionalFormatting rules added equal to 6", { + expect_equal(object = length(wb$worksheets[[1]]$conditionalFormatting), expected = 6) +}) + +test_that("topN conditions do not have the 'bottom' argument", { + expect_false(object = grepl(paste('bottom'), wb$worksheets[[1]]$conditionalFormatting[1])) + expect_false(object = grepl(paste('bottom'), wb$worksheets[[1]]$conditionalFormatting[3])) +}) + +test_that("bottomN conditions have the 'bottom' argument set to '1'", { + expect_true(object = grepl(paste('bottom="1"'), wb$worksheets[[1]]$conditionalFormatting[2])) + expect_true(object = grepl(paste('bottom="1"'), wb$worksheets[[1]]$conditionalFormatting[4])) +}) + +test_that("topN/bottomN rank conditions have the 'percent=FALSE' argument set to '0'", { + expect_true(object = grepl(paste('percent="0"'), wb$worksheets[[1]]$conditionalFormatting[1])) + expect_true(object = grepl(paste('percent="0"'), wb$worksheets[[1]]$conditionalFormatting[2])) +}) + +test_that("topN/bottomN rank conditions do not have the 'percent' argument is set to 'NULL'", { + expect_true(object = grepl(paste('percent="NULL"'), wb$worksheets[[1]]$conditionalFormatting[5])) + expect_true(object = grepl(paste('percent="NULL"'), wb$worksheets[[1]]$conditionalFormatting[6])) +}) + +test_that("topN/bottomN percent conditions have the 'percent' argument set to '1'", { + expect_true(object = grepl(paste('percent="1"'), wb$worksheets[[1]]$conditionalFormatting[3])) + expect_true(object = grepl(paste('percent="1"'), wb$worksheets[[1]]$conditionalFormatting[4])) +}) + +test_that("topN/bottomN conditions correspond to 'top10' type", { + expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[1])) + expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[2])) + expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[3])) + expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[4])) + expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[5])) + expect_true(object = grepl(paste('type="top10"'), wb$worksheets[[1]]$conditionalFormatting[6])) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-date_time_conversion.R r-cran-openxlsx-4.2.5/tests/testthat/test-date_time_conversion.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-date_time_conversion.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-date_time_conversion.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,35 +1,35 @@ - - -context("Date/Time Conversions") - - - -test_that("convert to date", { - dates <- as.Date("2015-02-07") + -10:10 - origin <- 25569L - n <- as.integer(dates) + origin - - expect_equal(convertToDate(n), dates) - - earlyDate <- as.Date("1900-01-03") - serialDate <- 3 - expect_equal(convertToDate(serialDate), earlyDate) - -}) - - - -test_that("convert to datetime", { - x <- 43037 + 2 / 1440 - expect_equal(object = convertToDateTime(x, tx = Sys.timezone()), expected = as.POSIXct("2017-10-29 00:02:00", tz = Sys.timezone())) - - x <- 43037 + 2 / 1440 + 1 / 86400 - expect_equal(object = convertToDateTime(x, tx = Sys.timezone()), expected = as.POSIXct("2017-10-29 00:02:01", tz = Sys.timezone())) - - x <- 43037 + 2.50 / 1440 - expect_equal(object = convertToDateTime(x, tx = Sys.timezone()), expected = as.POSIXct("2017-10-29 00:02:30", tz = Sys.timezone())) - - x <- 43037 + 2 / 1440 + 12.12 / 86400 - x_datetime <- convertToDateTime(x, tx = "UTC") - attr(x_datetime, "tzone") <- "UTC" -}) + + +context("Date/Time Conversions") + + + +test_that("convert to date", { + dates <- as.Date("2015-02-07") + -10:10 + origin <- 25569L + n <- as.integer(dates) + origin + + expect_equal(convertToDate(n), dates) + + earlyDate <- as.Date("1900-01-03") + serialDate <- 3 + expect_equal(convertToDate(serialDate), earlyDate) + +}) + + + +test_that("convert to datetime", { + x <- 43037 + 2 / 1440 + expect_equal(object = convertToDateTime(x, tx = Sys.timezone()), expected = as.POSIXct("2017-10-29 00:02:00", tz = Sys.timezone())) + + x <- 43037 + 2 / 1440 + 1 / 86400 + expect_equal(object = convertToDateTime(x, tx = Sys.timezone()), expected = as.POSIXct("2017-10-29 00:02:01", tz = Sys.timezone())) + + x <- 43037 + 2.50 / 1440 + expect_equal(object = convertToDateTime(x, tx = Sys.timezone()), expected = as.POSIXct("2017-10-29 00:02:30", tz = Sys.timezone())) + + x <- 43037 + 2 / 1440 + 12.12 / 86400 + x_datetime <- convertToDateTime(x, tx = "UTC") + attr(x_datetime, "tzone") <- "UTC" +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-deleting_tables.R r-cran-openxlsx-4.2.5/tests/testthat/test-deleting_tables.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-deleting_tables.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-deleting_tables.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,222 +1,222 @@ - - -context(desc = "Deleting tables from worksheets") - -test_that("Deleting a Table Object", { - wb <- createWorkbook() - addWorksheet(wb, sheetName = "Sheet 1") - addWorksheet(wb, sheetName = "Sheet 2") - writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") - writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - - # Get table ---- - - expect_equal(length(getTables(wb, sheet = 1)), 2L) - expect_equal(length(getTables(wb, sheet = "Sheet 1")), 2L) - - expect_equal(length(getTables(wb, sheet = 2)), 0) - expect_equal(length(getTables(wb, sheet = "Sheet 2")), 0) - - expect_error(getTables(wb, sheet = 3)) - expect_error(getTables(wb, sheet = "Sheet 3")) - - expect_equal(getTables(wb, sheet = 1), c("iris", "mtcars"), check.attributes = FALSE) - expect_equal(getTables(wb, sheet = "Sheet 1"), c("iris", "mtcars"), check.attributes = FALSE) - - expect_equal(attr(getTables(wb, sheet = 1), "refs"), c("A1:E151", "J1:T33")) - expect_equal(attr(getTables(wb, sheet = "Sheet 1"), "refs"), c("A1:E151", "J1:T33")) - - expect_equal(length(wb$tables), 2L) - - ## Deleting a worksheet ---- - - removeWorksheet(wb, 1) - expect_equal(length(wb$tables), 2L) - expect_equal(length(getTables(wb, sheet = 1)), 0) - - expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted")) - expect_equal(attr(wb$tables, "sheet"), c(0, 0)) - - - - - ################################################################################### - ## write same tables again - - writeDataTable(wb, sheet = 1, x = iris, tableName = "iris") - writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - - expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted", "iris", "mtcars")) - expect_equal(attr(wb$tables, "sheet"), c(0, 0, 1, 1)) - - expect_equal(length(getTables(wb, sheet = 1)), 2L) - expect_equal(length(getTables(wb, sheet = "Sheet 2")), 2L) - - expect_error(getTables(wb, sheet = 2)) - expect_error(getTables(wb, sheet = "Sheet 1")) - - expect_equal(getTables(wb, sheet = 1), c("iris", "mtcars"), check.attributes = FALSE) - expect_equal(getTables(wb, sheet = "Sheet 2"), c("iris", "mtcars"), check.attributes = FALSE) - - expect_equal(attr(getTables(wb, sheet = 1), "refs"), c("A1:E151", "J1:T33")) - expect_equal(attr(getTables(wb, sheet = "Sheet 2"), "refs"), c("A1:E151", "J1:T33")) - - expect_equal(length(wb$tables), 4L) - - - ################################################################################### - ## removeTable - - ## remove iris and re-write it - removeTable(wb = wb, sheet = 1, table = "iris") - - expect_equal(length(wb$tables), 4L) - expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) - expect_equal(attr(wb$worksheets[[1]]$tableParts, "tableName"), "mtcars") - - expect_equal(attr(wb$tables, "tableName"), c( - "iris_openxlsx_deleted", - "mtcars_openxlsx_deleted", - "iris_openxlsx_deleted", - "mtcars" - )) - - ## removeTable clears table object and all data - writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) - expect_equal(wb$worksheets[[1]]$tableParts, c("", ""), check.attributes = FALSE) - expect_equal(attr(wb$worksheets[[1]]$tableParts, "tableName"), c("mtcars", "iris")) - - - removeTable(wb = wb, sheet = 1, table = "iris") - - expect_equal(length(wb$tables), 5L) - expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) - expect_equal(attr(wb$worksheets[[1]]$tableParts, "tableName"), "mtcars") - - expect_equal(attr(wb$tables, "tableName"), c( - "iris_openxlsx_deleted", - "mtcars_openxlsx_deleted", - "iris_openxlsx_deleted", - "mtcars", - "iris_openxlsx_deleted" - )) - - - expect_equal(getTables(wb, sheet = 1), "mtcars", check.attributes = FALSE) -}) - -test_that("Save and load Table Deletion", { - temp_file <- temp_xlsx() - - wb <- createWorkbook() - addWorksheet(wb, sheetName = "Sheet 1") - addWorksheet(wb, sheetName = "Sheet 2") - writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") - writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - - - ################################################################################### - ## Deleting a worksheet - - removeWorksheet(wb, 1) - expect_equal(length(wb$tables), 2L) - expect_equal(length(getTables(wb, sheet = 1)), 0) - - expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted")) - expect_equal(attr(wb$tables, "sheet"), c(0, 0)) - - - ## both table were written to sheet 1 and are expected to not exist after load - saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) - wb <- loadWorkbook(file = temp_file) - expect_null(wb$tables) - unlink(temp_file) - - - - - ################################################################################### - ## Deleting a table - - wb <- createWorkbook() - addWorksheet(wb, sheetName = "Sheet 1") - addWorksheet(wb, sheetName = "Sheet 2") - writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") - writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - - ## remove iris and re-write it - removeTable(wb = wb, sheet = 1, table = "iris") - expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars")) - - temp_file <- temp_xlsx() - saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) - wb <- loadWorkbook(file = temp_file) - - expect_equal(length(wb$tables), 1L) - expect_equal(unname(attr(wb$tables, "tableName")), "mtcars") - - expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) ## rId reset - expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), "mtcars") - unlink(temp_file) - - - - ## now delete the other table - wb <- createWorkbook() - addWorksheet(wb, sheetName = "Sheet 1") - addWorksheet(wb, sheetName = "Sheet 2") - writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") - writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - writeDataTable(wb, sheet = 2, x = mtcars, tableName = "mtcars2", startCol = 3) - - removeTable(wb = wb, sheet = 1, table = "iris") - removeTable(wb = wb, sheet = 1, table = "mtcars") - expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted", "mtcars2")) - - temp_file <- temp_xlsx() - saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) - wb <- loadWorkbook(file = temp_file) - - - expect_equal(length(wb$tables), 1L) - expect_equal(unname(attr(wb$tables, "tableName")), "mtcars2") - expect_length(wb$worksheets[[1]]$tableParts, 0) - expect_equal(wb$worksheets[[2]]$tableParts, "", check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[2]]$tableParts, "tableName")), "mtcars2") - unlink(temp_file) - - - ## write tables back in - writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") - writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) - - expect_equal(length(wb$tables), 3L) - expect_equal(unname(attr(wb$tables, "tableName")), c("mtcars2", "iris", "mtcars")) - - expect_length(wb$worksheets[[1]]$tableParts, 2) - expect_equal(wb$worksheets[[1]]$tableParts, c("", ""), check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), c("iris", "mtcars")) - - expect_length(wb$worksheets[[2]]$tableParts, 1) - expect_equal(wb$worksheets[[2]]$tableParts, c(""), check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[2]]$tableParts, "tableName")), "mtcars2") - - saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) - - - ## Ids should get reset after load - wb <- loadWorkbook(file = temp_file) - - expect_equal(length(wb$tables), 3L) - expect_equal(unname(attr(wb$tables, "tableName")), c("iris", "mtcars", "mtcars2")) - - expect_length(wb$worksheets[[1]]$tableParts, 2) - expect_equal(wb$worksheets[[1]]$tableParts, c("", ""), check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), c("iris", "mtcars")) - - expect_length(wb$worksheets[[2]]$tableParts, 1) - expect_equal(wb$worksheets[[2]]$tableParts, c(""), check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[2]]$tableParts, "tableName")), "mtcars2") - - unlink(temp_file) -}) + + +context(desc = "Deleting tables from worksheets") + +test_that("Deleting a Table Object", { + wb <- createWorkbook() + addWorksheet(wb, sheetName = "Sheet 1") + addWorksheet(wb, sheetName = "Sheet 2") + writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") + writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + + # Get table ---- + + expect_equal(length(getTables(wb, sheet = 1)), 2L) + expect_equal(length(getTables(wb, sheet = "Sheet 1")), 2L) + + expect_equal(length(getTables(wb, sheet = 2)), 0) + expect_equal(length(getTables(wb, sheet = "Sheet 2")), 0) + + expect_error(getTables(wb, sheet = 3)) + expect_error(getTables(wb, sheet = "Sheet 3")) + + expect_equal(getTables(wb, sheet = 1), c("iris", "mtcars"), check.attributes = FALSE) + expect_equal(getTables(wb, sheet = "Sheet 1"), c("iris", "mtcars"), check.attributes = FALSE) + + expect_equal(attr(getTables(wb, sheet = 1), "refs"), c("A1:E151", "J1:T33")) + expect_equal(attr(getTables(wb, sheet = "Sheet 1"), "refs"), c("A1:E151", "J1:T33")) + + expect_equal(length(wb$tables), 2L) + + ## Deleting a worksheet ---- + + removeWorksheet(wb, 1) + expect_equal(length(wb$tables), 2L) + expect_equal(length(getTables(wb, sheet = 1)), 0) + + expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted")) + expect_equal(attr(wb$tables, "sheet"), c(0, 0)) + + + + + ################################################################################### + ## write same tables again + + writeDataTable(wb, sheet = 1, x = iris, tableName = "iris") + writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + + expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted", "iris", "mtcars")) + expect_equal(attr(wb$tables, "sheet"), c(0, 0, 1, 1)) + + expect_equal(length(getTables(wb, sheet = 1)), 2L) + expect_equal(length(getTables(wb, sheet = "Sheet 2")), 2L) + + expect_error(getTables(wb, sheet = 2)) + expect_error(getTables(wb, sheet = "Sheet 1")) + + expect_equal(getTables(wb, sheet = 1), c("iris", "mtcars"), check.attributes = FALSE) + expect_equal(getTables(wb, sheet = "Sheet 2"), c("iris", "mtcars"), check.attributes = FALSE) + + expect_equal(attr(getTables(wb, sheet = 1), "refs"), c("A1:E151", "J1:T33")) + expect_equal(attr(getTables(wb, sheet = "Sheet 2"), "refs"), c("A1:E151", "J1:T33")) + + expect_equal(length(wb$tables), 4L) + + + ################################################################################### + ## removeTable + + ## remove iris and re-write it + removeTable(wb = wb, sheet = 1, table = "iris") + + expect_equal(length(wb$tables), 4L) + expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) + expect_equal(attr(wb$worksheets[[1]]$tableParts, "tableName"), "mtcars") + + expect_equal(attr(wb$tables, "tableName"), c( + "iris_openxlsx_deleted", + "mtcars_openxlsx_deleted", + "iris_openxlsx_deleted", + "mtcars" + )) + + ## removeTable clears table object and all data + writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1) + expect_equal(wb$worksheets[[1]]$tableParts, c("", ""), check.attributes = FALSE) + expect_equal(attr(wb$worksheets[[1]]$tableParts, "tableName"), c("mtcars", "iris")) + + + removeTable(wb = wb, sheet = 1, table = "iris") + + expect_equal(length(wb$tables), 5L) + expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) + expect_equal(attr(wb$worksheets[[1]]$tableParts, "tableName"), "mtcars") + + expect_equal(attr(wb$tables, "tableName"), c( + "iris_openxlsx_deleted", + "mtcars_openxlsx_deleted", + "iris_openxlsx_deleted", + "mtcars", + "iris_openxlsx_deleted" + )) + + + expect_equal(getTables(wb, sheet = 1), "mtcars", check.attributes = FALSE) +}) + +test_that("Save and load Table Deletion", { + temp_file <- temp_xlsx() + + wb <- createWorkbook() + addWorksheet(wb, sheetName = "Sheet 1") + addWorksheet(wb, sheetName = "Sheet 2") + writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") + writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + + + ################################################################################### + ## Deleting a worksheet + + removeWorksheet(wb, 1) + expect_equal(length(wb$tables), 2L) + expect_equal(length(getTables(wb, sheet = 1)), 0) + + expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted")) + expect_equal(attr(wb$tables, "sheet"), c(0, 0)) + + + ## both table were written to sheet 1 and are expected to not exist after load + saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) + wb <- loadWorkbook(file = temp_file) + expect_null(wb$tables) + unlink(temp_file) + + + + + ################################################################################### + ## Deleting a table + + wb <- createWorkbook() + addWorksheet(wb, sheetName = "Sheet 1") + addWorksheet(wb, sheetName = "Sheet 2") + writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") + writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + + ## remove iris and re-write it + removeTable(wb = wb, sheet = 1, table = "iris") + expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars")) + + temp_file <- temp_xlsx() + saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) + wb <- loadWorkbook(file = temp_file) + + expect_equal(length(wb$tables), 1L) + expect_equal(unname(attr(wb$tables, "tableName")), "mtcars") + + expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) ## rId reset + expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), "mtcars") + unlink(temp_file) + + + + ## now delete the other table + wb <- createWorkbook() + addWorksheet(wb, sheetName = "Sheet 1") + addWorksheet(wb, sheetName = "Sheet 2") + writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") + writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + writeDataTable(wb, sheet = 2, x = mtcars, tableName = "mtcars2", startCol = 3) + + removeTable(wb = wb, sheet = 1, table = "iris") + removeTable(wb = wb, sheet = 1, table = "mtcars") + expect_equal(attr(wb$tables, "tableName"), c("iris_openxlsx_deleted", "mtcars_openxlsx_deleted", "mtcars2")) + + temp_file <- temp_xlsx() + saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) + wb <- loadWorkbook(file = temp_file) + + + expect_equal(length(wb$tables), 1L) + expect_equal(unname(attr(wb$tables, "tableName")), "mtcars2") + expect_length(wb$worksheets[[1]]$tableParts, 0) + expect_equal(wb$worksheets[[2]]$tableParts, "", check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[2]]$tableParts, "tableName")), "mtcars2") + unlink(temp_file) + + + ## write tables back in + writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris") + writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10) + + expect_equal(length(wb$tables), 3L) + expect_equal(unname(attr(wb$tables, "tableName")), c("mtcars2", "iris", "mtcars")) + + expect_length(wb$worksheets[[1]]$tableParts, 2) + expect_equal(wb$worksheets[[1]]$tableParts, c("", ""), check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), c("iris", "mtcars")) + + expect_length(wb$worksheets[[2]]$tableParts, 1) + expect_equal(wb$worksheets[[2]]$tableParts, c(""), check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[2]]$tableParts, "tableName")), "mtcars2") + + saveWorkbook(wb = wb, file = temp_file, overwrite = TRUE) + + + ## Ids should get reset after load + wb <- loadWorkbook(file = temp_file) + + expect_equal(length(wb$tables), 3L) + expect_equal(unname(attr(wb$tables, "tableName")), c("iris", "mtcars", "mtcars2")) + + expect_length(wb$worksheets[[1]]$tableParts, 2) + expect_equal(wb$worksheets[[1]]$tableParts, c("", ""), check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), c("iris", "mtcars")) + + expect_length(wb$worksheets[[2]]$tableParts, 1) + expect_equal(wb$worksheets[[2]]$tableParts, c(""), check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[2]]$tableParts, "tableName")), "mtcars2") + + unlink(temp_file) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-encoding.R r-cran-openxlsx-4.2.5/tests/testthat/test-encoding.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-encoding.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-encoding.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,91 +1,91 @@ - - - -context("Encoding Tests") - - - -test_that("Write read encoding equality", { - tempFile <- temp_xlsx() - - wb <- createWorkbook() - for (i in 1:4) { - addWorksheet(wb, sprintf("Sheet %s", i)) - } - - df <- data.frame("X" = c("测试", "一下"), stringsAsFactors = FALSE) - writeDataTable(wb, sheet = 1, x = df) - - saveWorkbook(wb, tempFile, overwrite = TRUE) - - x <- read.xlsx(tempFile) - expect_equal(x, df) - - x <- read.xlsx(wb) - expect_equal(x, df) - - ## reload - wb <- loadWorkbook(tempFile) - - x <- read.xlsx(wb) - expect_equal(x, df) - - saveWorkbook(wb, tempFile, overwrite = TRUE) - x <- read.xlsx(tempFile) - expect_equal(x, df) - - unlink(tempFile, recursive = TRUE, force = TRUE) - rm(wb) -}) - - -test_that("Support non-ASCII strings not in UTF-8 encodings", { - non_ascii <- c("\u4f60\u597d", "\u4e2d\u6587", "\u6c49\u5b57", - "\u5de5\u4f5c\u7c3f1", "\u6d4b\u8bd5\u540d\u5b571", - "\u6d4b2", "\u5de52", "\u5de5\u4f5c3") - # Ideally, we should test agains native encodings. However, the testing machine's - # locale encoding may not be able to represent the non-ascii letters, when - # it's the case, we use the UTF-8 encoding as it is. - if (identical( enc2utf8(enc2native(non_ascii)), non_ascii )) { - non_ascii <- enc2native(non_ascii) - } - non_ascii_df <- data.frame( - X = non_ascii, Y = seq_along(non_ascii), stringsAsFactors = FALSE - ) - colnames(non_ascii_df) <- non_ascii[3:4] - file <- temp_xlsx() - wb <- createWorkbook(creator = non_ascii[1]) - ws <- addWorksheet(wb, non_ascii[2]) - writeDataTable(wb, ws, non_ascii_df, tableName = non_ascii[3]) - writeData(wb, ws, non_ascii_df, xy = list("D", 1), name = non_ascii[4]) - writeComment(wb, ws, 1, 1, comment = createComment(non_ascii[5], non_ascii[6])) - writeFormula(wb, ws, x = sprintf('"%s"&"%s"', non_ascii[1], non_ascii[2]), xy = list("G", 1)) - createNamedRegion(wb, ws, 7, 1, name = non_ascii[7]) - saveWorkbook(wb, file) - - wb2 <- loadWorkbook(file) - expect_equal( - getCreators(wb2), non_ascii[1] - ) - expect_equal( - getSheetNames(file), non_ascii[2] - ) - expect_equivalent( - getTables(wb2, ws), non_ascii[3] - ) - expect_equivalent( - getNamedRegions(wb2), non_ascii[c(4, 7)] - ) - expect_equal( - wb2$comments[[1]][[1]][c("comment", "author")], - setNames(as.list(non_ascii[5:6]), c("comment", "author")) - ) - expect_equal( - read.xlsx(file, ws, cols = 1:2), - non_ascii_df - ) - expect_equal( - read.xlsx(file, ws, cols = 4:5), - non_ascii_df - ) -}) + + + +context("Encoding Tests") + + + +test_that("Write read encoding equality", { + tempFile <- temp_xlsx() + + wb <- createWorkbook() + for (i in 1:4) { + addWorksheet(wb, sprintf("Sheet %s", i)) + } + + df <- data.frame("X" = c("测试", "一下"), stringsAsFactors = FALSE) + writeDataTable(wb, sheet = 1, x = df) + + saveWorkbook(wb, tempFile, overwrite = TRUE) + + x <- read.xlsx(tempFile) + expect_equal(x, df) + + x <- read.xlsx(wb) + expect_equal(x, df) + + ## reload + wb <- loadWorkbook(tempFile) + + x <- read.xlsx(wb) + expect_equal(x, df) + + saveWorkbook(wb, tempFile, overwrite = TRUE) + x <- read.xlsx(tempFile) + expect_equal(x, df) + + unlink(tempFile, recursive = TRUE, force = TRUE) + rm(wb) +}) + + +test_that("Support non-ASCII strings not in UTF-8 encodings", { + non_ascii <- c("\u4f60\u597d", "\u4e2d\u6587", "\u6c49\u5b57", + "\u5de5\u4f5c\u7c3f1", "\u6d4b\u8bd5\u540d\u5b571", + "\u6d4b2", "\u5de52", "\u5de5\u4f5c3") + # Ideally, we should test agains native encodings. However, the testing machine's + # locale encoding may not be able to represent the non-ascii letters, when + # it's the case, we use the UTF-8 encoding as it is. + if (identical( enc2utf8(enc2native(non_ascii)), non_ascii )) { + non_ascii <- enc2native(non_ascii) + } + non_ascii_df <- data.frame( + X = non_ascii, Y = seq_along(non_ascii), stringsAsFactors = FALSE + ) + colnames(non_ascii_df) <- non_ascii[3:4] + file <- temp_xlsx() + wb <- createWorkbook(creator = non_ascii[1]) + ws <- addWorksheet(wb, non_ascii[2]) + writeDataTable(wb, ws, non_ascii_df, tableName = non_ascii[3]) + writeData(wb, ws, non_ascii_df, xy = list("D", 1), name = non_ascii[4]) + writeComment(wb, ws, 1, 1, comment = createComment(non_ascii[5], non_ascii[6])) + writeFormula(wb, ws, x = sprintf('"%s"&"%s"', non_ascii[1], non_ascii[2]), xy = list("G", 1)) + createNamedRegion(wb, ws, 7, 1, name = non_ascii[7]) + saveWorkbook(wb, file) + + wb2 <- loadWorkbook(file) + expect_equal( + getCreators(wb2), non_ascii[1] + ) + expect_equal( + getSheetNames(file), non_ascii[2] + ) + expect_equivalent( + getTables(wb2, ws), non_ascii[3] + ) + expect_equivalent( + getNamedRegions(wb2), non_ascii[c(4, 7)] + ) + expect_equal( + wb2$comments[[1]][[1]][c("comment", "author")], + setNames(as.list(non_ascii[5:6]), c("comment", "author")) + ) + expect_equal( + read.xlsx(file, ws, cols = 1:2), + non_ascii_df + ) + expect_equal( + read.xlsx(file, ws, cols = 4:5), + non_ascii_df + ) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-fill_merged_cells.R r-cran-openxlsx-4.2.5/tests/testthat/test-fill_merged_cells.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-fill_merged_cells.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-fill_merged_cells.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,44 +1,44 @@ - - - - - -context("Fill Merged Cells") - - - -test_that("fill merged cells", { - wb <- createWorkbook() - addWorksheet(wb, sheetName = "sheet1") - writeData(wb = wb, sheet = 1, x = data.frame("A" = 1, "B" = 2)) - writeData(wb = wb, sheet = 1, x = 2, startRow = 2, startCol = 2) - writeData(wb = wb, sheet = 1, x = 3, startRow = 2, startCol = 3) - writeData(wb = wb, sheet = 1, x = 4, startRow = 2, startCol = 4) - writeData(wb = wb, sheet = 1, x = t(matrix(1:4, 4, 4)), startRow = 3, startCol = 1, colNames = FALSE) - - mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 1) - mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 3) - mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 4) - mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 5) - - tmp_file <- temp_xlsx() - saveWorkbook(wb = wb, file = tmp_file, overwrite = TRUE) - - expect_equal(names(read.xlsx(tmp_file, fillMergedCells = FALSE)), c("A", "B", "X3", "X4")) - expect_equal(names(read.xlsx(tmp_file, fillMergedCells = TRUE)), c("A", "B", "B", "B")) - - r1 <- data.frame("A" = rep(1, 5), "B" = rep(2, 5), "X3" = rep(3,5), "X4" = rep(4, 5)) - r2 <- data.frame("A" = rep(1, 5), "B" = rep(2, 5), "B1" = c(3,2,2,2,3), "B2" = c(4,2,2,2,4)) - names(r2) <- c("A", "B", "B", "B") - - r2_1 <- r2[1:5, 1:3] - names(r2_1) <- c("A", "B", "B") - - expect_equal(read.xlsx(tmp_file, fillMergedCells = FALSE), r1) - expect_equal(read.xlsx(tmp_file, fillMergedCells = TRUE), r2) - - expect_equal( read.xlsx(tmp_file, cols = 1:3, fillMergedCells = TRUE), r2_1) - expect_equal( read.xlsx(tmp_file, rows = 1:3, fillMergedCells = TRUE), r2[1:2, ]) - expect_equal( read.xlsx(tmp_file, cols = 1:3, rows = 1:4, fillMergedCells = TRUE), r2_1[1:3,]) - -}) + + + + + +context("Fill Merged Cells") + + + +test_that("fill merged cells", { + wb <- createWorkbook() + addWorksheet(wb, sheetName = "sheet1") + writeData(wb = wb, sheet = 1, x = data.frame("A" = 1, "B" = 2)) + writeData(wb = wb, sheet = 1, x = 2, startRow = 2, startCol = 2) + writeData(wb = wb, sheet = 1, x = 3, startRow = 2, startCol = 3) + writeData(wb = wb, sheet = 1, x = 4, startRow = 2, startCol = 4) + writeData(wb = wb, sheet = 1, x = t(matrix(1:4, 4, 4)), startRow = 3, startCol = 1, colNames = FALSE) + + mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 1) + mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 3) + mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 4) + mergeCells(wb = wb, sheet = 1, cols = 2:4, rows = 5) + + tmp_file <- temp_xlsx() + saveWorkbook(wb = wb, file = tmp_file, overwrite = TRUE) + + expect_equal(names(read.xlsx(tmp_file, fillMergedCells = FALSE)), c("A", "B", "X3", "X4")) + expect_equal(names(read.xlsx(tmp_file, fillMergedCells = TRUE)), c("A", "B", "B", "B")) + + r1 <- data.frame("A" = rep(1, 5), "B" = rep(2, 5), "X3" = rep(3,5), "X4" = rep(4, 5)) + r2 <- data.frame("A" = rep(1, 5), "B" = rep(2, 5), "B1" = c(3,2,2,2,3), "B2" = c(4,2,2,2,4)) + names(r2) <- c("A", "B", "B", "B") + + r2_1 <- r2[1:5, 1:3] + names(r2_1) <- c("A", "B", "B") + + expect_equal(read.xlsx(tmp_file, fillMergedCells = FALSE), r1) + expect_equal(read.xlsx(tmp_file, fillMergedCells = TRUE), r2) + + expect_equal( read.xlsx(tmp_file, cols = 1:3, fillMergedCells = TRUE), r2_1) + expect_equal( read.xlsx(tmp_file, rows = 1:3, fillMergedCells = TRUE), r2[1:2, ]) + expect_equal( read.xlsx(tmp_file, cols = 1:3, rows = 1:4, fillMergedCells = TRUE), r2_1[1:3,]) + +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-fontSizeLookupTables.R r-cran-openxlsx-4.2.5/tests/testthat/test-fontSizeLookupTables.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-fontSizeLookupTables.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-fontSizeLookupTables.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,4 +1,4 @@ -test_that("lookup tables dimensions", { - expect_equal(dim(openxlsxFontSizeLookupTable), c(29L, 225L)) - expect_equal(dim(openxlsxFontSizeLookupTableBold), c(29L, 225L)) -}) +test_that("lookup tables dimensions", { + expect_equal(dim(openxlsxFontSizeLookupTable), c(29L, 225L)) + expect_equal(dim(openxlsxFontSizeLookupTableBold), c(29L, 225L)) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-freeze_pane.R r-cran-openxlsx-4.2.5/tests/testthat/test-freeze_pane.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-freeze_pane.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-freeze_pane.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,111 +1,111 @@ - -context("Freeze Panes") - -test_that("Freeze Panes", { - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - freezePane(wb, 1, firstActiveRow = 3, firstActiveCol = 3) - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - - - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - freezePane(wb, 1, firstActiveRow = 1, firstActiveCol = 3) - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - - - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - freezePane(wb, 1, firstActiveRow = 2, firstActiveCol = 1) - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - - - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - freezePane(wb, 1, firstActiveRow = 2, firstActiveCol = 4) - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - - - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - freezePane(wb, 1, firstCol = TRUE) - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - - - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - freezePane(wb, 1, firstRow = TRUE) - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - - - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - freezePane(wb, 1, firstRow = TRUE, firstCol = TRUE) - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - addWorksheet(wb, "Sheet 2") - addWorksheet(wb, "Sheet 3") - addWorksheet(wb, "Sheet 4") - addWorksheet(wb, "Sheet 5") - addWorksheet(wb, "Sheet 6") - addWorksheet(wb, "Sheet 7") - - freezePane(wb, sheet = 1, firstActiveRow = 3, firstActiveCol = 3) - freezePane(wb, sheet = 2, firstActiveRow = 1, firstActiveCol = 3) - freezePane(wb, sheet = 3, firstActiveRow = 2, firstActiveCol = 1) - freezePane(wb, sheet = 4, firstActiveRow = 2, firstActiveCol = 4) - freezePane(wb, sheet = 5, firstCol = TRUE) - freezePane(wb, sheet = 6, firstRow = TRUE) - freezePane(wb, sheet = 7, firstRow = TRUE, firstCol = TRUE) - - - expected <- "" - expect_equal(wb$worksheets[[1]]$freezePane, expected) - - expected <- "" - expect_equal(wb$worksheets[[2]]$freezePane, expected) - - expected <- "" - expect_equal(wb$worksheets[[3]]$freezePane, expected) - - expected <- "" - expect_equal(wb$worksheets[[4]]$freezePane, expected) - - expected <- "" - expect_equal(wb$worksheets[[5]]$freezePane, expected) - - expected <- "" - expect_equal(wb$worksheets[[6]]$freezePane, expected) - - expected <- "" - expect_equal(wb$worksheets[[7]]$freezePane, expected) -}) + +context("Freeze Panes") + +test_that("Freeze Panes", { + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + freezePane(wb, 1, firstActiveRow = 3, firstActiveCol = 3) + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + + + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + freezePane(wb, 1, firstActiveRow = 1, firstActiveCol = 3) + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + + + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + freezePane(wb, 1, firstActiveRow = 2, firstActiveCol = 1) + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + + + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + freezePane(wb, 1, firstActiveRow = 2, firstActiveCol = 4) + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + + + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + freezePane(wb, 1, firstCol = TRUE) + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + + + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + freezePane(wb, 1, firstRow = TRUE) + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + + + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + freezePane(wb, 1, firstRow = TRUE, firstCol = TRUE) + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + addWorksheet(wb, "Sheet 2") + addWorksheet(wb, "Sheet 3") + addWorksheet(wb, "Sheet 4") + addWorksheet(wb, "Sheet 5") + addWorksheet(wb, "Sheet 6") + addWorksheet(wb, "Sheet 7") + + freezePane(wb, sheet = 1, firstActiveRow = 3, firstActiveCol = 3) + freezePane(wb, sheet = 2, firstActiveRow = 1, firstActiveCol = 3) + freezePane(wb, sheet = 3, firstActiveRow = 2, firstActiveCol = 1) + freezePane(wb, sheet = 4, firstActiveRow = 2, firstActiveCol = 4) + freezePane(wb, sheet = 5, firstCol = TRUE) + freezePane(wb, sheet = 6, firstRow = TRUE) + freezePane(wb, sheet = 7, firstRow = TRUE, firstCol = TRUE) + + + expected <- "" + expect_equal(wb$worksheets[[1]]$freezePane, expected) + + expected <- "" + expect_equal(wb$worksheets[[2]]$freezePane, expected) + + expected <- "" + expect_equal(wb$worksheets[[3]]$freezePane, expected) + + expected <- "" + expect_equal(wb$worksheets[[4]]$freezePane, expected) + + expected <- "" + expect_equal(wb$worksheets[[5]]$freezePane, expected) + + expected <- "" + expect_equal(wb$worksheets[[6]]$freezePane, expected) + + expected <- "" + expect_equal(wb$worksheets[[7]]$freezePane, expected) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-getBaseFont.R r-cran-openxlsx-4.2.5/tests/testthat/test-getBaseFont.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-getBaseFont.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-getBaseFont.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,22 +1,22 @@ -test_that("getBaseFont works", { - wb <- createWorkbook() - expect_equal( - getBaseFont(wb), - list( - size = list(val = "11"), - # should this be "#000000"? - colour = list(rgb = "FF000000"), - name = list(val = "Calibri") - ) - ) - - modifyBaseFont(wb, fontSize = 9, fontName = "Arial", fontColour = "red") - expect_equal( - getBaseFont(wb), - list( - size = list(val = "9"), - colour = list(rgb = "FFFF0000"), - name = list(val = "Arial") - ) - ) -}) +test_that("getBaseFont works", { + wb <- createWorkbook() + expect_equal( + getBaseFont(wb), + list( + size = list(val = "11"), + # should this be "#000000"? + colour = list(rgb = "FF000000"), + name = list(val = "Calibri") + ) + ) + + modifyBaseFont(wb, fontSize = 9, fontName = "Arial", fontColour = "red") + expect_equal( + getBaseFont(wb), + list( + size = list(val = "9"), + colour = list(rgb = "FFFF0000"), + name = list(val = "Arial") + ) + ) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-getCellRefs.R r-cran-openxlsx-4.2.5/tests/testthat/test-getCellRefs.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-getCellRefs.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-getCellRefs.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,24 +1,24 @@ - - -context("Check Cell Ref") - - - -test_that("Provide tests for single getCellRefs", { - expect_equal(getCellRefs(data.frame(1, 2)), "B1") - - - expect_error(getCellRefs(c(1, 2))) - - expect_error(getCellRefs(c(1, "a"))) -}) - - -test_that("Provide tests for multiple getCellRefs", { - expect_equal(getCellRefs(data.frame(1:3, 2:4)), c("B1", "C2", "D3")) - - - - - expect_error(getCellRefs(c(1:2, c("a", "b")))) -}) + + +context("Check Cell Ref") + + + +test_that("Provide tests for single getCellRefs", { + expect_equal(getCellRefs(data.frame(1, 2)), "B1") + + + expect_error(getCellRefs(c(1, 2))) + + expect_error(getCellRefs(c(1, "a"))) +}) + + +test_that("Provide tests for multiple getCellRefs", { + expect_equal(getCellRefs(data.frame(1:3, 2:4)), c("B1", "C2", "D3")) + + + + + expect_error(getCellRefs(c(1:2, c("a", "b")))) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-loading_workbook.R r-cran-openxlsx-4.2.5/tests/testthat/test-loading_workbook.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-loading_workbook.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-loading_workbook.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,935 +1,1044 @@ - - - - -context("Load Workbook Object") - - -test_that("Loading readTest.xlsx Sheet 1", { - fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - wb <- loadWorkbook(fl) - - sheet_data <- wb$worksheets[[2]]$sheet_data - sheet_v <- sheet_data$v - sheet_t <- sheet_data$t - sheet_f <- sheet_data$f - sheet_row <- sheet_data$rows - sheet_col <- sheet_data$cols - - - ## Sheet 2 - expected_row <- c( - 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, - 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, - 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, - 6L, 6L, 6L, 7L, 9L, 10L, 10L, 10L, 11L, 12L, 13L, 13L, 13L, 14L, - 14L, 14L, 14L, 15L, 15L, 16L, 16L, 16L, 16L, 17L, 17L, 17L, 17L, - 18L, 19L, 19L, 20L, 20L, 21L, 22L, 22L, 23L, 23L, 24L, 25L, 25L, - 26L, 26L, 26L, 27L, 27L, 28L, 28L, 28L, 29L, 30L, 31L, 31L, 31L, - 32L, 33L, 33L, 33L, 34L, 35L - ) - - expect_equal(sheet_row, expected_row) - - - - - expected_col <- c( - 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L, 6L, - 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, - 5L, 6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 1L, 2L, 3L, 4L, - 5L, 6L, 7L, 1L, 1L, 1L, 2L, 3L, 3L, 1L, 4L, 5L, 6L, 1L, 5L, 6L, - 8L, 1L, 2L, 2L, 6L, 7L, 8L, 2L, 3L, 5L, 6L, 2L, 2L, 4L, 2L, 3L, - 4L, 5L, 6L, 2L, 5L, 5L, 4L, 6L, 2L, 3L, 7L, 1L, 8L, 2L, 3L, 7L, - 7L, 4L, 5L, 6L, 7L, 8L, 7L, 8L, 9L, 8L, 1L - ) - - expect_equal(sheet_col, expected_col) - - - expected_t <- c( - 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0 - ) - - expect_equal(sheet_t, expected_t) - - - - expected_v <- c( - "0", "1", "2", "3", "4", "5", "6", "7", "8", "1", "2", "3", - "4", "5", "6", "7", "8", "9", "1", "2", "3", "4", "5", "6", "7", - "8", "9", "1", "2", "3", "4", "5", "6", "7", "8", "8", "2", "2", - "3", "4", "4", "5", "6", "1", "1", "2", "2", "2", "3", "3", "1", - "2", "2", "34", "3", "4", "2", "2", "2", "3", "2", "6", "3", - "3", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", - "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", - "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", - "2", "2", "2", "35" - ) - - - expect_equal(sheet_v, expected_v) - - - ## Sheet 3 - expected_col_widths <- structure(c("41.430625", "11.29", "11.0009375", "8.71578125"), - .Names = c("3", "4", "5", "6") - ) - - attr(expected_col_widths, "hidden") <- rep("0", 4) - - expect_equal(wb$colWidths[[3]], expected_col_widths) -}) - - - - - - - - - - - - - - - - - - - - - - - - - -test_that("Loading readTest.xlsx Sheet 1", { - fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - wb <- loadWorkbook(fl) - - sheet_data <- wb$worksheets[[1]]$sheet_data - sheet_v <- sheet_data$v - sheet_t <- sheet_data$t - sheet_f <- sheet_data$f - sheet_row <- sheet_data$rows - sheet_col <- sheet_data$cols - - ## sheet 1 - - expected_row <- c( - 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, - 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 6L, 6L, - 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 8L, 9L, 9L, 9L, 9L, 9L, 10L, - 10L, 10L, 10L, 10L, 11L, 11L, 11L - ) - - expect_equal(sheet_row, expected_row) - - - expected_col <- c( - 1L, 2L, 4L, 5L, 6L, 7L, 8L, 1L, 2L, 4L, 5L, 6L, 7L, 8L, 1L, - 4L, 5L, 6L, 8L, 1L, 2L, 4L, 5L, 6L, 8L, 1L, 2L, 5L, 6L, 1L, 2L, - 4L, 5L, 6L, 1L, 2L, 4L, 5L, 6L, 6L, 1L, 2L, 4L, 5L, 6L, 1L, 2L, - 4L, 5L, 6L, 2L, 4L, 6L - ) - - expect_equal(sheet_col, expected_col) - - - - expected_t <- c( - 1, 1, 1, 1, 1, 1, 1, 2, 0, 0, 1, 0, - 3, 4, 2, 4, 1, 0, 4, 2, 0, 0, 1, 0, - 4, 2, 0, 4, NA, 2, 0, 0, 1, NA, 2, 0, 0, - 1, 0, 0, 2, 0, 0, 1, 0, 2, 0, 0, 1, 0, - 0, 0, 0 - ) - - expect_equal(sheet_t, expected_t) - - - expected_v <- c( - "2096", "2097", "2098", "2099", "2107", "2108", "2109", "1", - "1", "1", "2100", "42042", "3209324 This", "#DIV/0!", "1", "#NUM!", - "2101", "42041", "#N/A", "1", "2", "1.34", "2102", "42040", "#NUM!", - "0", "2", "#NUM!", NA, "0", "3", "1.56", "2103", NA, "0", "1", - "1.7", "2104", "42037", "42036", "0", "2", "23", "2105", "42035", - "0", "3", "67.3", "2106", "42034", "1", "123", "42033" - ) - - - expect_equal(sheet_v, expected_v) - - - expected_f <- c( - NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "\"3209324\" & \" This\"", - "1/0", NA, NA, NA, NA, "#N/A", NA, NA, NA, NA, - NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, - NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA - ) - - - expect_equal(sheet_f, expected_f) - - - ## Column Widths - expected_col_widths <- structure("10.8603125", .Names = "6") - attr(expected_col_widths, "hidden") <- "0" - expect_equal(wb$colWidths[[1]], expected_col_widths) - - - - - - - expected_shared_strings <- structure(c( - "v1", "v2", "v3", - "v4", "v5", "v6", - "v7", "v8", "v9", - "bool", "Date", "value", - "word", "N-Z-P-S-Y", "C-G-D-X-H", - "B-K-A-O-W", "H-P-G-O-K", "F-P-C-L-T", - "A-N-Q-P-V", "Y-E-B-K-O", "V-S-N-T-R", - "F-K-Z-U-S", "O-E-Z-T-G", "Q-X-F-L-N", - "E-D-Y-Z-N", "W-F-L-C-I", "P-S-W-Y-E", - "P-H-N-Q-Z", "S-O-L-W-J", "J-E-F-Q-K", - "D-N-O-P-Z", "H-Z-K-S-U", "B-P-A-Y-R", - "Z-I-X-J-V", "Y-S-I-M-X", "V-A-C-R-O", - "O-V-S-C-Q", "A-K-S-V-W", "B-G-U-S-J", - "Z-E-J-V-T", "P-F-C-N-T", "L-T-Z-D-V", - "K-Q-Y-N-O", "U-S-Z-O-E", "Y-F-Z-C-P", - "P-Y-M-I-K", "D-Y-A-L-T", "W-I-F-A-B", - "I-H-S-W-K", "U-D-J-F-K", "B-K-G-J-V", - "Y-J-E-N-B", "X-L-V-S-U", "A-I-B-S-P", - "U-L-D-O-M", "M-D-V-R-X", "O-Q-K-S-B", - "O-R-X-C-W", "O-F-M-A-X", "J-K-V-E-X", - "W-B-S-O-A", "R-N-D-G-S", "W-J-K-M-R", - "K-I-H-F-M", "U-F-X-P-A", "M-R-C-H-L", - "H-A-E-X-J", "C-B-K-L-S", "V-A-I-S-L", - "B-L-N-J-G", "J-X-A-D-O", "I-S-W-P-U", - "D-R-M-G-C", "M-V-U-D-W", "U-S-A-Z-B", - "T-E-N-F-P", "K-E-S-Z-Y", "D-J-O-T-A", - "F-U-Y-T-R", "Q-U-N-P-J", "D-C-V-A-X", - "S-B-F-E-V", "U-R-P-H-A", "R-C-Z-J-B", - "L-B-M-F-I", "D-Y-B-S-Q", "X-Y-D-W-P", - "Z-L-I-V-R", "Z-W-T-M-B", "Z-U-S-E-G", - "V-I-M-C-O", "E-K-D-R-Z", "Z-F-H-Y-D", - "O-I-X-M-A", "F-K-U-G-T", "I-P-X-J-M", - "F-N-Z-E-C", "F-A-M-X-E", "R-V-C-O-P", - "X-Y-C-V-H", "K-G-T-Y-I", "N-M-E-D-F", - "M-K-N-U-W", "L-K-J-A-B", "S-M-T-D-A", - "W-D-G-F-U", "X-R-Z-F-E", "H-L-N-G-P", - "Z-X-W-M-R", "E-F-G-J-V", "X-I-M-Z-V", - "T-A-O-L-Q", "F-T-X-N-B", "O-G-D-P-A", - "B-K-Z-V-M", "M-J-O-S-X", "O-D-M-S-G", - "W-O-V-A-D", "I-D-W-T-H", "E-C-I-A-L", - "P-I-W-U-T", "Y-P-U-L-C", "Q-N-A-B-E", - "C-F-X-Y-H", "Q-P-G-I-J", "A-Q-J-W-F", - "G-N-R-U-D", "G-L-I-F-V", "Y-R-P-K-X", - "V-W-B-G-S", "E-Q-D-N-F", "E-R-U-D-O", - "O-E-G-X-L", "D-Q-G-A-K", "U-Z-N-C-V", - "O-K-T-W-X", "L-W-G-K-Q", "I-F-O-X-Q", - "J-B-V-W-T", "U-H-I-P-Q", "R-W-M-S-U", - "F-U-M-W-H", "F-A-Q-U-K", "Q-R-D-K-I", - "L-P-K-V-S", "G-I-B-U-Q", "Z-W-L-G-E", - "Q-C-I-B-A", "J-N-Y-W-D", "T-Y-G-W-S", - "L-M-A-G-K", "O-D-S-T-K", "O-G-L-T-Z", - "N-Q-E-B-F", "B-F-W-A-X", "U-G-Q-B-M", - "B-O-V-U-A", "R-K-X-H-A", "B-P-Q-T-R", - "I-P-Z-L-V", "C-T-L-W-D", "L-Q-D-M-U", - "N-P-H-A-G", "F-O-P-G-M", "N-M-Z-W-L", - "G-V-K-Z-T", "F-J-T-C-U", "J-P-R-A-C", - "Z-X-V-C-W", "B-Z-K-I-Q", "E-N-L-I-Y", - "C-D-P-R-B", "I-W-X-P-V", "T-M-P-I-O", - "W-Y-D-J-K", "A-O-C-L-B", "S-R-O-Y-C", - "A-O-Y-N-W", "P-C-O-D-Y", "E-S-A-L-Y", - "E-O-Q-W-C", "U-O-A-X-Q", "W-E-N-Y-D", - "A-W-J-Z-X", "P-L-R-U-K", "V-J-E-K-Z", - "V-A-M-G-D", "N-C-F-M-G", "H-W-N-K-R", - "G-T-A-F-O", "K-F-V-G-S", "N-V-H-G-I", - "F-Y-T-S-G", "A-H-O-C-V", "Q-W-J-S-C", - "W-G-I-X-E", "D-B-V-A-N", "P-N-L-Y-Q", - "O-I-R-Q-U", "D-R-W-E-O", "W-X-U-V-P", - "X-Y-D-A-W", "M-J-B-S-G", "K-R-G-N-Y", - "O-B-K-L-M", "G-N-Y-X-D", "K-F-A-B-T", - "S-Z-R-L-A", "K-Y-W-X-A", "O-Q-X-I-D", - "I-L-R-M-X", "S-D-V-U-N", "B-W-F-A-T", - "A-W-X-R-J", "D-H-G-X-L", "E-C-V-U-T", - "D-W-P-Z-F", "V-O-M-P-R", "P-L-B-X-N", - "Z-U-F-D-V", "M-K-Z-S-Y", "X-P-N-T-D", - "U-Q-D-T-S", "N-I-X-S-O", "S-C-K-F-D", - "N-V-I-R-D", "Z-X-Y-B-P", "U-W-R-D-V", - "G-V-I-N-K", "D-Y-N-T-J", "P-K-F-U-W", - "U-I-P-D-Q", "R-T-Q-N-Z", "Z-R-D-V-O", - "Z-S-F-T-D", "X-K-Z-B-W", "U-F-Z-S-Y", - "X-I-T-Z-K", "A-X-H-N-Z", "R-U-Q-W-J", - "C-H-P-V-Y", "R-O-A-T-E", "L-F-B-X-A", - "Z-X-E-C-G", "R-B-C-Q-W", "A-O-Z-U-B", - "R-W-P-S-H", "R-Y-B-A-W", "K-X-U-I-M", - "O-X-F-P-A", "U-Y-P-D-M", "A-D-K-R-M", - "R-U-D-T-M", "H-Q-Y-K-J", "T-B-H-N-U", - "P-I-V-X-W", "S-H-X-C-U", "I-O-Y-G-W", - "A-U-Z-J-R", "Q-U-H-M-A", "B-W-M-I-C", - "P-X-Z-Y-N", "Y-J-W-N-B", "V-Y-U-S-B", - "K-W-S-Q-M", "I-K-X-H-S", "F-L-M-Q-T", - "S-Z-O-K-L", "O-P-N-G-E", "P-H-R-Q-T", - "M-L-A-D-T", "D-S-X-V-H", "F-C-O-A-B", - "P-I-N-O-H", "H-X-Y-I-C", "S-I-R-P-Q", - "P-M-F-H-Y", "S-R-O-T-Q", "X-H-O-B-R", - "W-P-A-Q-V", "E-L-Q-G-Y", "I-S-T-W-C", - "B-M-R-G-Y", "S-J-A-K-Q", "E-P-B-G-J", - "R-Y-E-L-D", "A-R-C-N-S", "Y-H-B-M-I", - "T-Q-C-K-N", "L-T-Z-V-C", "Q-L-N-J-K", - "T-E-J-M-Y", "E-M-F-R-C", "M-A-Y-D-I", - "G-M-Y-F-Q", "A-X-B-E-N", "F-Y-E-H-L", - "S-Z-R-M-O", "U-V-W-S-I", "D-S-E-L-K", - "B-C-X-V-F", "Q-V-L-F-H", "H-Z-I-J-P", - "W-U-O-M-D", "A-Y-T-O-X", "Y-C-Z-V-D", - "E-L-O-X-Y", "D-U-K-X-A", "S-W-K-N-E", - "D-F-T-E-Y", "J-T-B-C-L", "E-T-Z-V-F", - "Q-D-U-P-E", "M-Q-X-T-J", "A-M-I-K-P", - "J-T-B-E-R", "L-X-J-O-F", "X-B-V-W-P", - "Y-N-H-G-Z", "M-F-K-S-P", "K-B-V-Z-L", - "T-L-Y-G-A", "N-U-X-C-D", "W-B-O-X-Z", - "U-Y-J-F-A", "T-V-J-I-S", "T-L-W-X-Z", - "V-K-X-C-N", "G-C-I-S-Z", "C-T-K-S-Z", - "F-I-D-N-E", "E-C-M-Y-J", "N-C-Y-S-I", - "B-N-I-L-D", "Y-F-T-M-V", "R-A-E-O-M", - "M-G-P-W-X", "H-B-C-D-R", "A-J-N-C-H", - "R-O-F-D-N", "H-E-R-T-K", "M-U-S-V-A", - "L-V-F-A-H", "E-Q-N-Y-C", "T-N-L-X-S", - "C-F-X-A-N", "M-X-Y-C-Z", "A-N-F-B-K", - "J-Q-R-Z-D", "Q-P-Y-G-N", "D-Y-O-R-J", - "K-R-Y-N-O", "A-H-K-J-B", "O-G-J-A-S", - "T-N-K-X-S", "V-P-X-Y-F", "R-P-V-G-T", - "O-B-F-E-D", "Z-P-I-T-F", "T-S-D-X-G", - "Y-J-P-Z-U", "H-W-Y-K-J", "H-Z-C-F-Q", - "D-I-B-N-X", "K-B-U-H-E", "H-Y-U-Q-A", - "N-Q-G-T-I", "J-B-V-E-G", "M-F-O-E-H", - "B-P-K-M-I", "T-Z-B-Q-Y", "X-Y-T-P-O", - "E-K-I-W-C", "C-M-R-S-Y", "F-Y-M-W-L", - "A-S-E-U-J", "I-P-W-N-G", "V-G-R-E-T", - "H-O-W-G-Y", "O-H-B-C-P", "C-Y-D-Q-X", - "X-Y-I-Z-U", "R-I-Q-Y-P", "E-M-L-D-Y", - "B-G-P-Y-T", "Z-H-X-D-V", "S-B-R-J-F", - "O-T-X-P-W", "Y-C-T-M-E", "J-A-D-O-P", - "B-W-Q-D-I", "Y-T-X-K-Q", "F-D-P-X-J", - "Z-G-Y-O-N", "J-N-Z-Q-P", "W-C-E-I-U", - "L-R-K-F-H", "X-I-G-B-O", "M-C-Q-Y-Z", - "S-T-W-J-E", "G-O-N-Y-Q", "O-Q-R-Z-B", - "X-G-E-C-I", "P-B-D-F-Q", "Q-H-D-I-V", - "H-I-J-D-Q", "C-B-S-I-G", "M-A-F-D-B", - "G-Z-R-U-K", "N-U-L-Q-R", "C-A-K-M-T", - "F-S-R-B-K", "O-D-X-S-W", "H-J-N-P-C", - "N-G-Y-L-J", "D-X-K-O-E", "F-E-H-D-L", - "E-M-D-P-Z", "Q-K-I-J-V", "D-O-N-M-X", - "C-P-N-E-K", "L-H-T-U-P", "M-T-Z-P-H", - "B-T-L-Z-G", "Z-V-R-C-I", "J-M-R-D-G", - "I-V-L-Q-T", "O-V-X-A-M", "V-L-N-A-T", - "M-B-R-U-O", "O-B-Q-F-X", "H-O-E-K-G", - "S-H-G-B-D", "N-Z-C-L-D", "M-F-J-H-K", - "A-O-D-W-B", "I-X-G-K-W", "B-S-O-K-Q", - "X-T-Z-I-D", "N-D-G-B-L", "Z-O-U-I-X", - "W-B-A-R-H", "S-G-Q-J-F", "M-B-J-F-A", - "M-B-X-A-P", "F-M-S-Y-V", "T-K-B-G-C", - "H-V-C-G-X", "V-A-S-I-T", "Z-X-G-U-S", - "U-J-Y-M-H", "D-Y-H-X-S", "T-Q-X-I-E", - "S-V-K-M-T", "S-Z-P-O-Y", "V-Y-Q-L-F", - "A-E-R-V-G", "E-C-M-G-O", "T-B-U-M-V", - "M-R-V-A-E", "C-A-R-W-N", "Y-U-D-Z-X", - "Y-G-Z-C-Q", "T-X-R-A-D", "S-A-U-R-K", - "E-A-D-R-V", "P-R-T-W-F", "A-Z-Y-O-N", - "O-P-W-A-I", "H-V-U-R-F", "W-D-G-P-I", - "M-Z-Q-C-I", "Y-S-H-W-I", "F-J-C-N-S", - "H-C-Z-Y-K", "W-J-K-Z-I", "Q-T-G-C-X", - "S-Q-T-O-Y", "Z-G-T-W-X", "X-M-J-R-W", - "S-Y-N-F-H", "C-F-V-G-A", "W-R-J-I-B", - "I-V-B-A-M", "R-C-D-L-U", "S-T-B-A-N", - "F-W-J-M-A", "J-I-R-E-H", "Q-D-O-E-R", - "R-B-M-O-J", "B-X-G-V-U", "R-J-L-Y-M", - "R-F-A-X-J", "N-I-J-V-Q", "J-O-D-Q-Z", - "K-I-F-D-H", "N-H-Q-Z-M", "I-K-R-Z-X", - "O-D-U-T-I", "K-G-S-L-Y", "X-D-O-K-A", - "C-X-I-P-J", "X-A-Y-V-T", "I-V-T-J-O", - "X-D-M-H-U", "M-L-R-Y-J", "N-L-I-R-B", - "A-J-Z-O-Q", "G-Y-I-S-E", "N-F-X-Z-T", - "U-G-C-F-K", "R-N-W-S-M", "A-O-T-N-U", - "W-O-P-G-V", "D-W-E-H-O", "B-D-S-E-Z", - "C-L-V-M-I", "Y-N-C-W-B", "C-Q-L-P-W", - "X-H-L-B-M", "H-V-D-K-Q", "O-S-C-U-H", - "V-I-J-K-A", "D-M-B-I-F", "O-H-N-J-V", - "R-L-Q-J-Y", "Q-P-B-S-X", "J-K-V-H-F", - "A-T-L-Q-B", "E-D-S-B-G", "K-T-X-J-Q", - "W-L-U-B-H", "T-Y-Z-G-V", "G-S-C-X-P", - "D-C-M-Z-Y", "V-G-F-D-E", "Q-F-X-O-U", - "E-V-L-F-G", "M-T-V-U-Y", "Z-X-S-U-E", - "J-I-F-E-R", "C-V-J-R-W", "W-R-V-U-K", - "M-A-S-U-Q", "J-K-O-F-I", "I-Y-G-U-Z", - "B-Y-V-D-R", "M-G-Q-N-J", "A-F-N-K-M", - "R-B-D-Q-P", "H-T-N-U-L", "J-W-E-A-B", - "N-M-K-R-O", "H-Q-A-N-E", "U-B-Y-L-Q", - "J-E-N-T-Q", "D-N-L-R-E", "K-S-O-L-Z", - "Z-D-Y-A-N", "D-Q-B-X-Z", "J-E-F-O-Q", - "U-E-Q-T-R", "U-H-F-N-L", "C-T-I-V-X", - "V-L-Q-O-K", "G-Q-D-P-V", "D-T-V-G-S", - "I-G-H-Z-L", "A-E-I-Y-B", "S-V-N-B-R", - "M-P-J-Y-N", "D-T-W-Q-Z", "U-V-F-A-S", - "M-B-T-Y-Q", "F-I-C-D-X", "G-X-O-K-J", - "J-M-I-E-D", "C-B-S-F-A", "A-Y-O-Z-P", - "R-T-H-L-S", "P-X-B-S-O", "B-I-C-P-T", - "F-K-H-Z-N", "R-D-Y-T-P", "S-U-P-G-R", - "M-K-R-Q-V", "Z-E-O-U-T", "M-W-Y-X-C", - "Q-J-U-T-B", "L-H-S-J-U", "P-M-X-R-N", - "S-Y-T-G-W", "W-P-N-V-O", "E-U-I-L-M", - "V-S-K-J-R", "P-E-T-C-X", "E-V-C-S-Y", - "M-S-F-T-Q", "L-D-P-K-T", "D-Z-U-Q-P", - "D-H-L-W-N", "V-U-Q-I-A", "L-D-G-H-V", - "G-I-U-Q-E", "G-E-D-R-H", "N-T-L-K-H", - "J-U-K-F-V", "G-J-Y-K-W", "E-A-I-G-Q", - "S-U-H-R-T", "L-S-W-H-C", "P-V-I-Y-O", - "E-L-K-X-N", "Y-B-S-T-N", "N-U-V-E-Z", - "B-V-K-M-O", "L-V-H-A-K", "M-U-T-J-K", - "V-J-T-F-R", "T-Y-E-U-W", "C-D-B-A-L", - "K-E-U-S-A", "D-H-R-X-Z", "M-B-Z-G-C", - "P-E-T-S-Y", "M-G-O-J-F", "C-Y-E-P-X", - "R-V-D-C-N", "S-Y-A-K-Z", "K-S-G-T-D", - "D-F-G-U-K", "F-B-P-T-M", "P-G-O-D-W", - "U-L-I-R-J", "F-Q-N-X-J", "D-Q-F-V-B", - "R-P-E-Z-H", "A-H-X-M-L", "I-H-F-G-W", - "V-C-M-H-Y", "V-H-L-Y-F", "H-I-L-P-V", - "L-Q-W-K-A", "D-W-J-R-L", "W-E-V-J-L", - "F-Z-X-U-H", "K-U-Q-I-R", "S-D-N-E-V", - "G-T-E-L-Y", "S-P-E-B-D", "U-N-L-S-O", - "Z-G-W-I-X", "M-C-X-S-E", "P-C-S-X-Y", - "B-Z-K-R-H", "D-J-W-Y-U", "J-O-Q-F-P", - "I-A-V-G-Y", "U-B-V-G-N", "W-H-Q-M-E", - "J-R-O-D-F", "W-M-C-O-P", "R-I-F-M-Q", - "Q-L-D-W-X", "M-A-Q-P-F", "O-J-T-L-A", - "X-S-I-P-G", "G-W-D-Y-F", "T-B-M-N-J", - "Q-W-N-Z-C", "M-F-C-O-H", "Z-N-Q-X-P", - "Q-G-A-Y-C", "R-F-G-P-E", "X-J-F-R-C", - "J-S-Q-E-L", "O-K-P-F-D", "R-J-W-G-T", - "Y-P-J-N-D", "N-S-F-Y-T", "M-L-N-H-U", - "V-A-H-G-Q", "H-L-W-K-P", "U-P-G-V-O", - "V-N-P-I-Y", "A-O-E-F-L", "W-F-Q-J-G", - "B-A-L-V-Q", "Y-J-F-V-S", "O-F-E-J-A", - "X-O-F-M-B", "B-M-L-H-W", "Z-X-F-T-B", - "W-X-E-M-A", "F-J-V-W-L", "P-C-U-R-O", - "S-K-F-D-V", "K-F-Z-Q-C", "J-S-R-M-Q", - "E-H-L-Q-N", "W-F-M-E-X", "P-R-E-N-A", - "D-F-G-N-Y", "I-S-O-V-T", "R-I-C-N-L", - "I-T-C-Y-P", "R-W-I-K-X", "P-B-J-X-G", - "D-W-F-N-E", "M-G-C-B-K", "E-T-H-F-W", - "A-E-L-F-Z", "Z-V-W-S-R", "O-T-L-D-Q", - "S-E-M-Z-O", "N-R-Y-A-U", "Y-D-M-A-R", - "S-M-P-N-K", "C-T-B-L-Z", "X-A-L-I-V", - "B-V-M-G-S", "N-R-K-Q-D", "F-O-L-X-Y", - "Y-T-F-A-S", "X-G-O-U-A", "Z-F-I-B-T", - "V-H-B-N-W", "V-K-B-W-S", "V-C-T-L-G", - "X-N-L-Y-Q", "N-D-L-I-Z", "L-K-G-N-E", - "D-L-M-K-Z", "E-I-P-Z-U", "H-X-B-C-D", - "B-H-D-C-V", "F-O-L-D-R", "B-Z-J-Y-V", - "E-C-R-B-S", "E-X-V-B-S", "P-K-I-W-G", - "A-I-F-V-O", "D-F-R-I-E", "X-L-I-N-O", - "P-Y-Q-C-S", "C-P-A-X-L", "W-O-U-A-X", - "H-M-R-E-B", "K-Y-P-G-A", "O-E-V-D-C", - "Z-A-K-M-W", "S-F-M-Z-E", "X-U-I-C-J", - "C-V-T-B-N", "Z-Q-Y-V-G", "T-W-G-Q-D", - "K-Y-L-R-F", "W-O-S-E-A", "V-T-Q-F-G", - "G-V-J-M-U", "P-R-A-N-C", "I-R-A-F-T", - "X-Z-U-W-N", "A-G-R-D-Y", "J-U-T-A-Q", - "K-Y-T-H-U", "P-Q-L-Z-G", "N-K-Y-X-W", - "A-T-M-R-Z", "M-B-P-C-L", "M-Q-K-N-R", - "I-W-H-G-R", "I-F-D-Q-A", "V-G-F-C-X", - "H-Q-F-D-T", "N-R-T-Q-G", "X-V-P-B-G", - "V-H-B-N-X", "G-Q-T-J-Y", "P-F-A-N-H", - "C-D-I-W-K", "T-R-J-B-P", "E-P-X-L-S", - "O-K-B-L-M", "Z-T-B-R-V", "V-N-Y-Z-U", - "E-W-V-F-O", "D-S-A-Z-J", "R-O-W-A-Y", - "V-L-K-J-Q", "Q-T-J-S-Z", "M-G-L-Y-D", - "G-U-W-I-C", "G-O-D-T-I", "R-L-Z-P-V", - "W-G-M-T-I", "S-F-H-Z-J", "Z-L-O-V-N", - "G-D-A-U-H", "Y-K-V-R-E", "Y-O-L-R-I", - "X-V-Z-I-B", "N-Z-S-D-O", "N-X-Z-J-M", - "S-X-A-H-C", "V-T-R-F-H", "K-E-Q-B-J", - "V-R-J-U-G", "Q-K-B-P-Z", "Y-I-S-X-K", - "U-O-R-Q-J", "Q-T-X-F-D", "P-O-F-B-J", - "C-M-K-L-F", "N-W-Y-A-V", "E-H-I-G-U", - "L-J-X-A-C", "Q-K-U-D-B", "A-S-R-D-T", - "S-Z-E-Y-U", "A-K-R-S-G", "S-F-R-J-Q", - "A-Y-J-F-U", "L-I-J-R-H", "K-C-V-Q-F", - "H-U-A-T-D", "E-W-L-I-C", "Y-P-R-F-V", - "L-M-P-Z-U", "T-Q-U-P-V", "Q-W-T-M-K", - "P-D-G-Y-K", "F-I-K-C-P", "I-T-Y-K-L", - "H-T-K-I-R", "H-K-B-M-F", "J-P-D-Z-Q", - "D-M-K-C-V", "E-K-Y-F-R", "P-L-H-A-J", - "R-C-Z-V-T", "I-W-G-A-T", "Y-N-X-K-R", - "M-N-E-C-Q", "J-B-W-R-X", "R-M-D-T-F", - "R-V-L-Y-G", "M-V-E-Z-Q", "S-H-Q-X-G", - "H-P-Y-Q-G", "F-N-K-T-W", "I-B-Z-P-F", - "G-P-N-S-F", "B-Y-S-N-A", "P-I-Z-A-S", - "X-I-K-B-Y", "B-Q-F-W-M", "Y-E-J-P-M", - "V-E-T-G-O", "M-N-L-K-I", "N-D-W-B-V", - "F-P-S-M-X", "K-H-Q-M-F", "Z-B-O-I-L", - "L-F-D-S-E", "W-Y-P-B-A", "L-P-S-V-U", - "D-G-L-J-P", "K-U-F-Y-E", "J-G-R-M-N", - "J-U-P-H-O", "O-U-N-M-W", "X-V-J-K-E", - "C-W-G-L-K", "D-H-A-O-K", "H-G-C-X-P", - "B-C-I-J-D", "N-L-T-D-S", "X-D-C-A-T", - "Z-D-U-N-E", "P-W-A-I-L", "N-U-G-H-C", - "F-Q-E-V-T", "X-O-M-S-U", "Z-V-S-Q-R", - "K-Z-U-D-L", "A-O-Z-C-T", "S-K-U-T-Q", - "V-Q-I-B-Z", "A-K-Z-N-Y", "T-G-V-Y-O", - "G-K-R-A-J", "Y-J-F-T-U", "E-P-K-G-F", - "U-P-X-L-V", "H-C-S-M-I", "K-D-X-W-N", - "F-E-P-V-R", "C-P-V-W-L", "I-S-M-E-B", - "D-E-L-C-O", "A-D-V-U-W", "D-I-N-M-Z", - "O-Z-K-S-N", "F-J-W-L-S", "H-C-V-W-I", - "B-A-L-V-Y", "N-K-Z-W-X", "Z-C-X-K-A", - "S-X-H-G-Y", "L-G-M-V-Q", "Z-L-G-Y-Q", - "J-W-E-A-D", "G-S-A-M-U", "F-M-D-K-O", - "B-O-G-R-K", "V-S-U-Q-B", "R-X-O-N-F", - "Y-N-M-H-I", "T-J-W-Q-L", "R-W-P-B-H", - "D-A-I-P-E", "D-P-Q-T-N", "Y-K-Q-U-X", - "A-Y-M-C-R", "M-O-I-L-B", "Y-O-K-J-F", - "O-C-J-X-H", "W-J-X-L-Z", "F-P-H-A-L", - "M-T-F-U-P", "W-H-F-C-X", "R-C-D-Z-L", - "Y-B-A-I-L", "S-I-Y-W-P", "K-D-X-G-Z", - "O-W-Q-M-G", "M-T-V-L-G", "F-Z-Y-J-L", - "V-L-A-S-N", "I-P-A-S-N", "G-T-Q-D-F", - "G-R-L-W-V", "I-R-Z-V-P", "M-L-B-A-I", - "D-K-Z-F-M", "M-O-G-X-V", "Y-V-D-Z-W", - "M-S-O-G-T", "Z-F-M-U-X", "V-N-Z-P-I", - "N-D-F-U-J", "G-O-U-E-S", "Z-C-G-W-B", - "O-T-E-N-V", "W-P-H-C-V", "X-R-D-P-G", - "Y-C-E-F-T", "V-O-G-K-I", "S-I-W-M-L", - "M-H-C-O-A", "Q-C-N-Z-D", "A-N-L-S-T", - "X-W-I-L-K", "A-Y-V-S-K", "D-W-F-L-K", - "U-Z-I-R-Q", "V-W-B-A-T", "I-U-R-E-W", - "N-W-U-Q-O", "F-H-L-N-O", "D-I-T-J-H", - "W-K-Q-D-T", "A-O-R-I-U", "M-E-V-A-F", - "U-J-M-X-S", "O-E-R-K-H", "A-V-Z-T-D", - "C-Z-B-D-L", "D-J-T-Q-G", "A-O-C-I-Z", - "J-L-A-Y-C", "P-O-H-E-V", "A-M-Z-I-R", - "W-C-R-H-V", "Z-G-I-V-N", "K-M-W-T-Q", - "O-I-F-D-N", "X-D-A-V-T", "T-S-M-B-D", - "F-C-D-U-Q", "B-H-M-Q-G", "M-K-I-W-B", - "R-M-Q-W-P", "N-Z-L-F-G", "I-P-J-B-W", - "O-Y-W-U-V", "C-V-Z-B-O", "O-Q-S-F-X", - "B-G-F-M-W", "N-X-R-P-S", "L-T-A-H-R", - "G-O-E-L-X", "R-I-U-X-Y", "Q-O-Z-F-V", - "O-P-J-C-M", "D-W-G-S-L", "T-K-W-L-O", - "E-I-O-K-D", "K-E-A-I-S", "M-I-W-F-K", - "S-W-G-T-N", "P-L-J-D-A", "O-M-T-J-P", - "C-R-Z-L-G", "F-S-D-V-K", "N-J-H-V-I", - "D-I-A-F-J", "U-R-T-V-X", "J-N-T-R-S", - "K-V-Z-T-Q", "J-L-C-R-M", "Z-A-R-L-E", - "Y-L-W-I-S", "B-W-E-N-U", "B-S-W-J-F", - "D-G-I-P-S", "D-Q-M-E-R", "K-T-R-A-D", - "P-Q-L-E-U", "U-D-W-A-O", "Q-R-P-D-Y", - "C-X-V-S-I", "F-E-U-I-K", "H-Z-T-L-P", - "P-I-U-B-O", "S-Q-G-W-K", "K-V-S-U-L", - "F-N-Q-O-P", "M-Q-F-C-L", "V-X-G-C-A", - "N-S-E-C-V", "R-K-J-A-X", "D-L-H-W-S", - "Z-C-Y-L-G", "M-D-W-F-U", "R-A-U-S-F", - "Y-W-H-V-Q", "B-K-G-J-W", "B-V-H-E-C", - "D-J-X-S-H", "W-C-H-Z-Q", "X-B-A-I-U", - "D-A-J-C-F", "B-P-U-S-W", "A-D-R-Z-K", - "S-H-P-A-Z", "J-O-U-P-S", "W-C-H-P-T", - "C-U-Z-O-W", "P-E-H-M-S", "B-W-L-Y-N", - "N-S-F-R-Y", "W-R-K-A-N", "G-X-V-D-E", - "I-G-D-P-T", "W-N-J-R-L", "P-Q-H-A-V", - "U-Q-R-P-W", "I-H-Q-X-U", "W-K-R-M-N", - "U-H-Q-B-Y", "X-P-D-V-W", "E-K-F-R-C", - "T-E-B-N-L", "I-S-K-Q-H", "Y-Z-V-Q-L", - "W-L-U-P-I", "Y-P-F-H-O", "M-C-Y-T-I", - "Q-A-V-Z-O", "I-H-U-K-F", "Q-Z-C-W-Y", - "U-M-Q-C-R", "U-H-S-M-W", "R-C-M-Y-G", - "R-C-J-A-V", "X-B-Z-C-Y", "P-C-O-J-I", - "E-C-O-W-R", "E-T-Y-X-F", "Q-M-C-K-S", - "H-I-O-J-K", "R-P-N-J-V", "H-Y-P-N-V", - "R-J-I-L-S", "N-K-T-Z-O", "H-B-K-A-P", - "P-G-J-A-B", "L-S-O-I-Y", "L-U-R-Z-D", - "F-I-K-Q-B", "Q-K-X-B-M", "A-C-L-B-I", - "J-E-O-D-K", "Y-W-V-G-D", "S-N-T-H-Q", - "K-M-D-R-H", "B-U-N-A-T", "A-J-F-O-C", - "J-L-V-R-D", "X-A-Q-J-R", "I-V-E-W-Z", - "Q-G-K-P-X", "O-H-K-J-D", "N-K-I-J-B", - "Y-R-N-G-C", "K-L-E-B-S", "O-P-T-D-G", - "O-R-E-J-V", "X-V-B-Z-U", "Y-H-I-O-C", - "B-O-Y-M-P", "J-Z-R-Q-P", "A-E-K-M-D", - "D-X-L-F-U", "J-X-U-A-Z", "Y-R-G-X-Q", - "Y-R-P-W-C", "K-Q-C-Y-L", "K-H-L-V-U", - "P-A-N-I-C", "M-D-Y-F-A", "H-V-D-F-U", - "Z-D-P-U-J", "O-E-I-Z-Q", "L-Q-A-O-I", - "L-V-C-K-N", "E-Z-R-Q-K", "N-T-V-U-D", - "U-B-O-H-Z", "F-X-D-H-U", "T-W-R-O-G", - "G-A-O-Z-L", "Z-C-B-G-P", "O-I-B-S-N", - "Z-R-I-O-Y", "K-B-L-C-Z", "Z-B-T-F-D", - "B-H-P-J-C", "A-T-L-N-M", "O-P-W-M-S", - "Q-I-L-G-J", "O-D-Q-J-M", "P-B-F-Z-V", - "Q-H-J-I-C", "K-V-W-Z-D", "Y-A-R-Z-Q", - "M-U-H-Q-N", "O-D-K-J-Z", "I-C-Z-J-H", - "E-K-R-G-M", "D-B-G-Y-K", "U-Q-B-C-L", - "Y-Q-M-W-L", "A-Z-J-B-S", "C-W-K-O-X", - "G-E-V-B-R", "L-N-Q-T-H", "H-E-X-A-J", - "U-O-Z-S-B", "P-G-W-K-D", "J-W-L-C-A", - "L-C-E-V-Z", "T-K-Y-Q-P", "Z-J-Q-U-V", - "V-C-P-K-X", "U-X-A-H-E", "I-J-E-Z-W", - "O-M-W-F-S", "N-K-Y-P-M", "C-G-K-L-R", - "M-T-V-A-E", "D-V-H-Q-F", "M-N-P-W-L", - "G-E-F-T-M", "G-X-D-Q-O", "X-G-W-E-Z", - "U-C-B-P-Z", "F-K-Z-W-H", "P-C-D-F-L", - "N-V-G-R-T", "I-N-B-J-T", "B-T-A-M-L", - "Q-D-N-Y-I", "B-I-K-X-A", "C-U-F-S-K", - "W-X-G-P-L", "H-A-P-L-C", "W-T-K-P-F", - "G-B-U-T-K", "U-S-Q-Y-Z", "G-C-E-Z-W", - "Z-Y-Q-B-M", "D-Y-N-C-E", "E-J-Q-K-I", - "P-R-O-B-V", "D-E-A-S-U", "I-A-M-E-L", - "M-K-U-F-Y", "L-Q-H-S-O", "Z-F-V-T-P", - "V-N-M-R-J", "Q-E-P-K-O", "O-H-J-U-K", - "U-Z-Q-O-F", "R-X-K-O-C", "L-R-K-C-G", - "V-F-B-S-K", "L-Z-O-H-E", "D-S-Y-V-K", - "R-J-V-A-C", "P-L-B-Q-Z", "U-Q-Z-X-Y", - "E-P-L-F-T", "Z-F-C-G-B", "W-V-C-A-J", - "O-N-C-Y-H", "B-Y-C-D-Z", "E-X-G-H-Z", - "Y-H-X-J-I", "O-K-P-J-D", "G-E-K-T-B", - "G-A-K-Y-P", "T-V-X-P-H", "W-Y-D-K-V", - "Z-W-B-P-Q", "A-J-F-U-P", "V-A-X-E-Z", - "F-T-J-E-I", "V-M-L-Z-U", "H-I-B-L-Q", - "C-D-V-K-M", "G-Z-F-J-R", "C-T-N-U-H", - "W-Y-U-X-M", "T-F-I-W-V", "X-O-P-Y-W", - "L-Z-P-B-K", "A-E-T-Q-K", "K-P-C-T-Z", - "C-A-H-G-E", "B-W-G-D-V", "A-S-D-B-I", - "T-D-G-C-P", "J-B-F-T-K", "V-R-L-U-F", - "O-P-Q-X-M", "K-M-T-E-D", "R-B-H-X-G", - "L-C-O-Y-B", "R-Z-U-E-I", "K-I-W-O-G", - "Z-X-W-F-K", "Y-C-B-S-V", "L-M-R-N-Z", - "B-Q-M-Z-K", "P-S-Z-O-T", "Y-A-Z-N-R", - "L-O-A-P-J", "O-Z-Y-M-P", "C-P-S-J-Q", - "Y-F-Q-A-R", "U-Z-K-B-X", "Q-R-T-H-X", - "N-U-E-Q-A", "X-Z-R-J-C", "U-X-E-A-Z", - "Y-M-O-A-V", "N-K-D-W-M", "V-Q-E-F-S", - "L-U-A-Z-D", "X-S-R-P-E", "I-B-O-Z-L", - "J-G-K-H-Z", "T-P-O-Z-S", "L-I-R-G-N", - "Y-C-O-Z-A", "H-B-D-Q-R", "C-L-J-E-T", - "K-Z-N-U-X", "P-F-S-Z-H", "S-N-D-R-T", - "V-R-S-T-G", "N-S-F-U-Y", "D-P-L-C-A", - "B-X-V-M-S", "B-M-Z-E-Q", "K-Y-S-P-B", - "K-T-V-F-G", "U-Z-B-W-E", "J-X-O-C-Y", - "X-C-Q-P-D", "X-L-Y-J-Z", "Y-F-O-N-H", - "M-J-B-Z-X", "G-X-R-A-D", "E-I-L-O-A", - "B-R-C-I-K", "K-W-F-N-P", "C-Y-R-A-H", - "J-H-D-N-C", "P-Y-C-I-D", "P-D-C-U-E", - "H-A-I-E-P", "B-N-E-H-S", "C-Y-P-E-F", - "K-F-X-B-S", "M-Q-D-I-Z", "V-S-P-K-O", - "L-W-M-T-I", "K-N-B-V-D", "A-Z-N-X-G", - "U-T-D-A-Y", "Q-Z-D-F-E", "J-Q-I-Y-C", - "G-L-E-O-R", "V-J-Z-K-F", "O-W-F-X-H", - "H-R-P-X-L", "B-F-X-G-P", "I-C-A-M-R", - "P-N-W-Z-L", "R-G-O-H-D", "G-M-B-W-K", - "G-D-E-H-P", "Z-K-I-P-N", "K-V-C-E-W", - "O-K-N-T-R", "K-B-N-X-M", "E-V-A-X-P", - "Q-J-I-Y-C", "I-T-U-J-D", "W-U-T-O-Q", - "O-E-H-J-A", "D-K-P-A-I", "D-J-A-F-X", - "T-X-D-V-A", "B-W-T-H-V", "H-G-Q-E-U", - "B-U-F-Z-Y", "O-S-R-T-D", "F-W-S-I-G", - "Z-O-X-C-S", "H-V-K-N-E", "Z-M-L-E-O", - "Q-V-T-M-P", "T-N-D-C-S", "L-F-Q-R-Y", - "U-F-S-I-O", "S-R-M-B-K", "D-P-W-U-A", - "Y-W-A-T-E", "I-W-A-F-J", "V-J-G-A-Q", - "Z-S-C-Y-L", "T-C-N-O-S", "J-R-Y-X-Q", - "A-F-P-N-J", "R-Y-N-H-M", "S-W-Q-B-V", - "N-Q-U-G-K", "T-A-Y-R-Z", "I-L-O-U-V", - "W-B-L-F-Q", "N-T-E-W-G", "L-S-I-W-X", - "P-A-Z-J-U", "Z-N-F-X-G", "P-B-O-E-N", - "D-U-T-C-K", "G-Y-I-K-S", "F-H-W-X-P", - "O-B-T-E-Z", "N-K-T-S-X", "E-S-T-N-V", - "E-A-J-Q-F", "P-Q-D-X-B", "R-F-J-E-Q", - "X-Z-S-M-V", "E-Z-Q-D-X", "M-O-T-U-D", - "O-I-X-Z-H", "H-T-V-I-M", "U-E-A-D-W", - "Z-D-F-A-X", "E-D-V-P-N", "K-J-R-M-H", - "V-A-K-U-D", "S-B-L-A-N", "Q-C-Z-D-P", - "U-Z-A-W-C", "V-D-M-G-B", "Z-H-A-I-X", - "W-F-H-R-X", "G-E-V-F-K", "H-A-V-L-E", - "K-P-E-X-Y", "T-O-Y-R-P", "H-T-F-U-K", - "R-V-N-C-X", "K-H-Z-R-A", "Q-P-J-G-N", - "T-F-L-K-E", "E-T-O-D-G", "J-K-E-S-N", - "K-Q-D-C-B", "Q-R-A-F-D", "J-W-A-Q-I", - "N-T-F-G-D", "E-R-I-D-N", "M-G-P-Q-V", - "D-P-R-G-N", "N-C-F-T-A", "D-F-Q-X-O", - "U-D-K-Q-X", "N-G-M-Q-A", "I-X-F-D-V", - "R-T-C-K-I", "S-G-E-R-O", "R-B-J-G-Z", - "J-X-G-K-R", "U-K-O-L-C", "X-Q-U-S-B", - "B-A-M-V-N", "N-A-V-G-U", "I-Y-U-Z-C", - "Y-R-I-M-V", "Y-I-R-P-N", "E-C-Q-A-P", - "P-Z-B-O-A", "D-A-R-F-Y", "Q-E-T-L-N", - "Z-D-F-Q-C", "X-T-Q-W-D", "D-P-Y-U-J", - "S-J-Q-X-V", "E-O-P-W-N", "W-Q-B-O-Y", - "Y-Z-W-Q-F", "H-Q-C-X-O", "S-B-W-V-L", - "G-R-Y-V-J", "W-F-G-K-S", "F-N-P-D-S", - "L-C-Q-T-Z", "V-S-Y-O-B", "L-F-X-U-Q", - "G-D-R-M-E", "P-Q-R-Y-G", "N-E-H-L-P", - "Z-R-F-M-U", "I-X-C-F-O", "L-E-X-K-O", - "G-V-Y-X-F", "O-P-V-A-Z", "P-K-S-L-Y", - "Q-R-K-M-D", "A-N-B-J-R", "C-S-G-R-M", - "H-C-E-O-D", "E-I-N-F-O", "F-S-P-O-B", - "T-S-A-X-B", "R-K-Y-L-M", "F-G-O-C-T", - "C-F-H-Y-Z", "M-P-Z-A-V", "N-U-X-B-T", - "Q-A-V-N-P", "D-R-V-C-K", "U-P-X-M-F", - "S-P-I-T-Z", "O-Z-C-U-Y", "B-G-X-A-D", - "Y-U-L-A-W", "O-J-Q-W-G", "V-B-I-F-D", - "V-J-Q-K-A", "H-X-W-S-A", "E-D-F-T-I", - "H-Q-V-R-L", "M-U-Z-K-Q", "V-Y-U-Q-X", - "H-M-I-U-O", "N-Q-P-U-R", "Y-F-I-V-D", - "F-A-L-W-M", "G-Q-M-L-B", "X-B-L-P-W", - "I-A-R-Q-F", "U-E-J-T-V", "O-B-Q-U-S", - "B-P-U-S-M", "N-Z-D-O-V", "A-X-S-T-V", - "O-Y-C-F-K", "D-S-I-M-Y", "B-Y-N-G-I", - "G-P-U-M-F", "V-B-G-N-W", "C-K-I-S-Y", - "U-B-I-R-V", "L-R-M-C-Z", "T-Z-D-U-M", - "R-M-F-T-O", "S-V-D-F-Y", "M-F-R-C-J", - "G-P-O-X-W", "M-R-X-H-Z", "N-D-J-R-Y", - "B-J-W-U-L", "T-E-U-D-J", "M-V-J-R-B", - "G-X-Z-U-Y", "L-C-P-M-D", "H-Z-W-E-T", - "O-H-Y-C-K", "M-B-Q-N-E", "B-D-E-U-V", - "V-P-F-Y-R", "U-M-C-J-L", "P-X-L-Z-A", - "D-E-F-X-H", "P-I-Z-C-V", "V-N-O-B-G", - "M-T-U-D-P", "I-A-E-O-Q", "V-R-S-L-A", - "S-I-Q-N-T", "A-W-T-O-U", "O-T-V-A-Q", - "D-R-O-Z-F", "Z-M-F-Q-I", "B-H-E-L-M", - "Z-S-D-L-G", "E-B-N-A-Q", "K-Z-O-C-D", - "Y-J-M-C-Z", "K-O-F-A-G", "J-U-L-Y-G", - "A-F-C-V-D", "S-B-H-T-U", "J-F-V-T-Q", - "H-L-Z-K-M", "F-Q-O-K-S", "P-S-U-V-A", - "Y-L-E-D-F", "Z-L-U-K-V", "J-N-M-P-F", - "G-M-F-Y-Z", "W-P-N-D-U", "J-V-Q-H-P", - "Q-B-H-O-R", "U-R-J-K-W", "J-Q-S-O-F", - "S-J-N-T-O", "A-S-B-Q-W", "W-X-Q-H-I", - "K-R-V-S-X", "Q-S-O-R-W", "R-Q-N-G-Z", - "Z-P-A-S-R", "F-N-X-K-D", "S-I-X-A-W", - "K-E-J-H-G", "D-N-Z-W-U", "X-Y-T-J-O", - "X-I-J-Z-S", "R-V-L-W-C", "X-T-A-M-I", - "A-W-B-K-M", "E-C-Q-T-X", "A-B-V-W-X", - "K-O-B-W-Q", "V-Y-F-P-C", "H-O-E-X-D", - "I-Y-A-H-Q", "J-U-N-D-F", "O-V-N-P-Y", - "X-R-O-C-J", "W-I-D-R-M", "Q-C-O-H-N", - "L-Z-Y-W-T", "L-H-J-U-I", "X-M-E-R-U", - "R-J-K-Z-E", "Q-A-I-P-R", "A-D-L-Q-M", - "F-E-M-B-Z", "S-J-N-H-P", "I-Y-C-L-F", - "W-Y-O-N-I", "S-E-N-B-H", "K-Z-E-U-V", - "D-N-Y-Z-O", "Q-S-B-J-P", "J-N-V-T-B", - "U-H-Q-L-S", "U-C-N-Q-L", "A-L-R-Q-F", - "J-Y-K-P-L", "W-S-O-M-U", "L-P-S-U-T", - "U-V-P-F-M", "C-J-W-Q-N", "A-V-C-P-L", - "P-V-N-Y-E", "A-S-M-K-G", "T-U-I-W-H", - "E-K-G-P-M", "Z-F-O-H-E", "C-G-I-X-R", - "R-F-D-O-X", "C-R-F-M-Q", "H-F-M-N-W", - "M-Y-F-I-X", "A-B-U-X-S", "C-F-G-R-D", - "M-A-G-L-C", "W-L-Y-F-U", "U-M-C-R-H", - "A-C-P-Y-K", "A-E-V-C-P", "M-C-A-J-B", - "M-O-Z-G-A", "T-R-E-Y-M", "F-K-E-S-C", - "F-Q-B-J-T", "R-Y-D-V-B", "J-M-C-R-W", - "L-S-E-Z-R", "J-A-E-P-N", "Y-S-K-B-O", - "S-Y-N-G-C", "B-Q-I-W-H", "W-T-U-J-Y", - "O-J-W-G-C", "Q-B-G-I-F", "W-E-B-T-N", - "M-A-U-R-G", "Q-R-O-X-P", "H-T-Y-N-P", - "L-Q-A-G-X", "U-S-D-R-C", "I-J-F-R-Q", - "K-T-G-C-E", "M-K-P-C-T", "W-Z-L-N-K", - "B-O-G-U-P", "C-F-V-D-P", "G-A-P-R-X", - "E-I-Y-K-F", "W-H-G-P-S", "G-J-W-M-B", - "R-Y-B-F-L", "T-F-Y-Q-I", "R-L-O-C-F", - "I-X-S-G-O", "F-R-M-A-X", "H-B-L-Z-A", - "A-L-M-N-C", "F-D-Q-X-L", "Y-K-S-Q-D", - "I-Z-B-O-D", "R-M-A-S-C", "J-S-U-H-T", - "Q-B-A-P-Z", "I-D-X-Q-O", "F-H-S-W-Z", - "P-V-K-R-G", "L-B-A-H-I", "I-P-T-O-Q", - "N-F-K-Y-V", "T-U-M-A-G", "S-N-X-W-F", - "I-V-Y-O-C", "M-T-Z-G-O", "R-V-B-J-I", - "O-X-N-R-V", "W-N-M-F-J", "I-L-R-D-B", - "E-G-F-V-Z", "A-P-S-L-Y", "U-A-X-G-O", - "Y-D-B-O-M", "T-Q-K-M-D", "L-K-D-X-G", - "V-Z-J-A-C", "T-N-I-W-H", "Z-C-S-R-E", - "X-P-C-S-J", "O-A-F-C-R", "P-Z-X-W-E", - "N-L-Q-W-Z", "M-J-W-D-T", "R-S-Q-G-O", - "Z-C-Q-Y-S", "S-J-Y-R-V", "B-H-M-G-A", - "Y-K-D-O-N", "Y-F-G-W-J", "I-G-T-C-V", - "U-D-T-B-F", "N-Q-X-R-V", "F-O-N-L-V", - "R-C-X-F-I", "C-G-H-U-X", "T-I-J-W-G", - "U-B-G-O-Y", "G-C-H-Q-V", "S-U-D-A-H", - "F-B-S-I-H", "X-R-S-O-B", "M-H-C-E-K", - "Y-J-A-T-N", "Z-B-I-D-X", "R-I-U-E-B", - "C-S-O-V-X", "S-Y-G-E-M", "N-O-D-H-Z", - "U-D-V-T-S", "U-I-H-Q-M", "L-E-S-U-Y", - "L-Q-Y-W-P", "J-K-U-C-V", "A-Z-R-S-N", - "Z-F-A-Y-L", "C-L-G-R-I", "A-N-Q-C-Z", - "A-X-P-R-Z", "W-N-I-M-X", "O-I-L-B-N", - "P-U-Q-S-Y", "N-M-W-L-D", "D-V-X-C-R", - "P-G-J-I-X", "Y-G-C-T-H", "R-S-V-N-X", - "Y-H-O-Q-D", "Q-N-Y-Z-H", "D-Q-J-B-H", - "N-X-O-Z-T", "R-Q-B-X-J", "V-S-U-E-K", - "H-X-U-C-K", "W-X-E-I-P", "Z-H-J-N-L", - "A-R-N-V-H", "R-W-L-O-N", "Q-Z-K-E-G", - "M-X-L-W-F", "Z-R-L-K-J", "S-E-G-Y-N", - "R-H-K-V-L", "A-V-Q-R-I", "Z-L-J-B-O", - "W-S-R-C-V", "S-L-Q-M-R", "T-P-Y-A-K", - "W-R-H-U-O", "Z-B-Q-P-J", "I-H-Q-Y-U", - "W-K-U-I-S", "V-Y-N-M-W", "O-C-P-J-V", - "M-S-Z-W-G", "T-M-E-X-F", "E-W-A-P-N", - "Z-S-N-B-K", "G-D-X-R-V", "O-D-J-X-I", - "F-V-G-U-L", "R-U-I-Z-M", "G-E-O-L-I", - "K-T-B-F-X", "I-M-R-C-T", "B-Q-M-F-C", - "E-J-F-W-B", "W-P-N-H-G", "E-F-G-O-J", - "P-C-O-S-H", "C-L-A-N-W", "J-N-B-F-K", - "S-X-A-E-Z", "G-B-F-T-P", "K-C-G-D-E", - "T-I-O-G-U", "B-R-W-Q-Z", "L-C-R-G-N", - "F-A-B-V-G", "R-E-Q-W-L", "L-Z-J-H-S", - "E-R-L-D-N", "N-D-A-O-F", "V-O-A-C-L", - "A-J-S-M-W", "K-B-V-T-O", "J-D-P-K-L", - "J-Y-T-D-X", "Z-A-E-K-B", "L-D-R-Z-Q", - "O-X-L-B-G", "B-P-V-O-K", "Y-J-D-T-E", - "C-F-R-N-W", "U-Y-M-Q-E", "Y-O-V-X-H", - "Z-K-D-V-Q", "A-Q-B-P-S", "W-S-O-Z-B", - "W-D-U-F-S", "A-H-P-R-E", "W-N-V-J-K", - "D-F-U-Y-S", "O-A-G-P-V", "V-J-R-E-P", - "I-P-R-E-U", "F-T-C-O-G", "K-F-U-M-H", - "V-N-F-X-U", "E-R-C-H-B", "D-U-C-V-X", - "Q-Z-U-C-A", "B-G-I-O-T", "L-C-S-Z-M", - "S-Y-A-W-P", "K-M-D-G-N", "O-I-D-R-Q", - "D-P-J-Q-C", "T-N-I-B-L", "I-G-M-D-A", - "O-D-C-L-Y", "B-D-Q-H-F", "H-M-W-P-X", - "Z-Q-U-T-L", "K-F-I-O-R", "U-W-L-M-V", - "M-A-N-D-Y", "M-E-X-I-K", "Y-S-F-L-V", - "Q-Y-O-L-E", "T-K-G-A-O", "I-S-J-V-Q", - "J-K-P-B-G", "D-P-F-I-T", "I-Q-B-J-M", - "E-Q-H-V-W", "J-D-C-E-Q", "Q-U-V-D-J", - "G-D-S-Z-T", "U-M-X-Z-C", "Q-R-Z-G-W", - "R-C-L-Q-J", "E-I-O-V-W", "S-E-R-D-Q", - "V-J-E-D-T", "K-A-D-N-T", "P-C-R-Z-X", - "P-B-I-T-E", "H-W-Q-L-C", "C-J-K-E-G", - "R-Y-D-P-Q", "R-X-U-L-K", "R-T-Q-G-Y", - "X-H-J-T-D", "U-E-F-I-A", "L-K-O-C-M", - "K-Y-H-M-J", "T-M-K-L-Y", "B-D-U-L-P", - "D-G-N-F-H", "H-K-O-J-B", "L-A-C-X-D", - "L-D-P-Q-J", "A-F-T-U-R", "M-W-H-Q-V", - "T-F-J-S-G", "C-T-W-E-N", "K-U-F-A-D", - "S-U-Q-T-P", "K-V-Y-B-T", "E-V-Y-O-S", - "D-J-E-I-C", "Y-P-M-X-O", "Q-X-W-K-S", - "G-W-O-B-C", "A-V-G-B-D", "I-L-V-D-K", - "R-V-G-B-W", "Z-S-O-M-G", "B-A-C-X-W", - "S-P-X-G-Q", "A-I-S-C-B", "Q-N-S-J-P", - "E-T-W-J-B", "R-X-Y-T-E", "X-G-Z-V-S", - "C-M-B-A-N", "N-L-W-B-I", "R-H-E-F-X", - "E-U-I-Z-C", "N-F-E-Z-V", "T-S-O-J-F", - "R-U-B-S-K", "R-A-S-K-G", "O-F-K-R-V", - "N-X-J-A-M", "E-A-Z-T-X", "H-G-S-J-M", - "H-E-A-J-U", "N-Z-M-Q-O", "B-M-R-E-S", - "X-Y-Z-E-U", "W-I-H-R-J", "N-W-M-Y-Q", - "I-N-O-T-P", "C-N-T-H-W", "O-C-M-H-L", - "V-U-X-N-Q", "M-B-W-A-N", "H-Q-Z-B-L", - "H-E-C-O-Y", "A-D-W-F-Y", "C-G-L-M-O", - "A-D-U-O-C", "U-O-V-R-H", "Z-B-Y-G-L", - "L-X-C-E-P", "L-P-K-M-R", "A-F-T-M-B", - "E-Z-B-K-U", "D-F-E-A-Y", "J-A-R-M-O", - "T-N-I-U-X", "F-Q-B-D-J", "N-J-M-R-Z", - "Z-G-C-A-K", "U-G-V-X-H", "D-I-R-Z-W", - "E-O-M-R-T", "L-G-S-F-M", "A-J-C-K-N", - "Z-N-D-L-H", "X-Y-S-U-V", "B-Q-I-L-Y", - "J-C-D-Z-E", "S-U-K-T-G", "P-W-T-X-U", - "D-I-H-B-A", "Y-W-L-U-E", "F-O-A-S-V", - "B-H-R-Z-J", "B-V-C-Y-L", "Z-C-J-F-H", - "Z-Y-V-A-T", "R-F-D-E-Y", "J-O-L-A-M", - "L-B-Z-F-P", "X-P-S-D-R", "O-E-B-R-S", - "J-P-B-Q-X", "Q-E-Z-I-U", "Q-N-G-U-P", - "W-O-L-I-T", "D-O-B-K-Z", "Z-E-A-V-J", - "K-D-E-W-A", "Y-B-M-C-Z", "B-N-Y-J-O", - "L-U-F-E-J", "B-V-X-O-F", "V-X-S-A-P", - "L-B-Y-D-E", "E-U-D-V-T", "J-P-T-D-A", - "Q-C-R-X-V", "I-D-L-A-O", "R-G-Q-V-K", - "H-S-W-R-F", "C-E-F-Y-O", "S-P-B-Q-M", - "B-J-Z-F-Q", "U-E-C-P-Z", "D-H-O-E-B", - "G-J-L-R-S", "L-C-V-T-S", "R-V-W-K-I", - "A-M-X-W-P", "W-B-K-A-C", "P-O-I-L-S", - "A-K-T-B-Y", "K-B-X-R-T", "S-P-T-Q-W", - "D-Z-U-W-B", "L-S-E-H-Q", "G-F-W-U-N", - "J-T-E-Z-F", "V-X-N-T-B", "T-K-D-N-R", - "L-K-Q-I-T", "N-E-X-D-Q", "Y-B-S-X-A", - "S-D-W-J-Q", "U-H-J-W-I", "X-Z-A-J-B", - "E-S-D-O-H", "G-O-Y-N-Q", "U-F-I-B-A", - "M-H-W-C-O", "F-Z-C-B-M", "S-C-A-O-V", - "G-R-H-Q-U", "V-N-J-Q-P", "V-P-Y-M-U", - "R-J-O-Q-V", "G-C-U-E-I", "C-A-T-L-R", - "O-N-S-G-H", "P-Z-K-U-V", "R-Z-H-D-N", - "G-E-X-C-L", "Q-K-E-P-S", "N-K-I-H-A", - "A-N-T-R-M", "T-R-G-E-F", "I-B-T-S-D", - "G-R-J-L-W", "I-P-Y-K-L", "S-J-M-F-W", - "U-H-D-P-T", "A-D-H-M-B", "S-T-Z-P-U", - "N-I-G-R-S", "U-V-M-Q-S", "E-F-S-J-R", - "F-H-O-S-Z", "O-G-R-E-Z", "B-M-A-N-T", - "Z-H-D-L-Q", "Q-R-N-J-K", "C-X-H-Y-L", - "I-X-W-G-E", "T-B-M-Q-S", "A-H-Z-V-B", - "R-Z-M-X-G", "M-U-K-H-E", "G-B-L-A-W", - "R-X-T-S-F", "D-W-Q-M-S", "P-B-F-Q-K", - "R-H-I-J-V", "I-F-J-V-C", "U-T-K-R-F", - "P-T-L-U-R", "I-L-P-N-F", "D-H-K-X-J", - "A-Q-B-M-S", "B-V-L-Q-F", "C-H-K-V-A", - "T-Y-C-P-U", "B-U-P-Q-H", "M-H-Q-E-I", - "E-Z-S-U-K", "H-W-Q-R-M", "C-I-B-J-K", - "E-I-O-S-H", "Y-I-E-X-L", "S-Q-O-L-N", - "J-H-L-T-G", "H-M-Q-J-I", "V-I-Z-J-Q", - "B-G-R-J-P", "Z-I-W-B-O", "R-V-B-G-N", - "B-I-N-J-R", "F-T-W-M-L", "F-S-K-I-J", - "S-N-V-G-Z", "X-I-G-L-H", "K-B-X-V-A", - "F-M-A-H-N", "Y-Z-I-W-A", "P-M-R-C-Z", - "N-U-B-R-A", "wordZ2", "Var1", - "Var2", "Var3", "Var4", - "a", "b", "c", - "e", "f", "h", - "i", "Var5", "Var6", - "Var7", "col 1", "col 2", "g", "x" - ), uniqueCount = 2114L) - - - expect_equal(expected_shared_strings, wb$sharedStrings) -}) - -test_that("Loading multiple pivot tables: loadPivotTables.xlsx works",{ - ## loadPivotTables.xlsx is a file with 3 pivot tables and 2 of them have the same reference data (pivotCacheDefinition) - fl <- system.file("extdata", "loadPivotTables.xlsx", package = "openxlsx") - wb <- loadWorkbook(fl) - - # Check that wb is correctly loaded - sheet_names <- c("iris", - "iris_pivot", - "penguins", - "penguins_pivot1", - "penguins_pivot2") - - expect_equal(wb$sheet_names, sheet_names) - - # Check number of 'pivotTables' - expect_equal(length(wb$pivotTables), - 3) - # Check number of 'pivotCacheDefinition' - expect_equal(length(wb$pivotDefinitions), - 2) -}) - -test_that("Load and saving a file with Threaded Comments works", { - ## loadThreadComment.xlsx is a simple xlsx file that uses Threaded Comment. - fl <- system.file("extdata", "loadThreadComment.xlsx", package = "openxlsx") - wb <- loadWorkbook(fl) - # Check that wb can be saved without error - expect_silent(saveWorkbook(wb, file = temp_xlsx())) - -}) + + + + +context("Load Workbook Object") + + +test_that("Loading readTest.xlsx Sheet 1", { + fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + + sheet_data <- wb$worksheets[[2]]$sheet_data + sheet_v <- sheet_data$v + sheet_t <- sheet_data$t + sheet_f <- sheet_data$f + sheet_row <- sheet_data$rows + sheet_col <- sheet_data$cols + + + ## Sheet 2 + expected_row <- c( + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, + 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, + 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, + 6L, 6L, 6L, 7L, 9L, 10L, 10L, 10L, 11L, 12L, 13L, 13L, 13L, 14L, + 14L, 14L, 14L, 15L, 15L, 16L, 16L, 16L, 16L, 17L, 17L, 17L, 17L, + 18L, 19L, 19L, 20L, 20L, 21L, 22L, 22L, 23L, 23L, 24L, 25L, 25L, + 26L, 26L, 26L, 27L, 27L, 28L, 28L, 28L, 29L, 30L, 31L, 31L, 31L, + 32L, 33L, 33L, 33L, 34L, 35L + ) + + expect_equal(sheet_row, expected_row) + + + + + expected_col <- c( + 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L, 6L, + 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, + 5L, 6L, 7L, 8L, 9L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 1L, 2L, 3L, 4L, + 5L, 6L, 7L, 1L, 1L, 1L, 2L, 3L, 3L, 1L, 4L, 5L, 6L, 1L, 5L, 6L, + 8L, 1L, 2L, 2L, 6L, 7L, 8L, 2L, 3L, 5L, 6L, 2L, 2L, 4L, 2L, 3L, + 4L, 5L, 6L, 2L, 5L, 5L, 4L, 6L, 2L, 3L, 7L, 1L, 8L, 2L, 3L, 7L, + 7L, 4L, 5L, 6L, 7L, 8L, 7L, 8L, 9L, 8L, 1L + ) + + expect_equal(sheet_col, expected_col) + + + expected_t <- c( + 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0 + ) + + expect_equal(sheet_t, expected_t) + + + + expected_v <- c( + "0", "1", "2", "3", "4", "5", "6", "7", "8", "1", "2", "3", + "4", "5", "6", "7", "8", "9", "1", "2", "3", "4", "5", "6", "7", + "8", "9", "1", "2", "3", "4", "5", "6", "7", "8", "8", "2", "2", + "3", "4", "4", "5", "6", "1", "1", "2", "2", "2", "3", "3", "1", + "2", "2", "34", "3", "4", "2", "2", "2", "3", "2", "6", "3", + "3", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", + "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", + "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", "2", + "2", "2", "2", "35" + ) + + + expect_equal(sheet_v, expected_v) + + + ## Sheet 3 + expected_col_widths <- structure(c("41.430625", "11.29", "11.0009375", "8.71578125"), + .Names = c("3", "4", "5", "6") + ) + + attr(expected_col_widths, "hidden") <- rep("0", 4) + + expect_equal(wb$colWidths[[3]], expected_col_widths) +}) + + + + + + + + + + + + + + + + + + + + + + + + + +test_that("Loading readTest.xlsx Sheet 1", { + fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + + sheet_data <- wb$worksheets[[1]]$sheet_data + sheet_v <- sheet_data$v + sheet_t <- sheet_data$t + sheet_f <- sheet_data$f + sheet_row <- sheet_data$rows + sheet_col <- sheet_data$cols + + ## sheet 1 + + expected_row <- c( + 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, + 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 6L, 6L, + 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 8L, 9L, 9L, 9L, 9L, 9L, 10L, + 10L, 10L, 10L, 10L, 11L, 11L, 11L + ) + + expect_equal(sheet_row, expected_row) + + + expected_col <- c( + 1L, 2L, 4L, 5L, 6L, 7L, 8L, 1L, 2L, 4L, 5L, 6L, 7L, 8L, 1L, + 4L, 5L, 6L, 8L, 1L, 2L, 4L, 5L, 6L, 8L, 1L, 2L, 5L, 6L, 1L, 2L, + 4L, 5L, 6L, 1L, 2L, 4L, 5L, 6L, 6L, 1L, 2L, 4L, 5L, 6L, 1L, 2L, + 4L, 5L, 6L, 2L, 4L, 6L + ) + + expect_equal(sheet_col, expected_col) + + + + expected_t <- c( + 1, 1, 1, 1, 1, 1, 1, 2, 0, 0, 1, 0, + 3, 4, 2, 4, 1, 0, 4, 2, 0, 0, 1, 0, + 4, 2, 0, 4, NA, 2, 0, 0, 1, NA, 2, 0, 0, + 1, 0, 0, 2, 0, 0, 1, 0, 2, 0, 0, 1, 0, + 0, 0, 0 + ) + + expect_equal(sheet_t, expected_t) + + + expected_v <- c( + "2096", "2097", "2098", "2099", "2107", "2108", "2109", "1", + "1", "1", "2100", "42042", "3209324 This", "#DIV/0!", "1", "#NUM!", + "2101", "42041", "#N/A", "1", "2", "1.34", "2102", "42040", "#NUM!", + "0", "2", "#NUM!", NA, "0", "3", "1.56", "2103", NA, "0", "1", + "1.7", "2104", "42037", "42036", "0", "2", "23", "2105", "42035", + "0", "3", "67.3", "2106", "42034", "1", "123", "42033" + ) + + + expect_equal(sheet_v, expected_v) + + + expected_f <- c( + NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "\"3209324\" & \" This\"", + "1/0", NA, NA, NA, NA, "#N/A", NA, NA, NA, NA, + NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, + NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA + ) + + + expect_equal(sheet_f, expected_f) + + + ## Column Widths + expected_col_widths <- structure("10.8603125", .Names = "6") + attr(expected_col_widths, "hidden") <- "0" + expect_equal(wb$colWidths[[1]], expected_col_widths) + + + + + + + expected_shared_strings <- structure(c( + "v1", "v2", "v3", + "v4", "v5", "v6", + "v7", "v8", "v9", + "bool", "Date", "value", + "word", "N-Z-P-S-Y", "C-G-D-X-H", + "B-K-A-O-W", "H-P-G-O-K", "F-P-C-L-T", + "A-N-Q-P-V", "Y-E-B-K-O", "V-S-N-T-R", + "F-K-Z-U-S", "O-E-Z-T-G", "Q-X-F-L-N", + "E-D-Y-Z-N", "W-F-L-C-I", "P-S-W-Y-E", + "P-H-N-Q-Z", "S-O-L-W-J", "J-E-F-Q-K", + "D-N-O-P-Z", "H-Z-K-S-U", "B-P-A-Y-R", + "Z-I-X-J-V", "Y-S-I-M-X", "V-A-C-R-O", + "O-V-S-C-Q", "A-K-S-V-W", "B-G-U-S-J", + "Z-E-J-V-T", "P-F-C-N-T", "L-T-Z-D-V", + "K-Q-Y-N-O", "U-S-Z-O-E", "Y-F-Z-C-P", + "P-Y-M-I-K", "D-Y-A-L-T", "W-I-F-A-B", + "I-H-S-W-K", "U-D-J-F-K", "B-K-G-J-V", + "Y-J-E-N-B", "X-L-V-S-U", "A-I-B-S-P", + "U-L-D-O-M", "M-D-V-R-X", "O-Q-K-S-B", + "O-R-X-C-W", "O-F-M-A-X", "J-K-V-E-X", + "W-B-S-O-A", "R-N-D-G-S", "W-J-K-M-R", + "K-I-H-F-M", "U-F-X-P-A", "M-R-C-H-L", + "H-A-E-X-J", "C-B-K-L-S", "V-A-I-S-L", + "B-L-N-J-G", "J-X-A-D-O", "I-S-W-P-U", + "D-R-M-G-C", "M-V-U-D-W", "U-S-A-Z-B", + "T-E-N-F-P", "K-E-S-Z-Y", "D-J-O-T-A", + "F-U-Y-T-R", "Q-U-N-P-J", "D-C-V-A-X", + "S-B-F-E-V", "U-R-P-H-A", "R-C-Z-J-B", + "L-B-M-F-I", "D-Y-B-S-Q", "X-Y-D-W-P", + "Z-L-I-V-R", "Z-W-T-M-B", "Z-U-S-E-G", + "V-I-M-C-O", "E-K-D-R-Z", "Z-F-H-Y-D", + "O-I-X-M-A", "F-K-U-G-T", "I-P-X-J-M", + "F-N-Z-E-C", "F-A-M-X-E", "R-V-C-O-P", + "X-Y-C-V-H", "K-G-T-Y-I", "N-M-E-D-F", + "M-K-N-U-W", "L-K-J-A-B", "S-M-T-D-A", + "W-D-G-F-U", "X-R-Z-F-E", "H-L-N-G-P", + "Z-X-W-M-R", "E-F-G-J-V", "X-I-M-Z-V", + "T-A-O-L-Q", "F-T-X-N-B", "O-G-D-P-A", + "B-K-Z-V-M", "M-J-O-S-X", "O-D-M-S-G", + "W-O-V-A-D", "I-D-W-T-H", "E-C-I-A-L", + "P-I-W-U-T", "Y-P-U-L-C", "Q-N-A-B-E", + "C-F-X-Y-H", "Q-P-G-I-J", "A-Q-J-W-F", + "G-N-R-U-D", "G-L-I-F-V", "Y-R-P-K-X", + "V-W-B-G-S", "E-Q-D-N-F", "E-R-U-D-O", + "O-E-G-X-L", "D-Q-G-A-K", "U-Z-N-C-V", + "O-K-T-W-X", "L-W-G-K-Q", "I-F-O-X-Q", + "J-B-V-W-T", "U-H-I-P-Q", "R-W-M-S-U", + "F-U-M-W-H", "F-A-Q-U-K", "Q-R-D-K-I", + "L-P-K-V-S", "G-I-B-U-Q", "Z-W-L-G-E", + "Q-C-I-B-A", "J-N-Y-W-D", "T-Y-G-W-S", + "L-M-A-G-K", "O-D-S-T-K", "O-G-L-T-Z", + "N-Q-E-B-F", "B-F-W-A-X", "U-G-Q-B-M", + "B-O-V-U-A", "R-K-X-H-A", "B-P-Q-T-R", + "I-P-Z-L-V", "C-T-L-W-D", "L-Q-D-M-U", + "N-P-H-A-G", "F-O-P-G-M", "N-M-Z-W-L", + "G-V-K-Z-T", "F-J-T-C-U", "J-P-R-A-C", + "Z-X-V-C-W", "B-Z-K-I-Q", "E-N-L-I-Y", + "C-D-P-R-B", "I-W-X-P-V", "T-M-P-I-O", + "W-Y-D-J-K", "A-O-C-L-B", "S-R-O-Y-C", + "A-O-Y-N-W", "P-C-O-D-Y", "E-S-A-L-Y", + "E-O-Q-W-C", "U-O-A-X-Q", "W-E-N-Y-D", + "A-W-J-Z-X", "P-L-R-U-K", "V-J-E-K-Z", + "V-A-M-G-D", "N-C-F-M-G", "H-W-N-K-R", + "G-T-A-F-O", "K-F-V-G-S", "N-V-H-G-I", + "F-Y-T-S-G", "A-H-O-C-V", "Q-W-J-S-C", + "W-G-I-X-E", "D-B-V-A-N", "P-N-L-Y-Q", + "O-I-R-Q-U", "D-R-W-E-O", "W-X-U-V-P", + "X-Y-D-A-W", "M-J-B-S-G", "K-R-G-N-Y", + "O-B-K-L-M", "G-N-Y-X-D", "K-F-A-B-T", + "S-Z-R-L-A", "K-Y-W-X-A", "O-Q-X-I-D", + "I-L-R-M-X", "S-D-V-U-N", "B-W-F-A-T", + "A-W-X-R-J", "D-H-G-X-L", "E-C-V-U-T", + "D-W-P-Z-F", "V-O-M-P-R", "P-L-B-X-N", + "Z-U-F-D-V", "M-K-Z-S-Y", "X-P-N-T-D", + "U-Q-D-T-S", "N-I-X-S-O", "S-C-K-F-D", + "N-V-I-R-D", "Z-X-Y-B-P", "U-W-R-D-V", + "G-V-I-N-K", "D-Y-N-T-J", "P-K-F-U-W", + "U-I-P-D-Q", "R-T-Q-N-Z", "Z-R-D-V-O", + "Z-S-F-T-D", "X-K-Z-B-W", "U-F-Z-S-Y", + "X-I-T-Z-K", "A-X-H-N-Z", "R-U-Q-W-J", + "C-H-P-V-Y", "R-O-A-T-E", "L-F-B-X-A", + "Z-X-E-C-G", "R-B-C-Q-W", "A-O-Z-U-B", + "R-W-P-S-H", "R-Y-B-A-W", "K-X-U-I-M", + "O-X-F-P-A", "U-Y-P-D-M", "A-D-K-R-M", + "R-U-D-T-M", "H-Q-Y-K-J", "T-B-H-N-U", + "P-I-V-X-W", "S-H-X-C-U", "I-O-Y-G-W", + "A-U-Z-J-R", "Q-U-H-M-A", "B-W-M-I-C", + "P-X-Z-Y-N", "Y-J-W-N-B", "V-Y-U-S-B", + "K-W-S-Q-M", "I-K-X-H-S", "F-L-M-Q-T", + "S-Z-O-K-L", "O-P-N-G-E", "P-H-R-Q-T", + "M-L-A-D-T", "D-S-X-V-H", "F-C-O-A-B", + "P-I-N-O-H", "H-X-Y-I-C", "S-I-R-P-Q", + "P-M-F-H-Y", "S-R-O-T-Q", "X-H-O-B-R", + "W-P-A-Q-V", "E-L-Q-G-Y", "I-S-T-W-C", + "B-M-R-G-Y", "S-J-A-K-Q", "E-P-B-G-J", + "R-Y-E-L-D", "A-R-C-N-S", "Y-H-B-M-I", + "T-Q-C-K-N", "L-T-Z-V-C", "Q-L-N-J-K", + "T-E-J-M-Y", "E-M-F-R-C", "M-A-Y-D-I", + "G-M-Y-F-Q", "A-X-B-E-N", "F-Y-E-H-L", + "S-Z-R-M-O", "U-V-W-S-I", "D-S-E-L-K", + "B-C-X-V-F", "Q-V-L-F-H", "H-Z-I-J-P", + "W-U-O-M-D", "A-Y-T-O-X", "Y-C-Z-V-D", + "E-L-O-X-Y", "D-U-K-X-A", "S-W-K-N-E", + "D-F-T-E-Y", "J-T-B-C-L", "E-T-Z-V-F", + "Q-D-U-P-E", "M-Q-X-T-J", "A-M-I-K-P", + "J-T-B-E-R", "L-X-J-O-F", "X-B-V-W-P", + "Y-N-H-G-Z", "M-F-K-S-P", "K-B-V-Z-L", + "T-L-Y-G-A", "N-U-X-C-D", "W-B-O-X-Z", + "U-Y-J-F-A", "T-V-J-I-S", "T-L-W-X-Z", + "V-K-X-C-N", "G-C-I-S-Z", "C-T-K-S-Z", + "F-I-D-N-E", "E-C-M-Y-J", "N-C-Y-S-I", + "B-N-I-L-D", "Y-F-T-M-V", "R-A-E-O-M", + "M-G-P-W-X", "H-B-C-D-R", "A-J-N-C-H", + "R-O-F-D-N", "H-E-R-T-K", "M-U-S-V-A", + "L-V-F-A-H", "E-Q-N-Y-C", "T-N-L-X-S", + "C-F-X-A-N", "M-X-Y-C-Z", "A-N-F-B-K", + "J-Q-R-Z-D", "Q-P-Y-G-N", "D-Y-O-R-J", + "K-R-Y-N-O", "A-H-K-J-B", "O-G-J-A-S", + "T-N-K-X-S", "V-P-X-Y-F", "R-P-V-G-T", + "O-B-F-E-D", "Z-P-I-T-F", "T-S-D-X-G", + "Y-J-P-Z-U", "H-W-Y-K-J", "H-Z-C-F-Q", + "D-I-B-N-X", "K-B-U-H-E", "H-Y-U-Q-A", + "N-Q-G-T-I", "J-B-V-E-G", "M-F-O-E-H", + "B-P-K-M-I", "T-Z-B-Q-Y", "X-Y-T-P-O", + "E-K-I-W-C", "C-M-R-S-Y", "F-Y-M-W-L", + "A-S-E-U-J", "I-P-W-N-G", "V-G-R-E-T", + "H-O-W-G-Y", "O-H-B-C-P", "C-Y-D-Q-X", + "X-Y-I-Z-U", "R-I-Q-Y-P", "E-M-L-D-Y", + "B-G-P-Y-T", "Z-H-X-D-V", "S-B-R-J-F", + "O-T-X-P-W", "Y-C-T-M-E", "J-A-D-O-P", + "B-W-Q-D-I", "Y-T-X-K-Q", "F-D-P-X-J", + "Z-G-Y-O-N", "J-N-Z-Q-P", "W-C-E-I-U", + "L-R-K-F-H", "X-I-G-B-O", "M-C-Q-Y-Z", + "S-T-W-J-E", "G-O-N-Y-Q", "O-Q-R-Z-B", + "X-G-E-C-I", "P-B-D-F-Q", "Q-H-D-I-V", + "H-I-J-D-Q", "C-B-S-I-G", "M-A-F-D-B", + "G-Z-R-U-K", "N-U-L-Q-R", "C-A-K-M-T", + "F-S-R-B-K", "O-D-X-S-W", "H-J-N-P-C", + "N-G-Y-L-J", "D-X-K-O-E", "F-E-H-D-L", + "E-M-D-P-Z", "Q-K-I-J-V", "D-O-N-M-X", + "C-P-N-E-K", "L-H-T-U-P", "M-T-Z-P-H", + "B-T-L-Z-G", "Z-V-R-C-I", "J-M-R-D-G", + "I-V-L-Q-T", "O-V-X-A-M", "V-L-N-A-T", + "M-B-R-U-O", "O-B-Q-F-X", "H-O-E-K-G", + "S-H-G-B-D", "N-Z-C-L-D", "M-F-J-H-K", + "A-O-D-W-B", "I-X-G-K-W", "B-S-O-K-Q", + "X-T-Z-I-D", "N-D-G-B-L", "Z-O-U-I-X", + "W-B-A-R-H", "S-G-Q-J-F", "M-B-J-F-A", + "M-B-X-A-P", "F-M-S-Y-V", "T-K-B-G-C", + "H-V-C-G-X", "V-A-S-I-T", "Z-X-G-U-S", + "U-J-Y-M-H", "D-Y-H-X-S", "T-Q-X-I-E", + "S-V-K-M-T", "S-Z-P-O-Y", "V-Y-Q-L-F", + "A-E-R-V-G", "E-C-M-G-O", "T-B-U-M-V", + "M-R-V-A-E", "C-A-R-W-N", "Y-U-D-Z-X", + "Y-G-Z-C-Q", "T-X-R-A-D", "S-A-U-R-K", + "E-A-D-R-V", "P-R-T-W-F", "A-Z-Y-O-N", + "O-P-W-A-I", "H-V-U-R-F", "W-D-G-P-I", + "M-Z-Q-C-I", "Y-S-H-W-I", "F-J-C-N-S", + "H-C-Z-Y-K", "W-J-K-Z-I", "Q-T-G-C-X", + "S-Q-T-O-Y", "Z-G-T-W-X", "X-M-J-R-W", + "S-Y-N-F-H", "C-F-V-G-A", "W-R-J-I-B", + "I-V-B-A-M", "R-C-D-L-U", "S-T-B-A-N", + "F-W-J-M-A", "J-I-R-E-H", "Q-D-O-E-R", + "R-B-M-O-J", "B-X-G-V-U", "R-J-L-Y-M", + "R-F-A-X-J", "N-I-J-V-Q", "J-O-D-Q-Z", + "K-I-F-D-H", "N-H-Q-Z-M", "I-K-R-Z-X", + "O-D-U-T-I", "K-G-S-L-Y", "X-D-O-K-A", + "C-X-I-P-J", "X-A-Y-V-T", "I-V-T-J-O", + "X-D-M-H-U", "M-L-R-Y-J", "N-L-I-R-B", + "A-J-Z-O-Q", "G-Y-I-S-E", "N-F-X-Z-T", + "U-G-C-F-K", "R-N-W-S-M", "A-O-T-N-U", + "W-O-P-G-V", "D-W-E-H-O", "B-D-S-E-Z", + "C-L-V-M-I", "Y-N-C-W-B", "C-Q-L-P-W", + "X-H-L-B-M", "H-V-D-K-Q", "O-S-C-U-H", + "V-I-J-K-A", "D-M-B-I-F", "O-H-N-J-V", + "R-L-Q-J-Y", "Q-P-B-S-X", "J-K-V-H-F", + "A-T-L-Q-B", "E-D-S-B-G", "K-T-X-J-Q", + "W-L-U-B-H", "T-Y-Z-G-V", "G-S-C-X-P", + "D-C-M-Z-Y", "V-G-F-D-E", "Q-F-X-O-U", + "E-V-L-F-G", "M-T-V-U-Y", "Z-X-S-U-E", + "J-I-F-E-R", "C-V-J-R-W", "W-R-V-U-K", + "M-A-S-U-Q", "J-K-O-F-I", "I-Y-G-U-Z", + "B-Y-V-D-R", "M-G-Q-N-J", "A-F-N-K-M", + "R-B-D-Q-P", "H-T-N-U-L", "J-W-E-A-B", + "N-M-K-R-O", "H-Q-A-N-E", "U-B-Y-L-Q", + "J-E-N-T-Q", "D-N-L-R-E", "K-S-O-L-Z", + "Z-D-Y-A-N", "D-Q-B-X-Z", "J-E-F-O-Q", + "U-E-Q-T-R", "U-H-F-N-L", "C-T-I-V-X", + "V-L-Q-O-K", "G-Q-D-P-V", "D-T-V-G-S", + "I-G-H-Z-L", "A-E-I-Y-B", "S-V-N-B-R", + "M-P-J-Y-N", "D-T-W-Q-Z", "U-V-F-A-S", + "M-B-T-Y-Q", "F-I-C-D-X", "G-X-O-K-J", + "J-M-I-E-D", "C-B-S-F-A", "A-Y-O-Z-P", + "R-T-H-L-S", "P-X-B-S-O", "B-I-C-P-T", + "F-K-H-Z-N", "R-D-Y-T-P", "S-U-P-G-R", + "M-K-R-Q-V", "Z-E-O-U-T", "M-W-Y-X-C", + "Q-J-U-T-B", "L-H-S-J-U", "P-M-X-R-N", + "S-Y-T-G-W", "W-P-N-V-O", "E-U-I-L-M", + "V-S-K-J-R", "P-E-T-C-X", "E-V-C-S-Y", + "M-S-F-T-Q", "L-D-P-K-T", "D-Z-U-Q-P", + "D-H-L-W-N", "V-U-Q-I-A", "L-D-G-H-V", + "G-I-U-Q-E", "G-E-D-R-H", "N-T-L-K-H", + "J-U-K-F-V", "G-J-Y-K-W", "E-A-I-G-Q", + "S-U-H-R-T", "L-S-W-H-C", "P-V-I-Y-O", + "E-L-K-X-N", "Y-B-S-T-N", "N-U-V-E-Z", + "B-V-K-M-O", "L-V-H-A-K", "M-U-T-J-K", + "V-J-T-F-R", "T-Y-E-U-W", "C-D-B-A-L", + "K-E-U-S-A", "D-H-R-X-Z", "M-B-Z-G-C", + "P-E-T-S-Y", "M-G-O-J-F", "C-Y-E-P-X", + "R-V-D-C-N", "S-Y-A-K-Z", "K-S-G-T-D", + "D-F-G-U-K", "F-B-P-T-M", "P-G-O-D-W", + "U-L-I-R-J", "F-Q-N-X-J", "D-Q-F-V-B", + "R-P-E-Z-H", "A-H-X-M-L", "I-H-F-G-W", + "V-C-M-H-Y", "V-H-L-Y-F", "H-I-L-P-V", + "L-Q-W-K-A", "D-W-J-R-L", "W-E-V-J-L", + "F-Z-X-U-H", "K-U-Q-I-R", "S-D-N-E-V", + "G-T-E-L-Y", "S-P-E-B-D", "U-N-L-S-O", + "Z-G-W-I-X", "M-C-X-S-E", "P-C-S-X-Y", + "B-Z-K-R-H", "D-J-W-Y-U", "J-O-Q-F-P", + "I-A-V-G-Y", "U-B-V-G-N", "W-H-Q-M-E", + "J-R-O-D-F", "W-M-C-O-P", "R-I-F-M-Q", + "Q-L-D-W-X", "M-A-Q-P-F", "O-J-T-L-A", + "X-S-I-P-G", "G-W-D-Y-F", "T-B-M-N-J", + "Q-W-N-Z-C", "M-F-C-O-H", "Z-N-Q-X-P", + "Q-G-A-Y-C", "R-F-G-P-E", "X-J-F-R-C", + "J-S-Q-E-L", "O-K-P-F-D", "R-J-W-G-T", + "Y-P-J-N-D", "N-S-F-Y-T", "M-L-N-H-U", + "V-A-H-G-Q", "H-L-W-K-P", "U-P-G-V-O", + "V-N-P-I-Y", "A-O-E-F-L", "W-F-Q-J-G", + "B-A-L-V-Q", "Y-J-F-V-S", "O-F-E-J-A", + "X-O-F-M-B", "B-M-L-H-W", "Z-X-F-T-B", + "W-X-E-M-A", "F-J-V-W-L", "P-C-U-R-O", + "S-K-F-D-V", "K-F-Z-Q-C", "J-S-R-M-Q", + "E-H-L-Q-N", "W-F-M-E-X", "P-R-E-N-A", + "D-F-G-N-Y", "I-S-O-V-T", "R-I-C-N-L", + "I-T-C-Y-P", "R-W-I-K-X", "P-B-J-X-G", + "D-W-F-N-E", "M-G-C-B-K", "E-T-H-F-W", + "A-E-L-F-Z", "Z-V-W-S-R", "O-T-L-D-Q", + "S-E-M-Z-O", "N-R-Y-A-U", "Y-D-M-A-R", + "S-M-P-N-K", "C-T-B-L-Z", "X-A-L-I-V", + "B-V-M-G-S", "N-R-K-Q-D", "F-O-L-X-Y", + "Y-T-F-A-S", "X-G-O-U-A", "Z-F-I-B-T", + "V-H-B-N-W", "V-K-B-W-S", "V-C-T-L-G", + "X-N-L-Y-Q", "N-D-L-I-Z", "L-K-G-N-E", + "D-L-M-K-Z", "E-I-P-Z-U", "H-X-B-C-D", + "B-H-D-C-V", "F-O-L-D-R", "B-Z-J-Y-V", + "E-C-R-B-S", "E-X-V-B-S", "P-K-I-W-G", + "A-I-F-V-O", "D-F-R-I-E", "X-L-I-N-O", + "P-Y-Q-C-S", "C-P-A-X-L", "W-O-U-A-X", + "H-M-R-E-B", "K-Y-P-G-A", "O-E-V-D-C", + "Z-A-K-M-W", "S-F-M-Z-E", "X-U-I-C-J", + "C-V-T-B-N", "Z-Q-Y-V-G", "T-W-G-Q-D", + "K-Y-L-R-F", "W-O-S-E-A", "V-T-Q-F-G", + "G-V-J-M-U", "P-R-A-N-C", "I-R-A-F-T", + "X-Z-U-W-N", "A-G-R-D-Y", "J-U-T-A-Q", + "K-Y-T-H-U", "P-Q-L-Z-G", "N-K-Y-X-W", + "A-T-M-R-Z", "M-B-P-C-L", "M-Q-K-N-R", + "I-W-H-G-R", "I-F-D-Q-A", "V-G-F-C-X", + "H-Q-F-D-T", "N-R-T-Q-G", "X-V-P-B-G", + "V-H-B-N-X", "G-Q-T-J-Y", "P-F-A-N-H", + "C-D-I-W-K", "T-R-J-B-P", "E-P-X-L-S", + "O-K-B-L-M", "Z-T-B-R-V", "V-N-Y-Z-U", + "E-W-V-F-O", "D-S-A-Z-J", "R-O-W-A-Y", + "V-L-K-J-Q", "Q-T-J-S-Z", "M-G-L-Y-D", + "G-U-W-I-C", "G-O-D-T-I", "R-L-Z-P-V", + "W-G-M-T-I", "S-F-H-Z-J", "Z-L-O-V-N", + "G-D-A-U-H", "Y-K-V-R-E", "Y-O-L-R-I", + "X-V-Z-I-B", "N-Z-S-D-O", "N-X-Z-J-M", + "S-X-A-H-C", "V-T-R-F-H", "K-E-Q-B-J", + "V-R-J-U-G", "Q-K-B-P-Z", "Y-I-S-X-K", + "U-O-R-Q-J", "Q-T-X-F-D", "P-O-F-B-J", + "C-M-K-L-F", "N-W-Y-A-V", "E-H-I-G-U", + "L-J-X-A-C", "Q-K-U-D-B", "A-S-R-D-T", + "S-Z-E-Y-U", "A-K-R-S-G", "S-F-R-J-Q", + "A-Y-J-F-U", "L-I-J-R-H", "K-C-V-Q-F", + "H-U-A-T-D", "E-W-L-I-C", "Y-P-R-F-V", + "L-M-P-Z-U", "T-Q-U-P-V", "Q-W-T-M-K", + "P-D-G-Y-K", "F-I-K-C-P", "I-T-Y-K-L", + "H-T-K-I-R", "H-K-B-M-F", "J-P-D-Z-Q", + "D-M-K-C-V", "E-K-Y-F-R", "P-L-H-A-J", + "R-C-Z-V-T", "I-W-G-A-T", "Y-N-X-K-R", + "M-N-E-C-Q", "J-B-W-R-X", "R-M-D-T-F", + "R-V-L-Y-G", "M-V-E-Z-Q", "S-H-Q-X-G", + "H-P-Y-Q-G", "F-N-K-T-W", "I-B-Z-P-F", + "G-P-N-S-F", "B-Y-S-N-A", "P-I-Z-A-S", + "X-I-K-B-Y", "B-Q-F-W-M", "Y-E-J-P-M", + "V-E-T-G-O", "M-N-L-K-I", "N-D-W-B-V", + "F-P-S-M-X", "K-H-Q-M-F", "Z-B-O-I-L", + "L-F-D-S-E", "W-Y-P-B-A", "L-P-S-V-U", + "D-G-L-J-P", "K-U-F-Y-E", "J-G-R-M-N", + "J-U-P-H-O", "O-U-N-M-W", "X-V-J-K-E", + "C-W-G-L-K", "D-H-A-O-K", "H-G-C-X-P", + "B-C-I-J-D", "N-L-T-D-S", "X-D-C-A-T", + "Z-D-U-N-E", "P-W-A-I-L", "N-U-G-H-C", + "F-Q-E-V-T", "X-O-M-S-U", "Z-V-S-Q-R", + "K-Z-U-D-L", "A-O-Z-C-T", "S-K-U-T-Q", + "V-Q-I-B-Z", "A-K-Z-N-Y", "T-G-V-Y-O", + "G-K-R-A-J", "Y-J-F-T-U", "E-P-K-G-F", + "U-P-X-L-V", "H-C-S-M-I", "K-D-X-W-N", + "F-E-P-V-R", "C-P-V-W-L", "I-S-M-E-B", + "D-E-L-C-O", "A-D-V-U-W", "D-I-N-M-Z", + "O-Z-K-S-N", "F-J-W-L-S", "H-C-V-W-I", + "B-A-L-V-Y", "N-K-Z-W-X", "Z-C-X-K-A", + "S-X-H-G-Y", "L-G-M-V-Q", "Z-L-G-Y-Q", + "J-W-E-A-D", "G-S-A-M-U", "F-M-D-K-O", + "B-O-G-R-K", "V-S-U-Q-B", "R-X-O-N-F", + "Y-N-M-H-I", "T-J-W-Q-L", "R-W-P-B-H", + "D-A-I-P-E", "D-P-Q-T-N", "Y-K-Q-U-X", + "A-Y-M-C-R", "M-O-I-L-B", "Y-O-K-J-F", + "O-C-J-X-H", "W-J-X-L-Z", "F-P-H-A-L", + "M-T-F-U-P", "W-H-F-C-X", "R-C-D-Z-L", + "Y-B-A-I-L", "S-I-Y-W-P", "K-D-X-G-Z", + "O-W-Q-M-G", "M-T-V-L-G", "F-Z-Y-J-L", + "V-L-A-S-N", "I-P-A-S-N", "G-T-Q-D-F", + "G-R-L-W-V", "I-R-Z-V-P", "M-L-B-A-I", + "D-K-Z-F-M", "M-O-G-X-V", "Y-V-D-Z-W", + "M-S-O-G-T", "Z-F-M-U-X", "V-N-Z-P-I", + "N-D-F-U-J", "G-O-U-E-S", "Z-C-G-W-B", + "O-T-E-N-V", "W-P-H-C-V", "X-R-D-P-G", + "Y-C-E-F-T", "V-O-G-K-I", "S-I-W-M-L", + "M-H-C-O-A", "Q-C-N-Z-D", "A-N-L-S-T", + "X-W-I-L-K", "A-Y-V-S-K", "D-W-F-L-K", + "U-Z-I-R-Q", "V-W-B-A-T", "I-U-R-E-W", + "N-W-U-Q-O", "F-H-L-N-O", "D-I-T-J-H", + "W-K-Q-D-T", "A-O-R-I-U", "M-E-V-A-F", + "U-J-M-X-S", "O-E-R-K-H", "A-V-Z-T-D", + "C-Z-B-D-L", "D-J-T-Q-G", "A-O-C-I-Z", + "J-L-A-Y-C", "P-O-H-E-V", "A-M-Z-I-R", + "W-C-R-H-V", "Z-G-I-V-N", "K-M-W-T-Q", + "O-I-F-D-N", "X-D-A-V-T", "T-S-M-B-D", + "F-C-D-U-Q", "B-H-M-Q-G", "M-K-I-W-B", + "R-M-Q-W-P", "N-Z-L-F-G", "I-P-J-B-W", + "O-Y-W-U-V", "C-V-Z-B-O", "O-Q-S-F-X", + "B-G-F-M-W", "N-X-R-P-S", "L-T-A-H-R", + "G-O-E-L-X", "R-I-U-X-Y", "Q-O-Z-F-V", + "O-P-J-C-M", "D-W-G-S-L", "T-K-W-L-O", + "E-I-O-K-D", "K-E-A-I-S", "M-I-W-F-K", + "S-W-G-T-N", "P-L-J-D-A", "O-M-T-J-P", + "C-R-Z-L-G", "F-S-D-V-K", "N-J-H-V-I", + "D-I-A-F-J", "U-R-T-V-X", "J-N-T-R-S", + "K-V-Z-T-Q", "J-L-C-R-M", "Z-A-R-L-E", + "Y-L-W-I-S", "B-W-E-N-U", "B-S-W-J-F", + "D-G-I-P-S", "D-Q-M-E-R", "K-T-R-A-D", + "P-Q-L-E-U", "U-D-W-A-O", "Q-R-P-D-Y", + "C-X-V-S-I", "F-E-U-I-K", "H-Z-T-L-P", + "P-I-U-B-O", "S-Q-G-W-K", "K-V-S-U-L", + "F-N-Q-O-P", "M-Q-F-C-L", "V-X-G-C-A", + "N-S-E-C-V", "R-K-J-A-X", "D-L-H-W-S", + "Z-C-Y-L-G", "M-D-W-F-U", "R-A-U-S-F", + "Y-W-H-V-Q", "B-K-G-J-W", "B-V-H-E-C", + "D-J-X-S-H", "W-C-H-Z-Q", "X-B-A-I-U", + "D-A-J-C-F", "B-P-U-S-W", "A-D-R-Z-K", + "S-H-P-A-Z", "J-O-U-P-S", "W-C-H-P-T", + "C-U-Z-O-W", "P-E-H-M-S", "B-W-L-Y-N", + "N-S-F-R-Y", "W-R-K-A-N", "G-X-V-D-E", + "I-G-D-P-T", "W-N-J-R-L", "P-Q-H-A-V", + "U-Q-R-P-W", "I-H-Q-X-U", "W-K-R-M-N", + "U-H-Q-B-Y", "X-P-D-V-W", "E-K-F-R-C", + "T-E-B-N-L", "I-S-K-Q-H", "Y-Z-V-Q-L", + "W-L-U-P-I", "Y-P-F-H-O", "M-C-Y-T-I", + "Q-A-V-Z-O", "I-H-U-K-F", "Q-Z-C-W-Y", + "U-M-Q-C-R", "U-H-S-M-W", "R-C-M-Y-G", + "R-C-J-A-V", "X-B-Z-C-Y", "P-C-O-J-I", + "E-C-O-W-R", "E-T-Y-X-F", "Q-M-C-K-S", + "H-I-O-J-K", "R-P-N-J-V", "H-Y-P-N-V", + "R-J-I-L-S", "N-K-T-Z-O", "H-B-K-A-P", + "P-G-J-A-B", "L-S-O-I-Y", "L-U-R-Z-D", + "F-I-K-Q-B", "Q-K-X-B-M", "A-C-L-B-I", + "J-E-O-D-K", "Y-W-V-G-D", "S-N-T-H-Q", + "K-M-D-R-H", "B-U-N-A-T", "A-J-F-O-C", + "J-L-V-R-D", "X-A-Q-J-R", "I-V-E-W-Z", + "Q-G-K-P-X", "O-H-K-J-D", "N-K-I-J-B", + "Y-R-N-G-C", "K-L-E-B-S", "O-P-T-D-G", + "O-R-E-J-V", "X-V-B-Z-U", "Y-H-I-O-C", + "B-O-Y-M-P", "J-Z-R-Q-P", "A-E-K-M-D", + "D-X-L-F-U", "J-X-U-A-Z", "Y-R-G-X-Q", + "Y-R-P-W-C", "K-Q-C-Y-L", "K-H-L-V-U", + "P-A-N-I-C", "M-D-Y-F-A", "H-V-D-F-U", + "Z-D-P-U-J", "O-E-I-Z-Q", "L-Q-A-O-I", + "L-V-C-K-N", "E-Z-R-Q-K", "N-T-V-U-D", + "U-B-O-H-Z", "F-X-D-H-U", "T-W-R-O-G", + "G-A-O-Z-L", "Z-C-B-G-P", "O-I-B-S-N", + "Z-R-I-O-Y", "K-B-L-C-Z", "Z-B-T-F-D", + "B-H-P-J-C", "A-T-L-N-M", "O-P-W-M-S", + "Q-I-L-G-J", "O-D-Q-J-M", "P-B-F-Z-V", + "Q-H-J-I-C", "K-V-W-Z-D", "Y-A-R-Z-Q", + "M-U-H-Q-N", "O-D-K-J-Z", "I-C-Z-J-H", + "E-K-R-G-M", "D-B-G-Y-K", "U-Q-B-C-L", + "Y-Q-M-W-L", "A-Z-J-B-S", "C-W-K-O-X", + "G-E-V-B-R", "L-N-Q-T-H", "H-E-X-A-J", + "U-O-Z-S-B", "P-G-W-K-D", "J-W-L-C-A", + "L-C-E-V-Z", "T-K-Y-Q-P", "Z-J-Q-U-V", + "V-C-P-K-X", "U-X-A-H-E", "I-J-E-Z-W", + "O-M-W-F-S", "N-K-Y-P-M", "C-G-K-L-R", + "M-T-V-A-E", "D-V-H-Q-F", "M-N-P-W-L", + "G-E-F-T-M", "G-X-D-Q-O", "X-G-W-E-Z", + "U-C-B-P-Z", "F-K-Z-W-H", "P-C-D-F-L", + "N-V-G-R-T", "I-N-B-J-T", "B-T-A-M-L", + "Q-D-N-Y-I", "B-I-K-X-A", "C-U-F-S-K", + "W-X-G-P-L", "H-A-P-L-C", "W-T-K-P-F", + "G-B-U-T-K", "U-S-Q-Y-Z", "G-C-E-Z-W", + "Z-Y-Q-B-M", "D-Y-N-C-E", "E-J-Q-K-I", + "P-R-O-B-V", "D-E-A-S-U", "I-A-M-E-L", + "M-K-U-F-Y", "L-Q-H-S-O", "Z-F-V-T-P", + "V-N-M-R-J", "Q-E-P-K-O", "O-H-J-U-K", + "U-Z-Q-O-F", "R-X-K-O-C", "L-R-K-C-G", + "V-F-B-S-K", "L-Z-O-H-E", "D-S-Y-V-K", + "R-J-V-A-C", "P-L-B-Q-Z", "U-Q-Z-X-Y", + "E-P-L-F-T", "Z-F-C-G-B", "W-V-C-A-J", + "O-N-C-Y-H", "B-Y-C-D-Z", "E-X-G-H-Z", + "Y-H-X-J-I", "O-K-P-J-D", "G-E-K-T-B", + "G-A-K-Y-P", "T-V-X-P-H", "W-Y-D-K-V", + "Z-W-B-P-Q", "A-J-F-U-P", "V-A-X-E-Z", + "F-T-J-E-I", "V-M-L-Z-U", "H-I-B-L-Q", + "C-D-V-K-M", "G-Z-F-J-R", "C-T-N-U-H", + "W-Y-U-X-M", "T-F-I-W-V", "X-O-P-Y-W", + "L-Z-P-B-K", "A-E-T-Q-K", "K-P-C-T-Z", + "C-A-H-G-E", "B-W-G-D-V", "A-S-D-B-I", + "T-D-G-C-P", "J-B-F-T-K", "V-R-L-U-F", + "O-P-Q-X-M", "K-M-T-E-D", "R-B-H-X-G", + "L-C-O-Y-B", "R-Z-U-E-I", "K-I-W-O-G", + "Z-X-W-F-K", "Y-C-B-S-V", "L-M-R-N-Z", + "B-Q-M-Z-K", "P-S-Z-O-T", "Y-A-Z-N-R", + "L-O-A-P-J", "O-Z-Y-M-P", "C-P-S-J-Q", + "Y-F-Q-A-R", "U-Z-K-B-X", "Q-R-T-H-X", + "N-U-E-Q-A", "X-Z-R-J-C", "U-X-E-A-Z", + "Y-M-O-A-V", "N-K-D-W-M", "V-Q-E-F-S", + "L-U-A-Z-D", "X-S-R-P-E", "I-B-O-Z-L", + "J-G-K-H-Z", "T-P-O-Z-S", "L-I-R-G-N", + "Y-C-O-Z-A", "H-B-D-Q-R", "C-L-J-E-T", + "K-Z-N-U-X", "P-F-S-Z-H", "S-N-D-R-T", + "V-R-S-T-G", "N-S-F-U-Y", "D-P-L-C-A", + "B-X-V-M-S", "B-M-Z-E-Q", "K-Y-S-P-B", + "K-T-V-F-G", "U-Z-B-W-E", "J-X-O-C-Y", + "X-C-Q-P-D", "X-L-Y-J-Z", "Y-F-O-N-H", + "M-J-B-Z-X", "G-X-R-A-D", "E-I-L-O-A", + "B-R-C-I-K", "K-W-F-N-P", "C-Y-R-A-H", + "J-H-D-N-C", "P-Y-C-I-D", "P-D-C-U-E", + "H-A-I-E-P", "B-N-E-H-S", "C-Y-P-E-F", + "K-F-X-B-S", "M-Q-D-I-Z", "V-S-P-K-O", + "L-W-M-T-I", "K-N-B-V-D", "A-Z-N-X-G", + "U-T-D-A-Y", "Q-Z-D-F-E", "J-Q-I-Y-C", + "G-L-E-O-R", "V-J-Z-K-F", "O-W-F-X-H", + "H-R-P-X-L", "B-F-X-G-P", "I-C-A-M-R", + "P-N-W-Z-L", "R-G-O-H-D", "G-M-B-W-K", + "G-D-E-H-P", "Z-K-I-P-N", "K-V-C-E-W", + "O-K-N-T-R", "K-B-N-X-M", "E-V-A-X-P", + "Q-J-I-Y-C", "I-T-U-J-D", "W-U-T-O-Q", + "O-E-H-J-A", "D-K-P-A-I", "D-J-A-F-X", + "T-X-D-V-A", "B-W-T-H-V", "H-G-Q-E-U", + "B-U-F-Z-Y", "O-S-R-T-D", "F-W-S-I-G", + "Z-O-X-C-S", "H-V-K-N-E", "Z-M-L-E-O", + "Q-V-T-M-P", "T-N-D-C-S", "L-F-Q-R-Y", + "U-F-S-I-O", "S-R-M-B-K", "D-P-W-U-A", + "Y-W-A-T-E", "I-W-A-F-J", "V-J-G-A-Q", + "Z-S-C-Y-L", "T-C-N-O-S", "J-R-Y-X-Q", + "A-F-P-N-J", "R-Y-N-H-M", "S-W-Q-B-V", + "N-Q-U-G-K", "T-A-Y-R-Z", "I-L-O-U-V", + "W-B-L-F-Q", "N-T-E-W-G", "L-S-I-W-X", + "P-A-Z-J-U", "Z-N-F-X-G", "P-B-O-E-N", + "D-U-T-C-K", "G-Y-I-K-S", "F-H-W-X-P", + "O-B-T-E-Z", "N-K-T-S-X", "E-S-T-N-V", + "E-A-J-Q-F", "P-Q-D-X-B", "R-F-J-E-Q", + "X-Z-S-M-V", "E-Z-Q-D-X", "M-O-T-U-D", + "O-I-X-Z-H", "H-T-V-I-M", "U-E-A-D-W", + "Z-D-F-A-X", "E-D-V-P-N", "K-J-R-M-H", + "V-A-K-U-D", "S-B-L-A-N", "Q-C-Z-D-P", + "U-Z-A-W-C", "V-D-M-G-B", "Z-H-A-I-X", + "W-F-H-R-X", "G-E-V-F-K", "H-A-V-L-E", + "K-P-E-X-Y", "T-O-Y-R-P", "H-T-F-U-K", + "R-V-N-C-X", "K-H-Z-R-A", "Q-P-J-G-N", + "T-F-L-K-E", "E-T-O-D-G", "J-K-E-S-N", + "K-Q-D-C-B", "Q-R-A-F-D", "J-W-A-Q-I", + "N-T-F-G-D", "E-R-I-D-N", "M-G-P-Q-V", + "D-P-R-G-N", "N-C-F-T-A", "D-F-Q-X-O", + "U-D-K-Q-X", "N-G-M-Q-A", "I-X-F-D-V", + "R-T-C-K-I", "S-G-E-R-O", "R-B-J-G-Z", + "J-X-G-K-R", "U-K-O-L-C", "X-Q-U-S-B", + "B-A-M-V-N", "N-A-V-G-U", "I-Y-U-Z-C", + "Y-R-I-M-V", "Y-I-R-P-N", "E-C-Q-A-P", + "P-Z-B-O-A", "D-A-R-F-Y", "Q-E-T-L-N", + "Z-D-F-Q-C", "X-T-Q-W-D", "D-P-Y-U-J", + "S-J-Q-X-V", "E-O-P-W-N", "W-Q-B-O-Y", + "Y-Z-W-Q-F", "H-Q-C-X-O", "S-B-W-V-L", + "G-R-Y-V-J", "W-F-G-K-S", "F-N-P-D-S", + "L-C-Q-T-Z", "V-S-Y-O-B", "L-F-X-U-Q", + "G-D-R-M-E", "P-Q-R-Y-G", "N-E-H-L-P", + "Z-R-F-M-U", "I-X-C-F-O", "L-E-X-K-O", + "G-V-Y-X-F", "O-P-V-A-Z", "P-K-S-L-Y", + "Q-R-K-M-D", "A-N-B-J-R", "C-S-G-R-M", + "H-C-E-O-D", "E-I-N-F-O", "F-S-P-O-B", + "T-S-A-X-B", "R-K-Y-L-M", "F-G-O-C-T", + "C-F-H-Y-Z", "M-P-Z-A-V", "N-U-X-B-T", + "Q-A-V-N-P", "D-R-V-C-K", "U-P-X-M-F", + "S-P-I-T-Z", "O-Z-C-U-Y", "B-G-X-A-D", + "Y-U-L-A-W", "O-J-Q-W-G", "V-B-I-F-D", + "V-J-Q-K-A", "H-X-W-S-A", "E-D-F-T-I", + "H-Q-V-R-L", "M-U-Z-K-Q", "V-Y-U-Q-X", + "H-M-I-U-O", "N-Q-P-U-R", "Y-F-I-V-D", + "F-A-L-W-M", "G-Q-M-L-B", "X-B-L-P-W", + "I-A-R-Q-F", "U-E-J-T-V", "O-B-Q-U-S", + "B-P-U-S-M", "N-Z-D-O-V", "A-X-S-T-V", + "O-Y-C-F-K", "D-S-I-M-Y", "B-Y-N-G-I", + "G-P-U-M-F", "V-B-G-N-W", "C-K-I-S-Y", + "U-B-I-R-V", "L-R-M-C-Z", "T-Z-D-U-M", + "R-M-F-T-O", "S-V-D-F-Y", "M-F-R-C-J", + "G-P-O-X-W", "M-R-X-H-Z", "N-D-J-R-Y", + "B-J-W-U-L", "T-E-U-D-J", "M-V-J-R-B", + "G-X-Z-U-Y", "L-C-P-M-D", "H-Z-W-E-T", + "O-H-Y-C-K", "M-B-Q-N-E", "B-D-E-U-V", + "V-P-F-Y-R", "U-M-C-J-L", "P-X-L-Z-A", + "D-E-F-X-H", "P-I-Z-C-V", "V-N-O-B-G", + "M-T-U-D-P", "I-A-E-O-Q", "V-R-S-L-A", + "S-I-Q-N-T", "A-W-T-O-U", "O-T-V-A-Q", + "D-R-O-Z-F", "Z-M-F-Q-I", "B-H-E-L-M", + "Z-S-D-L-G", "E-B-N-A-Q", "K-Z-O-C-D", + "Y-J-M-C-Z", "K-O-F-A-G", "J-U-L-Y-G", + "A-F-C-V-D", "S-B-H-T-U", "J-F-V-T-Q", + "H-L-Z-K-M", "F-Q-O-K-S", "P-S-U-V-A", + "Y-L-E-D-F", "Z-L-U-K-V", "J-N-M-P-F", + "G-M-F-Y-Z", "W-P-N-D-U", "J-V-Q-H-P", + "Q-B-H-O-R", "U-R-J-K-W", "J-Q-S-O-F", + "S-J-N-T-O", "A-S-B-Q-W", "W-X-Q-H-I", + "K-R-V-S-X", "Q-S-O-R-W", "R-Q-N-G-Z", + "Z-P-A-S-R", "F-N-X-K-D", "S-I-X-A-W", + "K-E-J-H-G", "D-N-Z-W-U", "X-Y-T-J-O", + "X-I-J-Z-S", "R-V-L-W-C", "X-T-A-M-I", + "A-W-B-K-M", "E-C-Q-T-X", "A-B-V-W-X", + "K-O-B-W-Q", "V-Y-F-P-C", "H-O-E-X-D", + "I-Y-A-H-Q", "J-U-N-D-F", "O-V-N-P-Y", + "X-R-O-C-J", "W-I-D-R-M", "Q-C-O-H-N", + "L-Z-Y-W-T", "L-H-J-U-I", "X-M-E-R-U", + "R-J-K-Z-E", "Q-A-I-P-R", "A-D-L-Q-M", + "F-E-M-B-Z", "S-J-N-H-P", "I-Y-C-L-F", + "W-Y-O-N-I", "S-E-N-B-H", "K-Z-E-U-V", + "D-N-Y-Z-O", "Q-S-B-J-P", "J-N-V-T-B", + "U-H-Q-L-S", "U-C-N-Q-L", "A-L-R-Q-F", + "J-Y-K-P-L", "W-S-O-M-U", "L-P-S-U-T", + "U-V-P-F-M", "C-J-W-Q-N", "A-V-C-P-L", + "P-V-N-Y-E", "A-S-M-K-G", "T-U-I-W-H", + "E-K-G-P-M", "Z-F-O-H-E", "C-G-I-X-R", + "R-F-D-O-X", "C-R-F-M-Q", "H-F-M-N-W", + "M-Y-F-I-X", "A-B-U-X-S", "C-F-G-R-D", + "M-A-G-L-C", "W-L-Y-F-U", "U-M-C-R-H", + "A-C-P-Y-K", "A-E-V-C-P", "M-C-A-J-B", + "M-O-Z-G-A", "T-R-E-Y-M", "F-K-E-S-C", + "F-Q-B-J-T", "R-Y-D-V-B", "J-M-C-R-W", + "L-S-E-Z-R", "J-A-E-P-N", "Y-S-K-B-O", + "S-Y-N-G-C", "B-Q-I-W-H", "W-T-U-J-Y", + "O-J-W-G-C", "Q-B-G-I-F", "W-E-B-T-N", + "M-A-U-R-G", "Q-R-O-X-P", "H-T-Y-N-P", + "L-Q-A-G-X", "U-S-D-R-C", "I-J-F-R-Q", + "K-T-G-C-E", "M-K-P-C-T", "W-Z-L-N-K", + "B-O-G-U-P", "C-F-V-D-P", "G-A-P-R-X", + "E-I-Y-K-F", "W-H-G-P-S", "G-J-W-M-B", + "R-Y-B-F-L", "T-F-Y-Q-I", "R-L-O-C-F", + "I-X-S-G-O", "F-R-M-A-X", "H-B-L-Z-A", + "A-L-M-N-C", "F-D-Q-X-L", "Y-K-S-Q-D", + "I-Z-B-O-D", "R-M-A-S-C", "J-S-U-H-T", + "Q-B-A-P-Z", "I-D-X-Q-O", "F-H-S-W-Z", + "P-V-K-R-G", "L-B-A-H-I", "I-P-T-O-Q", + "N-F-K-Y-V", "T-U-M-A-G", "S-N-X-W-F", + "I-V-Y-O-C", "M-T-Z-G-O", "R-V-B-J-I", + "O-X-N-R-V", "W-N-M-F-J", "I-L-R-D-B", + "E-G-F-V-Z", "A-P-S-L-Y", "U-A-X-G-O", + "Y-D-B-O-M", "T-Q-K-M-D", "L-K-D-X-G", + "V-Z-J-A-C", "T-N-I-W-H", "Z-C-S-R-E", + "X-P-C-S-J", "O-A-F-C-R", "P-Z-X-W-E", + "N-L-Q-W-Z", "M-J-W-D-T", "R-S-Q-G-O", + "Z-C-Q-Y-S", "S-J-Y-R-V", "B-H-M-G-A", + "Y-K-D-O-N", "Y-F-G-W-J", "I-G-T-C-V", + "U-D-T-B-F", "N-Q-X-R-V", "F-O-N-L-V", + "R-C-X-F-I", "C-G-H-U-X", "T-I-J-W-G", + "U-B-G-O-Y", "G-C-H-Q-V", "S-U-D-A-H", + "F-B-S-I-H", "X-R-S-O-B", "M-H-C-E-K", + "Y-J-A-T-N", "Z-B-I-D-X", "R-I-U-E-B", + "C-S-O-V-X", "S-Y-G-E-M", "N-O-D-H-Z", + "U-D-V-T-S", "U-I-H-Q-M", "L-E-S-U-Y", + "L-Q-Y-W-P", "J-K-U-C-V", "A-Z-R-S-N", + "Z-F-A-Y-L", "C-L-G-R-I", "A-N-Q-C-Z", + "A-X-P-R-Z", "W-N-I-M-X", "O-I-L-B-N", + "P-U-Q-S-Y", "N-M-W-L-D", "D-V-X-C-R", + "P-G-J-I-X", "Y-G-C-T-H", "R-S-V-N-X", + "Y-H-O-Q-D", "Q-N-Y-Z-H", "D-Q-J-B-H", + "N-X-O-Z-T", "R-Q-B-X-J", "V-S-U-E-K", + "H-X-U-C-K", "W-X-E-I-P", "Z-H-J-N-L", + "A-R-N-V-H", "R-W-L-O-N", "Q-Z-K-E-G", + "M-X-L-W-F", "Z-R-L-K-J", "S-E-G-Y-N", + "R-H-K-V-L", "A-V-Q-R-I", "Z-L-J-B-O", + "W-S-R-C-V", "S-L-Q-M-R", "T-P-Y-A-K", + "W-R-H-U-O", "Z-B-Q-P-J", "I-H-Q-Y-U", + "W-K-U-I-S", "V-Y-N-M-W", "O-C-P-J-V", + "M-S-Z-W-G", "T-M-E-X-F", "E-W-A-P-N", + "Z-S-N-B-K", "G-D-X-R-V", "O-D-J-X-I", + "F-V-G-U-L", "R-U-I-Z-M", "G-E-O-L-I", + "K-T-B-F-X", "I-M-R-C-T", "B-Q-M-F-C", + "E-J-F-W-B", "W-P-N-H-G", "E-F-G-O-J", + "P-C-O-S-H", "C-L-A-N-W", "J-N-B-F-K", + "S-X-A-E-Z", "G-B-F-T-P", "K-C-G-D-E", + "T-I-O-G-U", "B-R-W-Q-Z", "L-C-R-G-N", + "F-A-B-V-G", "R-E-Q-W-L", "L-Z-J-H-S", + "E-R-L-D-N", "N-D-A-O-F", "V-O-A-C-L", + "A-J-S-M-W", "K-B-V-T-O", "J-D-P-K-L", + "J-Y-T-D-X", "Z-A-E-K-B", "L-D-R-Z-Q", + "O-X-L-B-G", "B-P-V-O-K", "Y-J-D-T-E", + "C-F-R-N-W", "U-Y-M-Q-E", "Y-O-V-X-H", + "Z-K-D-V-Q", "A-Q-B-P-S", "W-S-O-Z-B", + "W-D-U-F-S", "A-H-P-R-E", "W-N-V-J-K", + "D-F-U-Y-S", "O-A-G-P-V", "V-J-R-E-P", + "I-P-R-E-U", "F-T-C-O-G", "K-F-U-M-H", + "V-N-F-X-U", "E-R-C-H-B", "D-U-C-V-X", + "Q-Z-U-C-A", "B-G-I-O-T", "L-C-S-Z-M", + "S-Y-A-W-P", "K-M-D-G-N", "O-I-D-R-Q", + "D-P-J-Q-C", "T-N-I-B-L", "I-G-M-D-A", + "O-D-C-L-Y", "B-D-Q-H-F", "H-M-W-P-X", + "Z-Q-U-T-L", "K-F-I-O-R", "U-W-L-M-V", + "M-A-N-D-Y", "M-E-X-I-K", "Y-S-F-L-V", + "Q-Y-O-L-E", "T-K-G-A-O", "I-S-J-V-Q", + "J-K-P-B-G", "D-P-F-I-T", "I-Q-B-J-M", + "E-Q-H-V-W", "J-D-C-E-Q", "Q-U-V-D-J", + "G-D-S-Z-T", "U-M-X-Z-C", "Q-R-Z-G-W", + "R-C-L-Q-J", "E-I-O-V-W", "S-E-R-D-Q", + "V-J-E-D-T", "K-A-D-N-T", "P-C-R-Z-X", + "P-B-I-T-E", "H-W-Q-L-C", "C-J-K-E-G", + "R-Y-D-P-Q", "R-X-U-L-K", "R-T-Q-G-Y", + "X-H-J-T-D", "U-E-F-I-A", "L-K-O-C-M", + "K-Y-H-M-J", "T-M-K-L-Y", "B-D-U-L-P", + "D-G-N-F-H", "H-K-O-J-B", "L-A-C-X-D", + "L-D-P-Q-J", "A-F-T-U-R", "M-W-H-Q-V", + "T-F-J-S-G", "C-T-W-E-N", "K-U-F-A-D", + "S-U-Q-T-P", "K-V-Y-B-T", "E-V-Y-O-S", + "D-J-E-I-C", "Y-P-M-X-O", "Q-X-W-K-S", + "G-W-O-B-C", "A-V-G-B-D", "I-L-V-D-K", + "R-V-G-B-W", "Z-S-O-M-G", "B-A-C-X-W", + "S-P-X-G-Q", "A-I-S-C-B", "Q-N-S-J-P", + "E-T-W-J-B", "R-X-Y-T-E", "X-G-Z-V-S", + "C-M-B-A-N", "N-L-W-B-I", "R-H-E-F-X", + "E-U-I-Z-C", "N-F-E-Z-V", "T-S-O-J-F", + "R-U-B-S-K", "R-A-S-K-G", "O-F-K-R-V", + "N-X-J-A-M", "E-A-Z-T-X", "H-G-S-J-M", + "H-E-A-J-U", "N-Z-M-Q-O", "B-M-R-E-S", + "X-Y-Z-E-U", "W-I-H-R-J", "N-W-M-Y-Q", + "I-N-O-T-P", "C-N-T-H-W", "O-C-M-H-L", + "V-U-X-N-Q", "M-B-W-A-N", "H-Q-Z-B-L", + "H-E-C-O-Y", "A-D-W-F-Y", "C-G-L-M-O", + "A-D-U-O-C", "U-O-V-R-H", "Z-B-Y-G-L", + "L-X-C-E-P", "L-P-K-M-R", "A-F-T-M-B", + "E-Z-B-K-U", "D-F-E-A-Y", "J-A-R-M-O", + "T-N-I-U-X", "F-Q-B-D-J", "N-J-M-R-Z", + "Z-G-C-A-K", "U-G-V-X-H", "D-I-R-Z-W", + "E-O-M-R-T", "L-G-S-F-M", "A-J-C-K-N", + "Z-N-D-L-H", "X-Y-S-U-V", "B-Q-I-L-Y", + "J-C-D-Z-E", "S-U-K-T-G", "P-W-T-X-U", + "D-I-H-B-A", "Y-W-L-U-E", "F-O-A-S-V", + "B-H-R-Z-J", "B-V-C-Y-L", "Z-C-J-F-H", + "Z-Y-V-A-T", "R-F-D-E-Y", "J-O-L-A-M", + "L-B-Z-F-P", "X-P-S-D-R", "O-E-B-R-S", + "J-P-B-Q-X", "Q-E-Z-I-U", "Q-N-G-U-P", + "W-O-L-I-T", "D-O-B-K-Z", "Z-E-A-V-J", + "K-D-E-W-A", "Y-B-M-C-Z", "B-N-Y-J-O", + "L-U-F-E-J", "B-V-X-O-F", "V-X-S-A-P", + "L-B-Y-D-E", "E-U-D-V-T", "J-P-T-D-A", + "Q-C-R-X-V", "I-D-L-A-O", "R-G-Q-V-K", + "H-S-W-R-F", "C-E-F-Y-O", "S-P-B-Q-M", + "B-J-Z-F-Q", "U-E-C-P-Z", "D-H-O-E-B", + "G-J-L-R-S", "L-C-V-T-S", "R-V-W-K-I", + "A-M-X-W-P", "W-B-K-A-C", "P-O-I-L-S", + "A-K-T-B-Y", "K-B-X-R-T", "S-P-T-Q-W", + "D-Z-U-W-B", "L-S-E-H-Q", "G-F-W-U-N", + "J-T-E-Z-F", "V-X-N-T-B", "T-K-D-N-R", + "L-K-Q-I-T", "N-E-X-D-Q", "Y-B-S-X-A", + "S-D-W-J-Q", "U-H-J-W-I", "X-Z-A-J-B", + "E-S-D-O-H", "G-O-Y-N-Q", "U-F-I-B-A", + "M-H-W-C-O", "F-Z-C-B-M", "S-C-A-O-V", + "G-R-H-Q-U", "V-N-J-Q-P", "V-P-Y-M-U", + "R-J-O-Q-V", "G-C-U-E-I", "C-A-T-L-R", + "O-N-S-G-H", "P-Z-K-U-V", "R-Z-H-D-N", + "G-E-X-C-L", "Q-K-E-P-S", "N-K-I-H-A", + "A-N-T-R-M", "T-R-G-E-F", "I-B-T-S-D", + "G-R-J-L-W", "I-P-Y-K-L", "S-J-M-F-W", + "U-H-D-P-T", "A-D-H-M-B", "S-T-Z-P-U", + "N-I-G-R-S", "U-V-M-Q-S", "E-F-S-J-R", + "F-H-O-S-Z", "O-G-R-E-Z", "B-M-A-N-T", + "Z-H-D-L-Q", "Q-R-N-J-K", "C-X-H-Y-L", + "I-X-W-G-E", "T-B-M-Q-S", "A-H-Z-V-B", + "R-Z-M-X-G", "M-U-K-H-E", "G-B-L-A-W", + "R-X-T-S-F", "D-W-Q-M-S", "P-B-F-Q-K", + "R-H-I-J-V", "I-F-J-V-C", "U-T-K-R-F", + "P-T-L-U-R", "I-L-P-N-F", "D-H-K-X-J", + "A-Q-B-M-S", "B-V-L-Q-F", "C-H-K-V-A", + "T-Y-C-P-U", "B-U-P-Q-H", "M-H-Q-E-I", + "E-Z-S-U-K", "H-W-Q-R-M", "C-I-B-J-K", + "E-I-O-S-H", "Y-I-E-X-L", "S-Q-O-L-N", + "J-H-L-T-G", "H-M-Q-J-I", "V-I-Z-J-Q", + "B-G-R-J-P", "Z-I-W-B-O", "R-V-B-G-N", + "B-I-N-J-R", "F-T-W-M-L", "F-S-K-I-J", + "S-N-V-G-Z", "X-I-G-L-H", "K-B-X-V-A", + "F-M-A-H-N", "Y-Z-I-W-A", "P-M-R-C-Z", + "N-U-B-R-A", "wordZ2", "Var1", + "Var2", "Var3", "Var4", + "a", "b", "c", + "e", "f", "h", + "i", "Var5", "Var6", + "Var7", "col 1", "col 2", "g", "x" + ), uniqueCount = 2114L) + + + expect_equal(expected_shared_strings, wb$sharedStrings) +}) + +test_that("Loading multiple pivot tables: loadPivotTables.xlsx works",{ + ## loadPivotTables.xlsx is a file with 3 pivot tables and 2 of them have the same reference data (pivotCacheDefinition) + fl <- system.file("extdata", "loadPivotTables.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + + # Check that wb is correctly loaded + sheet_names <- c("iris", + "iris_pivot", + "penguins", + "penguins_pivot1", + "penguins_pivot2") + + expect_equal(wb$sheet_names, sheet_names) + + # Check number of 'pivotTables' + expect_equal(length(wb$pivotTables), + 3) + # Check number of 'pivotCacheDefinition' + expect_equal(length(wb$pivotDefinitions), + 2) +}) + +test_that("Load and saving a file with Threaded Comments works", { + ## loadThreadComment.xlsx is a simple xlsx file that uses Threaded Comment. + fl <- system.file("extdata", "loadThreadComment.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + # Check that wb can be saved without error + expect_silent(saveWorkbook(wb, file = temp_xlsx())) + +}) + +test_that("Read and save file with inlineStr", { + ## loadThreadComment.xlsx is a simple xlsx file that uses Threaded Comment. + fl <- system.file("extdata", "inlineStr.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + wb_df <- readWorkbook(wb) + + df <- data.frame( + this = c("is an xlsx file", "written with writexl::write_xlsx"), + it = c("cannot be read", "with open.xlsx::read.xlsx"), + stringsAsFactors = FALSE) + + # compare file imported with inlineStr + expect_true(all.equal(df, wb_df, compare.attributes = FALSE)) + + df_read_xlsx <- read.xlsx(fl) + df_readWorkbook <- readWorkbook(fl) + + expect_true(all.equal(df, df_read_xlsx, compare.attributes = FALSE)) + expect_true(all.equal(df, df_readWorkbook, compare.attributes = FALSE)) + + tmp_xlsx <- temp_xlsx() + # Check that wb can be saved without error and reimported + expect_silent(saveWorkbook(wb, file = tmp_xlsx)) + wb_df_re <- readWorkbook(loadWorkbook(tmp_xlsx)) + expect_true(all.equal(wb_df, wb_df_re, compare.attributes = FALSE)) + +}) + +# tests for getChildlessNode returns the content of every node, single node or not. the name has only historical meaning +test_that("read nodes", { + + # read single node + test <- "" + that <- openxlsx:::getChildlessNode(test, "xf") + expect_equal(test, that) + + # real life example and ... mixed + cellXfs <- "" + that <- openxlsx:::getChildlessNode(cellXfs, "xf") + test <- c("", + "", + "", + "", + "", + "", + "", + "", + "" + ) + expect_equal(test, that) + + # test + test <- "" + that <- openxlsx:::getChildlessNode(test, "xf") + expect_equal(character(0), that) + + # test + test <- "" + that <- openxlsx:::getChildlessNode(test, "b") + test <- c( + "", + "" + ) + expect_equal(test, that) + + # test ... + test <- "a" + that <- openxlsx:::getChildlessNode(test, "b") + test <- c("a", "") + expect_equal(test, that) + + # test + test <- "" + that <- openxlsx:::getChildlessNode(test, "xf") + test <- "" + expect_equal(test, that) + +}) + +test_that("sheet visibility", { + + # example is rather slow (lots of hidden cols) + fl <- system.file("extdata", "ColorTabs3.xlsx", package = "openxlsx") + tmp_dir <- temp_xlsx() + + exp_sheets <- c("Nums", "Chars", "hidden") + exp_vis <- c("visible", "visible", "hidden") + + # after load + wb <- loadWorkbook(fl) + wb_sheets <- openxlsx::sheets(wb) + wb_vis <- openxlsx::sheetVisibility(wb) + + # save + saveWorkbook(wb, tmp_dir) + + # re-import + wb2 <- loadWorkbook(tmp_dir) + wb2_sheets <- openxlsx::sheets(wb) + wb2_vis <- openxlsx::sheetVisibility(wb) + + expect_equal(exp_sheets, wb_sheets) + expect_equal(exp_vis, wb_vis) + + expect_equal(exp_sheets, wb2_sheets) + expect_equal(exp_vis, wb2_vis) + +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-loading_workbook_tables.R r-cran-openxlsx-4.2.5/tests/testthat/test-loading_workbook_tables.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-loading_workbook_tables.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-loading_workbook_tables.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,38 +1,38 @@ - - -context("Load Workbook Object Tables") - - -test_that("Tables loaded correctly", { - wb <- loadWorkbook(system.file("extdata", "loadExample.xlsx", package = "openxlsx")) - - expect_equal(unname(attr(wb$tables, "tableName")), c("Table2", "Table3")) - expect_equal(names(attr(wb$tables, "tableName")), c("A1:E51", "A1:K30")) - expect_equal(attr(wb$tables, "sheet"), c(1, 3)) - - expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), "Table2") - expect_equal(names(attr(wb$worksheets[[1]]$tableParts, "tableName")), "A1:E51") - - expect_equal(wb$worksheets[[3]]$tableParts, "", check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[3]]$tableParts, "tableName")), "Table3") - expect_equal(names(attr(wb$worksheets[[3]]$tableParts, "tableName")), "A1:K30") - - - ## now remove a table - expect_equal(unname(getTables(wb, 1)), "Table2", check.attributes = FALSE) - expect_equal(unname(getTables(wb, 3)), "Table3", check.attributes = FALSE) - - removeTable(wb, sheet = 1, table = "Table2") - - expect_equal(getTables(wb, sheet = 1), character(0), check.attributes = FALSE) - expect_equal(length(wb$worksheets[[1]]$tableParts), 0) - expect_equal(wb$worksheets[[1]]$tableParts, character(0), check.attributes = FALSE) - - expect_equal(wb$worksheets[[3]]$tableParts, "", check.attributes = FALSE) - expect_equal(unname(attr(wb$worksheets[[3]]$tableParts, "tableName")), "Table3") - expect_equal(names(attr(wb$worksheets[[3]]$tableParts, "tableName")), "A1:K30") - - - expect_error(removeTable(wb, sheet = 1, table = "Table2"), regexp = "table 'Table2' does not exist") -}) + + +context("Load Workbook Object Tables") + + +test_that("Tables loaded correctly", { + wb <- loadWorkbook(system.file("extdata", "loadExample.xlsx", package = "openxlsx")) + + expect_equal(unname(attr(wb$tables, "tableName")), c("Table2", "Table3")) + expect_equal(names(attr(wb$tables, "tableName")), c("A1:E51", "A1:K30")) + expect_equal(attr(wb$tables, "sheet"), c(1, 3)) + + expect_equal(wb$worksheets[[1]]$tableParts, "", check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[1]]$tableParts, "tableName")), "Table2") + expect_equal(names(attr(wb$worksheets[[1]]$tableParts, "tableName")), "A1:E51") + + expect_equal(wb$worksheets[[3]]$tableParts, "", check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[3]]$tableParts, "tableName")), "Table3") + expect_equal(names(attr(wb$worksheets[[3]]$tableParts, "tableName")), "A1:K30") + + + ## now remove a table + expect_equal(unname(getTables(wb, 1)), "Table2", check.attributes = FALSE) + expect_equal(unname(getTables(wb, 3)), "Table3", check.attributes = FALSE) + + removeTable(wb, sheet = 1, table = "Table2") + + expect_equal(getTables(wb, sheet = 1), character(0), check.attributes = FALSE) + expect_equal(length(wb$worksheets[[1]]$tableParts), 0) + expect_equal(wb$worksheets[[1]]$tableParts, character(0), check.attributes = FALSE) + + expect_equal(wb$worksheets[[3]]$tableParts, "", check.attributes = FALSE) + expect_equal(unname(attr(wb$worksheets[[3]]$tableParts, "tableName")), "Table3") + expect_equal(names(attr(wb$worksheets[[3]]$tableParts, "tableName")), "A1:K30") + + + expect_error(removeTable(wb, sheet = 1, table = "Table2"), regexp = "table 'Table2' does not exist") +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-loading_workbook_unzipped.R r-cran-openxlsx-4.2.5/tests/testthat/test-loading_workbook_unzipped.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-loading_workbook_unzipped.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-loading_workbook_unzipped.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,32 +1,32 @@ - - - - -context("Load Unzipped Workbook Object") - - -test_that("Loading unzipped readTest.xlsx", { - fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - wb <- loadWorkbook(fl) - - ## make unzipped file & load - tmp_dir <- file.path(tempdir(), paste(sample(LETTERS, 6), collapse = "")) - if (dir.exists(tmp_dir)) unlink(tmp_dir, recursive = TRUE) - dir.create(tmp_dir) - - unzip(zipfile = fl, exdir = tmp_dir) - wb2 <- loadWorkbook(file = tmp_dir, isUnzipped = TRUE) - - expect_true(all.equal(wb, wb2)) - - unlink(tmp_dir, recursive = TRUE) -}) - - - - - - - - -"" + + + + +context("Load Unzipped Workbook Object") + + +test_that("Loading unzipped readTest.xlsx", { + fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + + ## make unzipped file & load + tmp_dir <- file.path(tempdir(), paste(sample(LETTERS, 6), collapse = "")) + if (dir.exists(tmp_dir)) unlink(tmp_dir, recursive = TRUE) + dir.create(tmp_dir) + + unzip(zipfile = fl, exdir = tmp_dir) + wb2 <- loadWorkbook(file = tmp_dir, isUnzipped = TRUE) + + expect_true(all.equal(wb, wb2)) + + unlink(tmp_dir, recursive = TRUE) +}) + + + + + + + + +"" diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-load_read_file_read_equality.R r-cran-openxlsx-4.2.5/tests/testthat/test-load_read_file_read_equality.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-load_read_file_read_equality.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-load_read_file_read_equality.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,43 +1,43 @@ - - -context("Reading from workbook is identical to reading from file") - -test_that("Reading from loaded workbook", { - wb <- createWorkbook() - for (i in 1:4) { - addWorksheet(wb, sprintf("Sheet %s", i)) - } - - writeData(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = TRUE, startRow = 10, startCol = 5, borders = "all") - writeData(wb, sheet = 2, x = mtcars, colNames = TRUE, rowNames = FALSE, startRow = 10, startCol = 5, borders = "rows") - writeData(wb, sheet = 3, x = mtcars, colNames = FALSE, rowNames = TRUE, startRow = 2, startCol = 2, borders = "columns") - writeData(wb, sheet = 4, x = mtcars, colNames = FALSE, rowNames = FALSE, startRow = 12, startCol = 1, borders = "surrounding") - - tempFile <- temp_xlsx() - saveWorkbook(wb, tempFile, overwrite = TRUE) - - wb <- loadWorkbook(tempFile) - - ## colNames = TRUE, rowNames = TRUE - x <- read.xlsx(wb, 1, colNames = TRUE, rowNames = TRUE) - expect_equal(object = mtcars, expected = x, check.attributes = TRUE) - - - ## colNames = TRUE, rowNames = FALSE - x <- read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE) - expect_equal(object = mtcars, expected = x, check.attributes = FALSE) - expect_equal(object = colnames(mtcars), expected = colnames(x), check.attributes = FALSE) - - - ## colNames = FALSE, rowNames = TRUE - x <- read.xlsx(wb, sheet = 3, colNames = FALSE, rowNames = TRUE) - expect_equal(object = mtcars, expected = x, check.attributes = FALSE) - expect_equal(object = rownames(mtcars), expected = rownames(x)) - - - ## colNames = FALSE, rowNames = FALSE - x <- read.xlsx(wb, sheet = 4, colNames = FALSE, rowNames = FALSE) - expect_equal(object = mtcars, expected = x, check.attributes = FALSE) - - unlink(tempFile, recursive = TRUE, force = TRUE) -}) + + +context("Reading from workbook is identical to reading from file") + +test_that("Reading from loaded workbook", { + wb <- createWorkbook() + for (i in 1:4) { + addWorksheet(wb, sprintf("Sheet %s", i)) + } + + writeData(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = TRUE, startRow = 10, startCol = 5, borders = "all") + writeData(wb, sheet = 2, x = mtcars, colNames = TRUE, rowNames = FALSE, startRow = 10, startCol = 5, borders = "rows") + writeData(wb, sheet = 3, x = mtcars, colNames = FALSE, rowNames = TRUE, startRow = 2, startCol = 2, borders = "columns") + writeData(wb, sheet = 4, x = mtcars, colNames = FALSE, rowNames = FALSE, startRow = 12, startCol = 1, borders = "surrounding") + + tempFile <- temp_xlsx() + saveWorkbook(wb, tempFile, overwrite = TRUE) + + wb <- loadWorkbook(tempFile) + + ## colNames = TRUE, rowNames = TRUE + x <- read.xlsx(wb, 1, colNames = TRUE, rowNames = TRUE) + expect_equal(object = mtcars, expected = x, check.attributes = TRUE) + + + ## colNames = TRUE, rowNames = FALSE + x <- read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE) + expect_equal(object = mtcars, expected = x, check.attributes = FALSE) + expect_equal(object = colnames(mtcars), expected = colnames(x), check.attributes = FALSE) + + + ## colNames = FALSE, rowNames = TRUE + x <- read.xlsx(wb, sheet = 3, colNames = FALSE, rowNames = TRUE) + expect_equal(object = mtcars, expected = x, check.attributes = FALSE) + expect_equal(object = rownames(mtcars), expected = rownames(x)) + + + ## colNames = FALSE, rowNames = FALSE + x <- read.xlsx(wb, sheet = 4, colNames = FALSE, rowNames = FALSE) + expect_equal(object = mtcars, expected = x, check.attributes = FALSE) + + unlink(tempFile, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-named_regions.R r-cran-openxlsx-4.2.5/tests/testthat/test-named_regions.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-named_regions.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-named_regions.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,363 +1,414 @@ - -context("Named Regions") - -test_that("Maintaining Named Regions on Load", { - ## create named regions - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - addWorksheet(wb, "Sheet 2") - - ## specify region - writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) - createNamedRegion( - wb = wb, - sheet = 1, - name = "iris", - rows = seq_len(nrow(iris) + 1), - cols = seq_len(ncol(iris)) - ) - - ## using writeData 'name' argument - writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) - - ## Named region size 1 - writeData(wb, sheet = 2, x = 99, name = "region1", startCol = 3, startRow = 3) - - ## save file for testing - out_file <- temp_xlsx() - saveWorkbook(wb, out_file, overwrite = TRUE) - - expect_equal(object = getNamedRegions(wb), expected = getNamedRegions(out_file)) - - df1 <- read.xlsx(wb, namedRegion = "iris") - df2 <- read.xlsx(out_file, namedRegion = "iris") - expect_equal(df1, df2) - - df1 <- read.xlsx(wb, namedRegion = "region1") - expect_s3_class(df1, "data.frame") - expect_equal(nrow(df1), 0) - expect_equal(ncol(df1), 1) - - df1 <- read.xlsx(wb, namedRegion = "region1", colNames = FALSE) - expect_s3_class(df1, "data.frame") - expect_equal(nrow(df1), 1) - expect_equal(ncol(df1), 1) - - df1 <- read.xlsx(wb, namedRegion = "region1", rowNames = TRUE) - expect_s3_class(df1, "data.frame") - expect_equal(nrow(df1), 0) - expect_equal(ncol(df1), 0) -}) - -test_that("Correctly Loading Named Regions Created in Excel", { - - # Load an excel workbook (in the repo, it's located in the /inst folder; - # when installed on the user's system, it is located in the installation folder - # of the package) - filename <- system.file("extdata", "namedRegions.xlsx", package = "openxlsx") - - # Load this workbook. We will test read.xlsx by passing both the object wb and - # the filename. Both should produce the same results. - wb <- loadWorkbook(filename) - - # NamedTable refers to Sheet1!$C$5:$D$8 - table_f <- read.xlsx(filename, - namedRegion = "NamedTable" - ) - table_w <- read.xlsx(wb, - namedRegion = "NamedTable" - ) - - expect_equal(object = table_f, expected = table_w) - expect_equal(object = class(table_f), expected = "data.frame") - expect_equal(object = ncol(table_f), expected = 2) - expect_equal(object = nrow(table_f), expected = 3) - - # NamedCell refers to Sheet1!$C$2 - # This proeduced an error in an earlier version of the pacage when the object - # wb was passed, but worked correctly when the filename was passed to read.xlsx - cell_f <- read.xlsx(filename, - namedRegion = "NamedCell", - colNames = FALSE, - rowNames = FALSE - ) - - cell_w <- read.xlsx(wb, - namedRegion = "NamedCell", - colNames = FALSE, - rowNames = FALSE - ) - - expect_equal(object = cell_f, expected = cell_w) - expect_equal(object = class(cell_f), expected = "data.frame") - expect_equal(object = ncol(cell_f), expected = 1) - expect_equal(object = nrow(cell_f), expected = 1) - - # NamedCell2 refers to Sheet1!$C$2:$C$2 - cell2_f <- read.xlsx(filename, - namedRegion = "NamedCell2", - colNames = FALSE, - rowNames = FALSE - ) - - cell2_w <- read.xlsx(wb, - namedRegion = "NamedCell2", - colNames = FALSE, - rowNames = FALSE - ) - - expect_equal(object = cell2_f, expected = cell2_w) - expect_equal(object = class(cell2_f), expected = "data.frame") - expect_equal(object = ncol(cell2_f), expected = 1) - expect_equal(object = nrow(cell2_f), expected = 1) -}) - - -test_that("Load names from an Excel file with funky non-region names", { - filename <- system.file("extdata", "namedRegions2.xlsx", package = "openxlsx") - wb <- loadWorkbook(filename) - names <- getNamedRegions(wb) - sheets <- attr(names, "sheet") - positions <- attr(names, "position") - - expect_true(length(names) == length(sheets)) - expect_true(length(names) == length(positions)) - expect_equal( - head(names, 5), - c("barref", "barref", "fooref", "fooref", "IQ_CH") - ) - expect_equal( - sheets, - c( - "Sheet with space", "Sheet1", "Sheet with space", "Sheet1", - rep("", 26) - ) - ) - expect_equal(positions, c("B4", "B4", "B3", "B3", rep("", 26))) - - names2 <- getNamedRegions(filename) - expect_equal(names, names2) -}) - - -test_that("Missing rows in named regions", { - temp_file <- temp_xlsx() - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - - ## create region - writeData(wb, sheet = 1, x = iris[1:11, ], startCol = 1, startRow = 1) - deleteData(wb, sheet = 1, col = 1:2, rows = c(6, 6)) - - createNamedRegion( - wb = wb, - sheet = 1, - name = "iris", - rows = 1:(5 + 1), - cols = 1:2 - ) - createNamedRegion( - wb = wb, - sheet = 1, - name = "iris2", - rows = 1:(5 + 2), - cols = 1:2 - ) - - ## iris region is rows 1:6 & cols 1:2 - ## iris2 region is rows 1:7 & cols 1:2 - - ## row 6 columns 1 & 2 are blank - expect_equal(getNamedRegions(wb)[1:2], c("iris", "iris2"), ignore.attributes = TRUE) - expect_equal(attr(getNamedRegions(wb), "sheet"), c("Sheet 1", "Sheet 1")) - expect_equal(attr(getNamedRegions(wb), "position"), c("A1:B6", "A1:B7")) - - ######################################################################## from Workbook - - ## Skip empty rows - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyRows = TRUE) - expect_equal(dim(x), c(4, 2)) - - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = TRUE) - expect_equal(dim(x), c(5, 2)) - - - ## Keep empty rows - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyRows = FALSE) - expect_equal(dim(x), c(5, 2)) - - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = FALSE) - expect_equal(dim(x), c(6, 2)) - - - - ######################################################################## from file - saveWorkbook(wb, file = temp_file, overwrite = TRUE) - - ## Skip empty rows - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyRows = TRUE) - expect_equal(dim(x), c(4, 2)) - - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = TRUE) - expect_equal(dim(x), c(5, 2)) - - - ## Keep empty rows - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyRows = FALSE) - expect_equal(dim(x), c(5, 2)) - - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = FALSE) - expect_equal(dim(x), c(6, 2)) - - unlink(temp_file) -}) - - - - - -test_that("Missing columns in named regions", { - temp_file <- temp_xlsx() - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - - ## create region - writeData(wb, sheet = 1, x = iris[1:11, ], startCol = 1, startRow = 1) - deleteData(wb, sheet = 1, col = 2, rows = 1:12, gridExpand = TRUE) - - createNamedRegion( - wb = wb, - sheet = 1, - name = "iris", - rows = 1:5, - cols = 1:2 - ) - - createNamedRegion( - wb = wb, - sheet = 1, - name = "iris2", - rows = 1:5, - cols = 1:3 - ) - - ## iris region is rows 1:5 & cols 1:2 - ## iris2 region is rows 1:5 & cols 1:3 - - ## row 6 columns 1 & 2 are blank - expect_equal(getNamedRegions(wb)[1:2], c("iris", "iris2"), ignore.attributes = TRUE) - expect_equal(attr(getNamedRegions(wb), "sheet"), c("Sheet 1", "Sheet 1")) - expect_equal(attr(getNamedRegions(wb), "position"), c("A1:B5", "A1:C5")) - - ######################################################################## from Workbook - - ## Skip empty cols - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyCols = TRUE) - expect_equal(dim(x), c(4, 1)) - - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = TRUE) - expect_equal(dim(x), c(4, 2)) - - - ## Keep empty cols - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyCols = FALSE) - expect_equal(dim(x), c(4, 1)) - - x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = FALSE) - expect_equal(dim(x), c(4, 3)) - - - - ######################################################################## from file - saveWorkbook(wb, file = temp_file, overwrite = TRUE) - - ## Skip empty cols - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyCols = TRUE) - expect_equal(dim(x), c(4, 1)) - - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = TRUE) - expect_equal(dim(x), c(4, 2)) - - - ## Keep empty cols - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyCols = FALSE) - expect_equal(dim(x), c(4, 1)) - - x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = FALSE) - expect_equal(dim(x), c(4, 3)) - - unlink(temp_file) -}) - - - - - -test_that("Matching Substrings breaks reading named regions", { - temp_file <- temp_xlsx() - - wb <- createWorkbook() - addWorksheet(wb, "table") - addWorksheet(wb, "table2") - - t1 <- head(iris) - t1$Species <- as.character(t1$Species) - t2 <- head(mtcars) - - writeData(wb, sheet = "table", x = t1, name = "t", startCol = 3, startRow = 12) - writeData(wb, sheet = "table2", x = t2, name = "t2", startCol = 5, startRow = 24, rowNames = TRUE) - - writeData(wb, sheet = "table", x = head(t1, 3), name = "t1", startCol = 9, startRow = 3) - writeData(wb, sheet = "table2", x = head(t2, 3), name = "t22", startCol = 15, startRow = 12, rowNames = TRUE) - - saveWorkbook(wb, file = temp_file, overwrite = TRUE) - - r1 <- getNamedRegions(wb) - expect_equal(attr(r1, "sheet"), c("table", "table2", "table", "table2")) - expect_equal(attr(r1, "position"), c("C12:G18", "E24:P30", "I3:M6", "O12:Z15")) - expect_equal(r1, c("t", "t2", "t1", "t22"), check.attributes = FALSE) - - r2 <- getNamedRegions(temp_file) - expect_equal(attr(r2, "sheet"), c("table", "table2", "table", "table2")) - expect_equal(attr(r1, "position"), c("C12:G18", "E24:P30", "I3:M6", "O12:Z15")) - expect_equal(r2, c("t", "t2", "t1", "t22"), check.attributes = FALSE) - - - ## read file named region - expect_equal(t1, read.xlsx(xlsxFile = temp_file, namedRegion = "t")) - expect_equal(t2, read.xlsx(xlsxFile = temp_file, namedRegion = "t2", rowNames = TRUE)) - expect_equal(head(t1, 3), read.xlsx(xlsxFile = temp_file, namedRegion = "t1")) - expect_equal(head(t2, 3), read.xlsx(xlsxFile = temp_file, namedRegion = "t22", rowNames = TRUE)) - - ## read Workbook named region - expect_equal(t1, read.xlsx(xlsxFile = wb, namedRegion = "t")) - expect_equal(t2, read.xlsx(xlsxFile = wb, namedRegion = "t2", rowNames = TRUE)) - expect_equal(head(t1, 3), read.xlsx(xlsxFile = wb, namedRegion = "t1")) - expect_equal(head(t2, 3), read.xlsx(xlsxFile = wb, namedRegion = "t22", rowNames = TRUE)) - - - - unlink(temp_file) -}) - - -test_that("Read namedRegion from specific sheet", { - - filename <- system.file("extdata", "namedRegions3.xlsx", package = "openxlsx") - - namedR <- "MyRange" - sheets <- openxlsx::getSheetNames(filename) - - # read the correct sheets - expect_equal(data.frame(X1 = "S1A1", X2 = "S1B1", stringsAsFactors = FALSE), read.xlsx(filename, sheet = "Sheet1", namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) - expect_equal(data.frame(X1 = "S2A1", X2 = "S2B1", stringsAsFactors = FALSE), read.xlsx(filename, sheet = which(sheets %in% "Sheet2"), namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) - expect_equal(data.frame(X1 = "S3A1", X2 = "S3B1", stringsAsFactors = FALSE), read.xlsx(filename, sheet = "Sheet3", namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) - - # Warning: Workbook has no such named region. (Wrong namedRegion selected.) - expect_warning(read.xlsx(filename, sheet = "Sheet2", namedRegion = "MyRage", rowNames = FALSE, colNames = FALSE)) - - # Warning: Workbook has no such named region on this sheet. (Correct namedRegion, but wrong sheet selected.) - expect_warning(read.xlsx(filename, sheet = "Sheet4", namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) -}) + +context("Named Regions") + +test_that("Maintaining Named Regions on Load", { + ## create named regions + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + addWorksheet(wb, "Sheet 2") + + ## specify region + writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1) + createNamedRegion( + wb = wb, + sheet = 1, + name = "iris", + rows = seq_len(nrow(iris) + 1), + cols = seq_len(ncol(iris)) + ) + + ## using writeData 'name' argument + writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10) + + ## Named region size 1 + writeData(wb, sheet = 2, x = 99, name = "region1", startCol = 3, startRow = 3) + + ## save file for testing + out_file <- temp_xlsx() + saveWorkbook(wb, out_file, overwrite = TRUE) + + expect_equal(object = getNamedRegions(wb), expected = getNamedRegions(out_file)) + + df1 <- read.xlsx(wb, namedRegion = "iris") + df2 <- read.xlsx(out_file, namedRegion = "iris") + expect_equal(df1, df2) + + df1 <- read.xlsx(wb, namedRegion = "region1") + expect_s3_class(df1, "data.frame") + expect_equal(nrow(df1), 0) + expect_equal(ncol(df1), 1) + + df1 <- read.xlsx(wb, namedRegion = "region1", colNames = FALSE) + expect_s3_class(df1, "data.frame") + expect_equal(nrow(df1), 1) + expect_equal(ncol(df1), 1) + + df1 <- read.xlsx(wb, namedRegion = "region1", rowNames = TRUE) + expect_s3_class(df1, "data.frame") + expect_equal(nrow(df1), 0) + expect_equal(ncol(df1), 0) +}) + +test_that("Correctly Loading Named Regions Created in Excel", { + + # Load an excel workbook (in the repo, it's located in the /inst folder; + # when installed on the user's system, it is located in the installation folder + # of the package) + filename <- system.file("extdata", "namedRegions.xlsx", package = "openxlsx") + + # Load this workbook. We will test read.xlsx by passing both the object wb and + # the filename. Both should produce the same results. + wb <- loadWorkbook(filename) + + # NamedTable refers to Sheet1!$C$5:$D$8 + table_f <- read.xlsx(filename, + namedRegion = "NamedTable" + ) + table_w <- read.xlsx(wb, + namedRegion = "NamedTable" + ) + + expect_equal(object = table_f, expected = table_w) + expect_equal(object = class(table_f), expected = "data.frame") + expect_equal(object = ncol(table_f), expected = 2) + expect_equal(object = nrow(table_f), expected = 3) + + # NamedCell refers to Sheet1!$C$2 + # This proeduced an error in an earlier version of the pacage when the object + # wb was passed, but worked correctly when the filename was passed to read.xlsx + cell_f <- read.xlsx(filename, + namedRegion = "NamedCell", + colNames = FALSE, + rowNames = FALSE + ) + + cell_w <- read.xlsx(wb, + namedRegion = "NamedCell", + colNames = FALSE, + rowNames = FALSE + ) + + expect_equal(object = cell_f, expected = cell_w) + expect_equal(object = class(cell_f), expected = "data.frame") + expect_equal(object = ncol(cell_f), expected = 1) + expect_equal(object = nrow(cell_f), expected = 1) + + # NamedCell2 refers to Sheet1!$C$2:$C$2 + cell2_f <- read.xlsx(filename, + namedRegion = "NamedCell2", + colNames = FALSE, + rowNames = FALSE + ) + + cell2_w <- read.xlsx(wb, + namedRegion = "NamedCell2", + colNames = FALSE, + rowNames = FALSE + ) + + expect_equal(object = cell2_f, expected = cell2_w) + expect_equal(object = class(cell2_f), expected = "data.frame") + expect_equal(object = ncol(cell2_f), expected = 1) + expect_equal(object = nrow(cell2_f), expected = 1) +}) + + +test_that("Load names from an Excel file with funky non-region names", { + filename <- system.file("extdata", "namedRegions2.xlsx", package = "openxlsx") + wb <- loadWorkbook(filename) + names <- getNamedRegions(wb) + sheets <- attr(names, "sheet") + positions <- attr(names, "position") + + expect_true(length(names) == length(sheets)) + expect_true(length(names) == length(positions)) + expect_equal( + head(names, 5), + c("barref", "barref", "fooref", "fooref", "IQ_CH") + ) + expect_equal( + sheets, + c( + "Sheet with space", "Sheet1", "Sheet with space", "Sheet1", + rep("", 26) + ) + ) + expect_equal(positions, c("B4", "B4", "B3", "B3", rep("", 26))) + + names2 <- getNamedRegions(filename) + expect_equal(names, names2) +}) + + +test_that("Missing rows in named regions", { + temp_file <- temp_xlsx() + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + ## create region + writeData(wb, sheet = 1, x = iris[1:11, ], startCol = 1, startRow = 1) + deleteData(wb, sheet = 1, cols = 1:2, rows = c(6, 6)) + + createNamedRegion( + wb = wb, + sheet = 1, + name = "iris", + rows = 1:(5 + 1), + cols = 1:2 + ) + createNamedRegion( + wb = wb, + sheet = 1, + name = "iris2", + rows = 1:(5 + 2), + cols = 1:2 + ) + + ## iris region is rows 1:6 & cols 1:2 + ## iris2 region is rows 1:7 & cols 1:2 + + ## row 6 columns 1 & 2 are blank + expect_equal(getNamedRegions(wb)[1:2], c("iris", "iris2"), ignore.attributes = TRUE) + expect_equal(attr(getNamedRegions(wb), "sheet"), c("Sheet 1", "Sheet 1")) + expect_equal(attr(getNamedRegions(wb), "position"), c("A1:B6", "A1:B7")) + + ######################################################################## from Workbook + + ## Skip empty rows + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyRows = TRUE) + expect_equal(dim(x), c(4, 2)) + + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = TRUE) + expect_equal(dim(x), c(5, 2)) + + + ## Keep empty rows + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyRows = FALSE) + expect_equal(dim(x), c(5, 2)) + + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = FALSE) + expect_equal(dim(x), c(6, 2)) + + + + ######################################################################## from file + saveWorkbook(wb, file = temp_file, overwrite = TRUE) + + ## Skip empty rows + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyRows = TRUE) + expect_equal(dim(x), c(4, 2)) + + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = TRUE) + expect_equal(dim(x), c(5, 2)) + + + ## Keep empty rows + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyRows = FALSE) + expect_equal(dim(x), c(5, 2)) + + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyRows = FALSE) + expect_equal(dim(x), c(6, 2)) + + unlink(temp_file) +}) + + + + + +test_that("Missing columns in named regions", { + temp_file <- temp_xlsx() + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + ## create region + writeData(wb, sheet = 1, x = iris[1:11, ], startCol = 1, startRow = 1) + deleteData(wb, sheet = 1, cols = 2, rows = 1:12, gridExpand = TRUE) + + createNamedRegion( + wb = wb, + sheet = 1, + name = "iris", + rows = 1:5, + cols = 1:2 + ) + + createNamedRegion( + wb = wb, + sheet = 1, + name = "iris2", + rows = 1:5, + cols = 1:3 + ) + + ## iris region is rows 1:5 & cols 1:2 + ## iris2 region is rows 1:5 & cols 1:3 + + ## row 6 columns 1 & 2 are blank + expect_equal(getNamedRegions(wb)[1:2], c("iris", "iris2"), ignore.attributes = TRUE) + expect_equal(attr(getNamedRegions(wb), "sheet"), c("Sheet 1", "Sheet 1")) + expect_equal(attr(getNamedRegions(wb), "position"), c("A1:B5", "A1:C5")) + + ######################################################################## from Workbook + + ## Skip empty cols + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyCols = TRUE) + expect_equal(dim(x), c(4, 1)) + + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = TRUE) + expect_equal(dim(x), c(4, 2)) + + + ## Keep empty cols + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris", colNames = TRUE, skipEmptyCols = FALSE) + expect_equal(dim(x), c(4, 1)) + + x <- read.xlsx(xlsxFile = wb, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = FALSE) + expect_equal(dim(x), c(4, 3)) + + + + ######################################################################## from file + saveWorkbook(wb, file = temp_file, overwrite = TRUE) + + ## Skip empty cols + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyCols = TRUE) + expect_equal(dim(x), c(4, 1)) + + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = TRUE) + expect_equal(dim(x), c(4, 2)) + + + ## Keep empty cols + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris", colNames = TRUE, skipEmptyCols = FALSE) + expect_equal(dim(x), c(4, 1)) + + x <- read.xlsx(xlsxFile = temp_file, namedRegion = "iris2", colNames = TRUE, skipEmptyCols = FALSE) + expect_equal(dim(x), c(4, 3)) + + unlink(temp_file) +}) + + + + + +test_that("Matching Substrings breaks reading named regions", { + temp_file <- temp_xlsx() + + wb <- createWorkbook() + addWorksheet(wb, "table") + addWorksheet(wb, "table2") + + t1 <- head(iris) + t1$Species <- as.character(t1$Species) + t2 <- head(mtcars) + + writeData(wb, sheet = "table", x = t1, name = "t", startCol = 3, startRow = 12) + writeData(wb, sheet = "table2", x = t2, name = "t2", startCol = 5, startRow = 24, rowNames = TRUE) + + writeData(wb, sheet = "table", x = head(t1, 3), name = "t1", startCol = 9, startRow = 3) + writeData(wb, sheet = "table2", x = head(t2, 3), name = "t22", startCol = 15, startRow = 12, rowNames = TRUE) + + saveWorkbook(wb, file = temp_file, overwrite = TRUE) + + r1 <- getNamedRegions(wb) + expect_equal(attr(r1, "sheet"), c("table", "table2", "table", "table2")) + expect_equal(attr(r1, "position"), c("C12:G18", "E24:P30", "I3:M6", "O12:Z15")) + expect_equal(r1, c("t", "t2", "t1", "t22"), check.attributes = FALSE) + + r2 <- getNamedRegions(temp_file) + expect_equal(attr(r2, "sheet"), c("table", "table2", "table", "table2")) + expect_equal(attr(r1, "position"), c("C12:G18", "E24:P30", "I3:M6", "O12:Z15")) + expect_equal(r2, c("t", "t2", "t1", "t22"), check.attributes = FALSE) + + + ## read file named region + expect_equal(t1, read.xlsx(xlsxFile = temp_file, namedRegion = "t")) + expect_equal(t2, read.xlsx(xlsxFile = temp_file, namedRegion = "t2", rowNames = TRUE)) + expect_equal(head(t1, 3), read.xlsx(xlsxFile = temp_file, namedRegion = "t1")) + expect_equal(head(t2, 3), read.xlsx(xlsxFile = temp_file, namedRegion = "t22", rowNames = TRUE)) + + ## read Workbook named region + expect_equal(t1, read.xlsx(xlsxFile = wb, namedRegion = "t")) + expect_equal(t2, read.xlsx(xlsxFile = wb, namedRegion = "t2", rowNames = TRUE)) + expect_equal(head(t1, 3), read.xlsx(xlsxFile = wb, namedRegion = "t1")) + expect_equal(head(t2, 3), read.xlsx(xlsxFile = wb, namedRegion = "t22", rowNames = TRUE)) + + + + unlink(temp_file) +}) + + +test_that("Read namedRegion from specific sheet", { + + filename <- system.file("extdata", "namedRegions3.xlsx", package = "openxlsx") + + namedR <- "MyRange" + sheets <- openxlsx::getSheetNames(filename) + + # read the correct sheets + expect_equal(data.frame(X1 = "S1A1", X2 = "S1B1", stringsAsFactors = FALSE), read.xlsx(filename, sheet = "Sheet1", namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) + expect_equal(data.frame(X1 = "S2A1", X2 = "S2B1", stringsAsFactors = FALSE), read.xlsx(filename, sheet = which(sheets %in% "Sheet2"), namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) + expect_equal(data.frame(X1 = "S3A1", X2 = "S3B1", stringsAsFactors = FALSE), read.xlsx(filename, sheet = "Sheet3", namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) + + # Warning: Workbook has no such named region. (Wrong namedRegion selected.) + expect_warning(read.xlsx(filename, sheet = "Sheet2", namedRegion = "MyRage", rowNames = FALSE, colNames = FALSE)) + + # Warning: Workbook has no such named region on this sheet. (Correct namedRegion, but wrong sheet selected.) + expect_warning(read.xlsx(filename, sheet = "Sheet4", namedRegion = namedR, rowNames = FALSE, colNames = FALSE)) +}) + +test_that("Overwrite and delete named regions", { + temp_file <- temp_xlsx() + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + ## create region + writeData(wb, sheet = 1, x = iris[1:11, ], startCol = 1, + startRow = 1, name = "iris") + + + + init_nr <- getNamedRegions(wb) + expect_equal(attr(init_nr, "position"), "A1:E12") + + # no overwrite + expect_error({ + writeData(wb, sheet = 1, x = iris[1:11, ], startCol = 1, + startRow = 1, name = "iris") + }) + + expect_error({ + createNamedRegion( + wb = wb, + sheet = 1, + name = "iris", + rows = 1:5, + cols = 1:2 + ) + }) + + # overwrite + createNamedRegion( + wb = wb, + sheet = 1, + name = "iris", + rows = 1:5, + cols = 1:2, + overwrite = TRUE + ) + + # check midification + modify_nr <- getNamedRegions(wb) + expect_equal(attr(modify_nr, "position"), "A1:B5") + expect_true("iris" %in% modify_nr) + + # delete name region + deleteNamedRegion(wb, "iris") + expect_false("iris" %in% getNamedRegions(wb)) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-options.R r-cran-openxlsx-4.2.5/tests/testthat/test-options.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-options.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-options.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,30 +1,51 @@ -test_that("option names are appropriate", { - bad <- grep("^openxlsx[.].*", names(op.openxlsx), value = TRUE, invert = TRUE) - expect_equal(bad, character(0)) -}) - -test_that("changing options", { - op <- options() - on.exit(options(op), add = TRUE) - - # Set via options() - options(openxlsx.border = "whatever") - expect_equal(openxlsx_getOp("borders"), getOption("openxlsx.borders")) - - options(openxlsx.tableStyle = "Cool format") - expect_equal(openxlsx_getOp("tableStyle"), openxlsx_getOp("openxlsx.tableStyle")) - - # Setting to NULL will return default - options(openxlsx.border = NULL) - expect_equal(openxlsx_getOp("borders"), op.openxlsx[["openxlsx.borders"]]) - - # Bad options names will trigger warning but still be produced - options(openxlsx.likelyNotARealOption = TRUE) - expect_warning( - expect_true(openxlsx_getOp("likelyNotARealOption")), - "not a standard openxlsx option" - ) - - # Multiple Ops returns error - expect_error(openxlsx_getOp(c("withFilter", "borders")), "length 1") -}) + +test_that("option names are appropriate", { + bad <- grep("^openxlsx[.].*", names(op.openxlsx), value = TRUE, invert = TRUE) + expect_equal(bad, character(0)) +}) + +test_that("changing options", { + op <- options() + + # Set via options() + options(openxlsx.borders = "whatever") + expect_equal(openxlsx_getOp("borders"), getOption("openxlsx.borders")) + expect_equal(openxlsx_getOp("borders"), "whatever") + + # Set via openxlsx_setOp() + openxlsx_setOp("borders", "new_whatever") + expect_equal(openxlsx_getOp("borders"), getOption("openxlsx.borders")) + expect_equal(openxlsx_getOp("borders"), "new_whatever") + + # with openxlsx. prefix + openxlsx_setOp("openxlsx.borders", "new_new_whatever") + expect_equal(openxlsx_getOp("openxlsx.borders"), getOption("openxlsx.borders")) + expect_equal(openxlsx_getOp("openxlsx.borders"), "new_new_whatever") + + options(openxlsx.tableStyle = "Cool format") + expect_equal(openxlsx_getOp("tableStyle"), openxlsx_getOp("openxlsx.tableStyle")) + + # Setting to NULL will return default + options(openxlsx.borders = NULL) + expect_equal(openxlsx_getOp("borders"), op.openxlsx[["openxlsx.borders"]]) + + # Bad options names will trigger warning but still be produced + options(openxlsx.likelyNotARealOption = TRUE) + expect_warning( + expect_true(openxlsx_getOp("likelyNotARealOption")), + "not a standard openxlsx option" + ) + + # Multiple Ops returns error + expect_error(openxlsx_getOp(c("withFilter", "borders")), "length 1") + + openxlsx_resetOp() + options(op) +}) + +test_that("openxlsx_setOp() works with list [#215]", { + op <- options() + expect_error(openxlsx_setOp(list(withFilter = TRUE, keepNA = TRUE)), NA) + openxlsx_resetOp() + options(op) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-outlines.R r-cran-openxlsx-4.2.5/tests/testthat/test-outlines.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-outlines.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-outlines.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,141 +1,141 @@ -context("Workbook groupings") - -# groupRows() requires assigning to wb to global environment -# For reference, see here: https://github.com/r-lib/testthat/issues/720 - -test_that("group columns", { - - # Grouping then setting widths updates hidden - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - groupColumns(wb, "Sheet 1", 2:3, hidden = T) - setColWidths(wb, "Sheet 1", 2, widths = "18", hidden = F) - - expect_equal(attr(wb$colOutlineLevels[[1]], "hidden")[attr(wb$colOutlineLevels[[1]], "names") == 2], "0") - - # Setting column widths then grouping - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - setColWidths(wb, "Sheet 1", 2:3, widths = "18", hidden = F) - groupColumns(wb, "Sheet 1", 1:2, hidden = T) - - expect_equal(attr(wb$colWidths[[1]], "hidden")[attr(wb$colWidths[[1]], "names") == 2], "1") -}) - - -test_that("group rows", { - - wb <- createWorkbook() - assign("wb", wb, envir = .GlobalEnv) - addWorksheet(wb, "Sheet 1") - groupRows(wb, "Sheet 1", 1:4, hidden = T) - - expect_equal(names(wb$outlineLevels[[1]]), c("1", "2", "3", "4")) - expect_equal(unique(attr(wb$outlineLevels[[1]], "hidden")), "1") - rm(wb) -}) - - -test_that("ungroup columns", { - - # OutlineLevelCol is removed from SheetFormatPr when no - # column groupings left - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - setColWidths(wb, "Sheet 1", 2:3, widths = "18", hidden = F) - groupColumns(wb, "Sheet 1", 1:3, hidden = T) - ungroupColumns(wb, "Sheet 1", 1:3) - - expect_equal(unique(attr(wb$colWidths[[1]], "hidden")[attr(wb$colWidths[[1]], "names") %in% c(2, 3)]), "0") -}) - - -test_that("ungroup rows", { - wb <- createWorkbook() - assign("wb", wb, envir = .GlobalEnv) - addWorksheet(wb, "Sheet 1") - groupRows(wb, "Sheet 1", 1:3, hidden = T) - ungroupRows(wb, "Sheet 1", 1:3) - - expect_equal(length(wb$outlineLevels[[1]]), 0L) - rm(wb) -}) - - -test_that("loading workbook preserves outlines", { - fl <- system.file("extdata", "groupTest.xlsx", package = "openxlsx") - wb <- loadWorkbook(fl) - - expect_equal(names(wb$colOutlineLevels[[1]]), c("2", "3", "4")) - expect_equal(names(wb$outlineLevels[[1]]), c("3", "4")) - expect_equal(unique(attr(wb$outlineLevels[[1]], "hidden")[names(wb$outlineLevels[[1]]) %in% c("3", "4")]), "true") - - wbb <- createWorkbook() - - addWorksheet(wbb, sheetName = "Test", gridLines = FALSE, tabColour = "deepskyblue") - - writeData(wbb, sheet = "Test", x = c(colA = "testcol1", colB = "testcol2")) - - groupColumns(wbb, "Test", cols = 2:3, hidden = FALSE) - setColWidths(wbb, sheet = "Test", cols=c(1:5), widths = c(9,9,9,9,9)) - groupColumns(wbb, "Test", cols = 5:10, hidden = FALSE) - setColWidths(wbb, "Test", cols = 15:20, widths = 9) - - tf <- temp_xlsx("test") - tf2 <- temp_xlsx("test2") - - saveWorkbook(wbb, tf, overwrite = T) - test <- wbb$worksheets[[1]]$copy() - - wb <- loadWorkbook(tf) - saveWorkbook(wb, tf2, overwrite = T) - - testthat::expect_equal(wb$worksheets[[1]], test) - - unlink(c("tf", "tf2"), recursive = TRUE, force = TRUE) -}) - - -test_that("Grouping after setting colwidths has correct length of hidden attributes", { - # Issue #100 - https://github.com/ycphs/openxlsx/issues/100 - - wb <- createWorkbook(title = "column width and grouping error") - addWorksheet(wb, sheetName = 1) - - setColWidths( - wb, - sheet = 1, - cols = 1:100, - widths = 8 - ) - - groupColumns(wb, sheet = 1, cols = 20:100, hidden = TRUE) - - expect_equal(length(wb$colOutlineLevels[[1]]), length(attr(wb$colOutlineLevels[[1]], "hidden"))) -}) - -test_that("Consecutive calls to saveWorkbook doesn't corrupt attributes", { - - wbb <- createWorkbook() - - addWorksheet(wbb, sheetName = "Test", gridLines = FALSE, tabColour = "deepskyblue") - - writeData(wbb, sheet = "Test", x = c(colA = "testcol1", colB = "testcol2")) - - groupColumns(wbb, "Test", cols = 2:3, hidden = FALSE) - setColWidths(wbb, sheet = "Test", cols=c(1:5), widths = c(9,9,9,9,9)) - groupColumns(wbb, "Test", cols = 5:10, hidden = FALSE) - setColWidths(wbb, "Test", cols = 15:20, widths = 9) - - tf <- temp_xlsx("test") - tf2 <- temp_xlsx("test2") - - saveWorkbook(wbb, tf, overwrite = T) - test <- wbb$worksheets[[1]]$copy() - - saveWorkbook(wbb, tf2, overwrite = T) - - testthat::expect_equal(wbb$worksheets[[1]], test) - - unlink(c("tf", "tf2"), recursive = TRUE, force = TRUE) -}) +context("Workbook groupings") + +# groupRows() requires assigning to wb to global environment +# For reference, see here: https://github.com/r-lib/testthat/issues/720 + +test_that("group columns", { + + # Grouping then setting widths updates hidden + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + groupColumns(wb, "Sheet 1", 2:3, hidden = T) + setColWidths(wb, "Sheet 1", 2, widths = "18", hidden = F) + + expect_equal(attr(wb$colOutlineLevels[[1]], "hidden")[attr(wb$colOutlineLevels[[1]], "names") == 2], "0") + + # Setting column widths then grouping + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + setColWidths(wb, "Sheet 1", 2:3, widths = "18", hidden = F) + groupColumns(wb, "Sheet 1", 1:2, hidden = T) + + expect_equal(attr(wb$colWidths[[1]], "hidden")[attr(wb$colWidths[[1]], "names") == 2], "1") +}) + + +test_that("group rows", { + + wb <- createWorkbook() + assign("wb", wb, envir = .GlobalEnv) + addWorksheet(wb, "Sheet 1") + groupRows(wb, "Sheet 1", 1:4, hidden = T) + + expect_equal(names(wb$outlineLevels[[1]]), c("1", "2", "3", "4")) + expect_equal(unique(attr(wb$outlineLevels[[1]], "hidden")), "1") + rm(wb) +}) + + +test_that("ungroup columns", { + + # OutlineLevelCol is removed from SheetFormatPr when no + # column groupings left + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + setColWidths(wb, "Sheet 1", 2:3, widths = "18", hidden = F) + groupColumns(wb, "Sheet 1", 1:3, hidden = T) + ungroupColumns(wb, "Sheet 1", 1:3) + + expect_equal(unique(attr(wb$colWidths[[1]], "hidden")[attr(wb$colWidths[[1]], "names") %in% c(2, 3)]), "0") +}) + + +test_that("ungroup rows", { + wb <- createWorkbook() + assign("wb", wb, envir = .GlobalEnv) + addWorksheet(wb, "Sheet 1") + groupRows(wb, "Sheet 1", 1:3, hidden = T) + ungroupRows(wb, "Sheet 1", 1:3) + + expect_equal(length(wb$outlineLevels[[1]]), 0L) + rm(wb) +}) + + +test_that("loading workbook preserves outlines", { + fl <- system.file("extdata", "groupTest.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + + expect_equal(names(wb$colOutlineLevels[[1]]), c("2", "3", "4")) + expect_equal(names(wb$outlineLevels[[1]]), c("3", "4")) + expect_equal(unique(attr(wb$outlineLevels[[1]], "hidden")[names(wb$outlineLevels[[1]]) %in% c("3", "4")]), "true") + + wbb <- createWorkbook() + + addWorksheet(wbb, sheetName = "Test", gridLines = FALSE, tabColour = "deepskyblue") + + writeData(wbb, sheet = "Test", x = c(colA = "testcol1", colB = "testcol2")) + + groupColumns(wbb, "Test", cols = 2:3, hidden = FALSE) + setColWidths(wbb, sheet = "Test", cols=c(1:5), widths = c(9,9,9,9,9)) + groupColumns(wbb, "Test", cols = 5:10, hidden = FALSE) + setColWidths(wbb, "Test", cols = 15:20, widths = 9) + + tf <- temp_xlsx("test") + tf2 <- temp_xlsx("test2") + + saveWorkbook(wbb, tf, overwrite = T) + test <- wbb$worksheets[[1]]$copy() + + wb <- loadWorkbook(tf) + saveWorkbook(wb, tf2, overwrite = T) + + testthat::expect_equal(wb$worksheets[[1]], test) + + unlink(c("tf", "tf2"), recursive = TRUE, force = TRUE) +}) + + +test_that("Grouping after setting colwidths has correct length of hidden attributes", { + # Issue #100 - https://github.com/ycphs/openxlsx/issues/100 + + wb <- createWorkbook(title = "column width and grouping error") + addWorksheet(wb, sheetName = 1) + + setColWidths( + wb, + sheet = 1, + cols = 1:100, + widths = 8 + ) + + groupColumns(wb, sheet = 1, cols = 20:100, hidden = TRUE) + + expect_equal(length(wb$colOutlineLevels[[1]]), length(attr(wb$colOutlineLevels[[1]], "hidden"))) +}) + +test_that("Consecutive calls to saveWorkbook doesn't corrupt attributes", { + + wbb <- createWorkbook() + + addWorksheet(wbb, sheetName = "Test", gridLines = FALSE, tabColour = "deepskyblue") + + writeData(wbb, sheet = "Test", x = c(colA = "testcol1", colB = "testcol2")) + + groupColumns(wbb, "Test", cols = 2:3, hidden = FALSE) + setColWidths(wbb, sheet = "Test", cols=c(1:5), widths = c(9,9,9,9,9)) + groupColumns(wbb, "Test", cols = 5:10, hidden = FALSE) + setColWidths(wbb, "Test", cols = 15:20, widths = 9) + + tf <- temp_xlsx("test") + tf2 <- temp_xlsx("test2") + + saveWorkbook(wbb, tf, overwrite = T) + test <- wbb$worksheets[[1]]$copy() + + saveWorkbook(wbb, tf2, overwrite = T) + + testthat::expect_equal(wbb$worksheets[[1]], test) + + unlink(c("tf", "tf2"), recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-page_setup.R r-cran-openxlsx-4.2.5/tests/testthat/test-page_setup.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-page_setup.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-page_setup.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,40 +1,40 @@ - - -context("Page setup") - - -test_that("Page setup", { - wb <- createWorkbook() - addWorksheet(wb, "s1") - addWorksheet(wb, "s2") - - - pageSetup(wb, - sheet = "s1", orientation = "landscape", scale = 100, left = 0.1, - right = 0.1, top = .75, bottom = .75, header = 0.1, footer = 0.1, - fitToWidth = TRUE, fitToHeight = TRUE, paperSize = 1, - summaryRow = "below", summaryCol = "right" - ) - - - pageSetup(wb, - sheet = 2, orientation = "landscape", scale = 100, left = 0.1, - right = 0.1, top = .75, bottom = .75, header = 0.1, footer = 0.1, - fitToWidth = TRUE, fitToHeight = TRUE, paperSize = 1, - summaryRow = "below", summaryCol = "right" - ) - - expect_equal(wb$worksheets[[1]]$pageSetup, wb$worksheets[[2]]$pageSetup) - - v <- gsub(" ", "", wb$worksheets[[1]]$pageSetup, fixed = TRUE) - expect_true(grepl('paperSize="1"', v)) - expect_true(grepl('orientation="landscape"', v)) - expect_true(grepl('fitToWidth="1"', v)) - expect_true(grepl('fitToHeight="1"', v)) - - pr <- wb$worksheets[[1]]$sheetPr - - # SheetPr will be a character vector of length 2; the first entry will - # be for PageSetupPr, inserted by `fitToWidth`/`fitToHeight`. - expect_true(grepl('', pr[2], fixed = TRUE)) -}) + + +context("Page setup") + + +test_that("Page setup", { + wb <- createWorkbook() + addWorksheet(wb, "s1") + addWorksheet(wb, "s2") + + + pageSetup(wb, + sheet = "s1", orientation = "landscape", scale = 100, left = 0.1, + right = 0.1, top = .75, bottom = .75, header = 0.1, footer = 0.1, + fitToWidth = TRUE, fitToHeight = TRUE, paperSize = 1, + summaryRow = "below", summaryCol = "right" + ) + + + pageSetup(wb, + sheet = 2, orientation = "landscape", scale = 100, left = 0.1, + right = 0.1, top = .75, bottom = .75, header = 0.1, footer = 0.1, + fitToWidth = TRUE, fitToHeight = TRUE, paperSize = 1, + summaryRow = "below", summaryCol = "right" + ) + + expect_equal(wb$worksheets[[1]]$pageSetup, wb$worksheets[[2]]$pageSetup) + + v <- gsub(" ", "", wb$worksheets[[1]]$pageSetup, fixed = TRUE) + expect_true(grepl('paperSize="1"', v)) + expect_true(grepl('orientation="landscape"', v)) + expect_true(grepl('fitToWidth="1"', v)) + expect_true(grepl('fitToHeight="1"', v)) + + pr <- wb$worksheets[[1]]$sheetPr + + # SheetPr will be a character vector of length 2; the first entry will + # be for PageSetupPr, inserted by `fitToWidth`/`fitToHeight`. + expect_true(grepl('', pr[2], fixed = TRUE)) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-protect-workbook.R r-cran-openxlsx-4.2.5/tests/testthat/test-protect-workbook.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-protect-workbook.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-protect-workbook.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,31 +1,33 @@ - - -context("Protection") - - -test_that("Protect Workbook", { - wb <- createWorkbook() - addWorksheet(wb, "s1") - - wb$protectWorkbook(password = "abcdefghij") - - expect_true(wb$workbook$workbookProtection == "") - - wb$protectWorkbook(protect = FALSE, password = "abcdefghij", lockStructure = TRUE, lockWindows = TRUE) - expect_true(wb$workbook$workbookProtection == "") -}) - -test_that("Reading protected Workbook", { - tmp_file <- file.path(tempdir(), "xlsx_read_protectedwb.xlsx") - - wb <- createWorkbook() - addWorksheet(wb, "s1") - protectWorkbook(wb, password = "abcdefghij") - saveWorkbook(wb, tmp_file, overwrite = TRUE) - - wb2 <- loadWorkbook(file = tmp_file) - # Check that the order of teh sub-elements is preserved - expect_equal(names(wb2$workbook), names(wb$workbook)) - - unlink(tmp_file, recursive = TRUE, force = TRUE) -}) + + +context("Protection") + + +test_that("Protect Workbook", { + wb <- createWorkbook() + addWorksheet(wb, "s1") + + wb$protectWorkbook(password = "abcdefghij") + + expect_true(wb$workbook$workbookProtection == "") + + wb$protectWorkbook(protect = FALSE, password = "abcdefghij", lockStructure = TRUE, lockWindows = TRUE) + expect_true(wb$workbook$workbookProtection == "") +}) + +test_that("Reading protected Workbook", { + tmp_file <- file.path(tempdir(), "xlsx_read_protectedwb.xlsx") + + wb <- createWorkbook() + addWorksheet(wb, "s1") + protectWorkbook(wb, password = "abcdefghij") + saveWorkbook(wb, tmp_file, overwrite = TRUE) + + wb2 <- loadWorkbook(file = tmp_file) + # Check that the order of the sub-elements is preserved + n1 <- names(wb2$workbook) + n2 <- names(wb$workbook)[names(wb$workbook) != "apps"] + expect_equal(n1, n2) + + unlink(tmp_file, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-protect-worksheet.R r-cran-openxlsx-4.2.5/tests/testthat/test-protect-worksheet.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-protect-worksheet.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-protect-worksheet.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,20 +1,20 @@ - - -context("Protection") - - -test_that("Protection", { - wb <- createWorkbook() - addWorksheet(wb, "s1") - addWorksheet(wb, "s2") - - - protectWorksheet(wb, sheet = "s1", protect = TRUE, password = "abcdefghij", lockSelectingLockedCells = FALSE, lockSelectingUnlockedCells = FALSE, lockFormattingCells = TRUE, lockFormattingColumns = TRUE, lockPivotTables = TRUE) - - expect_true(wb$worksheets[[1]]$sheetProtection == "") - - protectWorksheet(wb, sheet = "s2", protect = TRUE) - expect_true(wb$worksheets[[2]]$sheetProtection == "") - protectWorksheet(wb, sheet = "s2", protect = FALSE) - expect_true(wb$worksheets[[2]]$sheetProtection == "") -}) + + +context("Protection") + + +test_that("Protection", { + wb <- createWorkbook() + addWorksheet(wb, "s1") + addWorksheet(wb, "s2") + + + protectWorksheet(wb, sheet = "s1", protect = TRUE, password = "abcdefghij", lockSelectingLockedCells = FALSE, lockSelectingUnlockedCells = FALSE, lockFormattingCells = TRUE, lockFormattingColumns = TRUE, lockPivotTables = TRUE) + + expect_true(wb$worksheets[[1]]$sheetProtection == "") + + protectWorksheet(wb, sheet = "s2", protect = TRUE) + expect_true(wb$worksheets[[2]]$sheetProtection == "") + protectWorksheet(wb, sheet = "s2", protect = FALSE) + expect_true(wb$worksheets[[2]]$sheetProtection == "") +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-read_from_created_wb.R r-cran-openxlsx-4.2.5/tests/testthat/test-read_from_created_wb.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-read_from_created_wb.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-read_from_created_wb.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,361 +1,361 @@ - -context("Reading from wb object is identical to reading from file") - -test_that("Reading from new workbook", { - curr_wd <- getwd() - - wb <- createWorkbook() - for (i in 1:4) { - addWorksheet(wb, sprintf("Sheet %s", i)) - } - - - ## colNames = TRUE, rowNames = TRUE - writeData(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = TRUE, startRow = 10, startCol = 5) - x <- read.xlsx(wb, 1, colNames = TRUE, rowNames = TRUE) - expect_equal(object = mtcars, expected = x, check.attributes = TRUE) - - - ## colNames = TRUE, rowNames = FALSE - writeData(wb, sheet = 2, x = mtcars, colNames = TRUE, rowNames = FALSE, startRow = 10, startCol = 5) - x <- read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE) - expect_equal(object = mtcars, expected = x, check.attributes = FALSE) - expect_equal(object = colnames(mtcars), expected = colnames(x), check.attributes = FALSE) - - ## colNames = FALSE, rowNames = TRUE - writeData(wb, sheet = 3, x = mtcars, colNames = FALSE, rowNames = TRUE, startRow = 2, startCol = 2) - x <- read.xlsx(wb, sheet = 3, colNames = FALSE, rowNames = TRUE) - expect_equal(object = mtcars, expected = x, check.attributes = FALSE) - expect_equal(object = rownames(mtcars), expected = rownames(x)) - - - ## colNames = FALSE, rowNames = FALSE - writeData(wb, sheet = 4, x = mtcars, colNames = FALSE, rowNames = FALSE, startRow = 12, startCol = 1) - x <- read.xlsx(wb, sheet = 4, colNames = FALSE, rowNames = FALSE) - expect_equal(object = mtcars, expected = x, check.attributes = FALSE) - - expect_equal(object = getwd(), curr_wd) - rm(wb) -}) - -test_that("Empty workbook", { - curr_wd <- getwd() - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - - expect_equal(NULL, suppressWarnings(read.xlsx(wb))) - - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE))) - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE))) - - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = FALSE))) - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = FALSE))) - - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE))) - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE))) - - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10))) - expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10))) - - expect_warning(read.xlsx(wb)) - - expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE)) - expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE)) - - expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = FALSE)) - expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = FALSE)) - - expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE)) - expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE)) - - expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10)) - expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10)) - - - ## 1 element - writeData(wb, 1, "a") - - x <- read.xlsx(wb) - expect_equal(nrow(x), 0) - expect_equal(names(x), "a") - - x <- read.xlsx(wb, sheet = 1, colNames = FALSE) - expect_equal(data.frame("X1" = "a", stringsAsFactors = FALSE), x) - - x <- read.xlsx(wb, sheet = 1, colNames = TRUE) - expect_equal(nrow(x), 0) - expect_equal(names(x), "a") - - x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = FALSE) - expect_equal(data.frame("X1" = "a", stringsAsFactors = FALSE), x) - - x <- read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = FALSE) - expect_equal(nrow(x), 0) - expect_equal(names(x), "a") - - writeData(wb, 1, Sys.Date(), startCol = 1, startRow = 1) - x <- read.xlsx(wb) - expect_equal(nrow(x), 0) - expect_equal(convertToDate(as.integer(names(x)[1])), Sys.Date()) - - - x <- read.xlsx(wb, sheet = 1, colNames = FALSE) - expect_equal(nrow(x), 1) - - x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE) - expect_equal(class(x[[1]]), "Date") - - x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE) - expect_equal(x[[1]], Sys.Date()) - - x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10)) - expect_equal(NULL, x) - - x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10)) - expect_equal(NULL, x) - - - - addWorksheet(wb, "Sheet 2") - removeWorksheet(wb, 1) - - - ## 1 date - writeData(wb, 1, Sys.Date(), colNames = FALSE) - - x <- read.xlsx(wb) - expect_equal(convertToDate(names(x)), Sys.Date()) - - x <- read.xlsx(wb, sheet = 1, colNames = FALSE) - x1 <- convertToDate(x[[1]]) - expect_equal(x1, Sys.Date()) - - x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE) - expect_equal(class(x[[1]]), "Date") - expect_equal(x[[1]], Sys.Date()) - - x <- read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = TRUE) - expect_equal(as.Date(names(x)), Sys.Date()) - - x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10)) - expect_equal(NULL, x) - - x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10)) - expect_equal(NULL, x) - - - expect_equal(object = getwd(), curr_wd) -}) - - -test_that("Reading NAs and NaN values", { - fileName <- file.path(tempdir(), "NaN.xlsx") - na.string <- "*" - - ## data - a <- data.frame( - X = c(-pi / 0, NA, NaN), - Y = letters[1:3], - Z = c(pi / 0, 99, NaN), - Z2 = c(1, NaN, NaN), - stringsAsFactors = FALSE - ) - - b <- a - b[b == -Inf] <- NaN - b[b == Inf] <- NaN - - c <- b - is_na <- sapply(c, is.na) - is_nan <- sapply(c, is.nan) - c[is_na & !is_nan] <- na.string - is_nan_after <- sapply(c, is.nan) - c[is_nan & !is_nan_after] <- NA - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - writeData(wb, 1, a, keepNA = FALSE) - - addWorksheet(wb, "Sheet 2") - writeData(wb, 2, a, keepNA = TRUE) - - addWorksheet(wb, "Sheet 3") - writeData(wb, 3, a, keepNA = TRUE, na.string = na.string) - - saveWorkbook(wb, file = fileName, overwrite = TRUE) - - ## from file - expected_df <- structure(list( - X = c(NA_real_, NA_real_, NA_real_), - Y = c("a", "b", "c"), - Z = c(NA, 99, NA), - Z2 = c(1, NA, NA) - ), - .Names = c("X", "Y", "Z", "Z2"), - row.names = c(NA, 3L), class = "data.frame" - ) - - expect_equal(read.xlsx(fileName), expected_df) - - ## from workbook - expected_df <- structure(list( - X = c(NA_real_, NA_real_, NA_real_), - Y = c("a", "b", "c"), - Z = c(NA, 99, NA), - Z2 = c(1, NA, NA) - ), - .Names = c("X", "Y", "Z", "Z2"), - row.names = c(NA, 3L), class = "data.frame" - ) - - expect_equal(read.xlsx(wb), expected_df) - - ## keepNA = FALSE - expect_equal(read.xlsx(wb), read.xlsx(fileName)) - expect_equal(b, read.xlsx(wb)) - expect_equal(b, read.xlsx(fileName)) - - ## keepNA = TRUE - - expect_equal(read.xlsx(wb), expected_df) - expect_equal(read.xlsx(fileName), expected_df) - - expect_equal(b, read.xlsx(wb, sheet = 2)) - expect_equal(b, read.xlsx(fileName, sheet = 2)) - - ## keepNA = TRUE, na.string = "*" - expect_equal(c, read.xlsx(wb, sheet = 3)) - expect_equal(c, read.xlsx(fileName, sheet = 3)) - - unlink(fileName, recursive = TRUE, force = TRUE) -}) - - -test_that("Reading from new workbook 2 ", { - - ## data - genDf <- function() { - data.frame( - "Date" = Sys.Date() - 0:4, - "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), - "Currency" = -2:2, - "Accounting" = -2:2, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(-1, 1, length.out = 5), - "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE - ) - } - - df <- genDf() - - class(df$Currency) <- "currency" - class(df$Accounting) <- "accounting" - class(df$hLink) <- "hyperlink" - class(df$Percentage) <- "percentage" - class(df$TinyNumber) <- "scientific" - - options("openxlsx.dateFormat" = NULL) - - fileName <- file.path(tempdir(), "allClasses.xlsx") - wb <- write.xlsx(df, file = fileName, overwrite = TRUE) - - x <- read.xlsx(wb, sheet = 1, detectDates = FALSE) - x[[1]] <- convertToDate(x[[1]]) - expect_equal(object = x, expected = genDf(), check.attributes = FALSE) - - - x <- read.xlsx(wb, sheet = 1, detectDates = TRUE) - expect_equal(object = x, expected = genDf(), check.attributes = FALSE) - - unlink(fileName, recursive = TRUE, force = TRUE) -}) - - - - - -test_that("Reading from new workbook cols/rows", { - wb <- createWorkbook() - for (i in 1:4) { - addWorksheet(wb, sprintf("Sheet %s", i)) - } - - tempFile <- temp_xlsx() - - ## 1 - writeData(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = FALSE) - saveWorkbook(wb, tempFile, overwrite = TRUE) - - cols <- 1:3 - rows <- 1:10 - x <- read.xlsx(wb, 1, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) - y <- read.xlsx(tempFile, 1, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) - - df <- mtcars[sort((rows - 1)[(rows - 1) <= nrow(mtcars)]), sort(cols[cols <= ncol(mtcars)])] - rownames(df) <- seq_len(nrow(df)) - - expect_equal(object = x, expected = y) - expect_equal(object = x, expected = df) - - - - ## 2 - writeData(wb, sheet = 2, x = mtcars, colNames = TRUE, rowNames = FALSE, startRow = 10, startCol = 5) - saveWorkbook(wb, tempFile, overwrite = TRUE) - - cols <- 1:300 - rows <- 1:1000 - x <- read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) - y <- read.xlsx(tempFile, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) - - # - expect_equal(object = mtcars, expected = x, check.attributes = FALSE) - expect_equal(object = x, expected = y, check.attributes = TRUE) - expect_equal(object = colnames(mtcars), expected = colnames(x), check.attributes = FALSE) - - - cols <- 1:3 - rows <- 12:13 - x <- suppressWarnings(read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols)) - y <- suppressWarnings(read.xlsx(tempFile, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols)) - - - expect_equal(object = NULL, expected = x, check.attributes = FALSE) - expect_equal(object = NULL, expected = y, check.attributes = TRUE) - - - - ## 3 - writeData(wb, sheet = 3, x = mtcars, colNames = TRUE, rowNames = FALSE) - saveWorkbook(wb, tempFile, overwrite = TRUE) - - cols <- c(2, 4, 6) - rows <- seq(1, 31, by = 2) - - x <- read.xlsx(wb, sheet = 3, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) - y <- read.xlsx(tempFile, sheet = 3, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) - - df <- mtcars[sort((rows - 1)[(rows - 1) <= nrow(mtcars)]), sort(cols[cols <= ncol(mtcars)])] - rownames(df) <- seq_len(nrow(df)) - - expect_equal(object = x, expected = y, check.attributes = FALSE) - expect_equal(object = df, expected = x, check.attributes = FALSE) - - - - ## 4 - writeData(wb, sheet = 4, x = mtcars, colNames = TRUE, rowNames = TRUE) - saveWorkbook(wb, tempFile, overwrite = TRUE) - - cols <- c(1, 6, 12) - rows <- seq(1, 31, by = 2) - x <- read.xlsx(wb, sheet = 4, colNames = TRUE, rowNames = TRUE, rows = rows, cols = cols) - y <- read.xlsx(tempFile, sheet = 4, colNames = TRUE, rowNames = TRUE, rows = rows, cols = cols) - - df <- mtcars[sort((rows - 1)[(rows - 1) <= nrow(mtcars)]), cols[-1] - 1] - expect_equal(object = x, expected = y, check.attributes = FALSE) - expect_equal(object = df, expected = x, check.attributes = FALSE) - - rm(wb) - unlink(tempFile, recursive = TRUE, force = TRUE) -}) + +context("Reading from wb object is identical to reading from file") + +test_that("Reading from new workbook", { + curr_wd <- getwd() + + wb <- createWorkbook() + for (i in 1:4) { + addWorksheet(wb, sprintf("Sheet %s", i)) + } + + + ## colNames = TRUE, rowNames = TRUE + writeData(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = TRUE, startRow = 10, startCol = 5) + x <- read.xlsx(wb, 1, colNames = TRUE, rowNames = TRUE) + expect_equal(object = mtcars, expected = x, check.attributes = TRUE) + + + ## colNames = TRUE, rowNames = FALSE + writeData(wb, sheet = 2, x = mtcars, colNames = TRUE, rowNames = FALSE, startRow = 10, startCol = 5) + x <- read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE) + expect_equal(object = mtcars, expected = x, check.attributes = FALSE) + expect_equal(object = colnames(mtcars), expected = colnames(x), check.attributes = FALSE) + + ## colNames = FALSE, rowNames = TRUE + writeData(wb, sheet = 3, x = mtcars, colNames = FALSE, rowNames = TRUE, startRow = 2, startCol = 2) + x <- read.xlsx(wb, sheet = 3, colNames = FALSE, rowNames = TRUE) + expect_equal(object = mtcars, expected = x, check.attributes = FALSE) + expect_equal(object = rownames(mtcars), expected = rownames(x)) + + + ## colNames = FALSE, rowNames = FALSE + writeData(wb, sheet = 4, x = mtcars, colNames = FALSE, rowNames = FALSE, startRow = 12, startCol = 1) + x <- read.xlsx(wb, sheet = 4, colNames = FALSE, rowNames = FALSE) + expect_equal(object = mtcars, expected = x, check.attributes = FALSE) + + expect_equal(object = getwd(), curr_wd) + rm(wb) +}) + +test_that("Empty workbook", { + curr_wd <- getwd() + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + expect_equal(NULL, suppressWarnings(read.xlsx(wb))) + + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE))) + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE))) + + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = FALSE))) + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = FALSE))) + + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE))) + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE))) + + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10))) + expect_equal(NULL, suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10))) + + expect_warning(read.xlsx(wb)) + + expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE)) + expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE)) + + expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = FALSE)) + expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = FALSE)) + + expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE)) + expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE)) + + expect_warning(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10)) + expect_warning(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10)) + + + ## 1 element + writeData(wb, 1, "a") + + x <- read.xlsx(wb) + expect_equal(nrow(x), 0) + expect_equal(names(x), "a") + + x <- read.xlsx(wb, sheet = 1, colNames = FALSE) + expect_equal(data.frame("X1" = "a", stringsAsFactors = FALSE), x) + + x <- read.xlsx(wb, sheet = 1, colNames = TRUE) + expect_equal(nrow(x), 0) + expect_equal(names(x), "a") + + x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = FALSE) + expect_equal(data.frame("X1" = "a", stringsAsFactors = FALSE), x) + + x <- read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = FALSE) + expect_equal(nrow(x), 0) + expect_equal(names(x), "a") + + writeData(wb, 1, Sys.Date(), startCol = 1, startRow = 1) + x <- read.xlsx(wb) + expect_equal(nrow(x), 0) + expect_equal(convertToDate(as.integer(names(x)[1])), Sys.Date()) + + + x <- read.xlsx(wb, sheet = 1, colNames = FALSE) + expect_equal(nrow(x), 1) + + x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE) + expect_equal(class(x[[1]]), "Date") + + x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE) + expect_equal(x[[1]], Sys.Date()) + + x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10)) + expect_equal(NULL, x) + + x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10)) + expect_equal(NULL, x) + + + + addWorksheet(wb, "Sheet 2") + removeWorksheet(wb, 1) + + + ## 1 date + writeData(wb, 1, Sys.Date(), colNames = FALSE) + + x <- read.xlsx(wb) + expect_equal(convertToDate(names(x)), Sys.Date()) + + x <- read.xlsx(wb, sheet = 1, colNames = FALSE) + x1 <- convertToDate(x[[1]]) + expect_equal(x1, Sys.Date()) + + x <- read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE) + expect_equal(class(x[[1]]), "Date") + expect_equal(x[[1]], Sys.Date()) + + x <- read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = TRUE) + expect_equal(as.Date(names(x)), Sys.Date()) + + x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = FALSE, skipEmptyRows = TRUE, detectDates = TRUE, rows = 4:10)) + expect_equal(NULL, x) + + x <- suppressWarnings(read.xlsx(wb, sheet = 1, colNames = TRUE, skipEmptyRows = TRUE, detectDates = FALSE, cols = 4:10)) + expect_equal(NULL, x) + + + expect_equal(object = getwd(), curr_wd) +}) + + +test_that("Reading NAs and NaN values", { + fileName <- file.path(tempdir(), "NaN.xlsx") + na.string <- "*" + + ## data + a <- data.frame( + X = c(-pi / 0, NA, NaN), + Y = letters[1:3], + Z = c(pi / 0, 99, NaN), + Z2 = c(1, NaN, NaN), + stringsAsFactors = FALSE + ) + + b <- a + b[b == -Inf] <- NaN + b[b == Inf] <- NaN + + c <- b + is_na <- sapply(c, is.na) + is_nan <- sapply(c, is.nan) + c[is_na & !is_nan] <- na.string + is_nan_after <- sapply(c, is.nan) + c[is_nan & !is_nan_after] <- NA + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + writeData(wb, 1, a, keepNA = FALSE) + + addWorksheet(wb, "Sheet 2") + writeData(wb, 2, a, keepNA = TRUE) + + addWorksheet(wb, "Sheet 3") + writeData(wb, 3, a, keepNA = TRUE, na.string = na.string) + + saveWorkbook(wb, file = fileName, overwrite = TRUE) + + ## from file + expected_df <- structure(list( + X = c(NA_real_, NA_real_, NA_real_), + Y = c("a", "b", "c"), + Z = c(NA, 99, NA), + Z2 = c(1, NA, NA) + ), + .Names = c("X", "Y", "Z", "Z2"), + row.names = c(NA, 3L), class = "data.frame" + ) + + expect_equal(read.xlsx(fileName), expected_df) + + ## from workbook + expected_df <- structure(list( + X = c(NA_real_, NA_real_, NA_real_), + Y = c("a", "b", "c"), + Z = c(NA, 99, NA), + Z2 = c(1, NA, NA) + ), + .Names = c("X", "Y", "Z", "Z2"), + row.names = c(NA, 3L), class = "data.frame" + ) + + expect_equal(read.xlsx(wb), expected_df) + + ## keepNA = FALSE + expect_equal(read.xlsx(wb), read.xlsx(fileName)) + expect_equal(b, read.xlsx(wb)) + expect_equal(b, read.xlsx(fileName)) + + ## keepNA = TRUE + + expect_equal(read.xlsx(wb), expected_df) + expect_equal(read.xlsx(fileName), expected_df) + + expect_equal(b, read.xlsx(wb, sheet = 2)) + expect_equal(b, read.xlsx(fileName, sheet = 2)) + + ## keepNA = TRUE, na.string = "*" + expect_equal(c, read.xlsx(wb, sheet = 3)) + expect_equal(c, read.xlsx(fileName, sheet = 3)) + + unlink(fileName, recursive = TRUE, force = TRUE) +}) + + +test_that("Reading from new workbook 2 ", { + + ## data + genDf <- function() { + data.frame( + "Date" = Sys.Date() - 0:4, + "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), + "Currency" = -2:2, + "Accounting" = -2:2, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(-1, 1, length.out = 5), + "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE + ) + } + + df <- genDf() + + class(df$Currency) <- "currency" + class(df$Accounting) <- "accounting" + class(df$hLink) <- "hyperlink" + class(df$Percentage) <- "percentage" + class(df$TinyNumber) <- "scientific" + + options("openxlsx.dateFormat" = NULL) + + fileName <- file.path(tempdir(), "allClasses.xlsx") + wb <- write.xlsx(df, file = fileName, overwrite = TRUE) + + x <- read.xlsx(wb, sheet = 1, detectDates = FALSE) + x[[1]] <- convertToDate(x[[1]]) + expect_equal(object = x, expected = genDf(), check.attributes = FALSE) + + + x <- read.xlsx(wb, sheet = 1, detectDates = TRUE) + expect_equal(object = x, expected = genDf(), check.attributes = FALSE) + + unlink(fileName, recursive = TRUE, force = TRUE) +}) + + + + + +test_that("Reading from new workbook cols/rows", { + wb <- createWorkbook() + for (i in 1:4) { + addWorksheet(wb, sprintf("Sheet %s", i)) + } + + tempFile <- temp_xlsx() + + ## 1 + writeData(wb, sheet = 1, x = mtcars, colNames = TRUE, rowNames = FALSE) + saveWorkbook(wb, tempFile, overwrite = TRUE) + + cols <- 1:3 + rows <- 1:10 + x <- read.xlsx(wb, 1, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) + y <- read.xlsx(tempFile, 1, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) + + df <- mtcars[sort((rows - 1)[(rows - 1) <= nrow(mtcars)]), sort(cols[cols <= ncol(mtcars)])] + rownames(df) <- seq_len(nrow(df)) + + expect_equal(object = x, expected = y) + expect_equal(object = x, expected = df) + + + + ## 2 + writeData(wb, sheet = 2, x = mtcars, colNames = TRUE, rowNames = FALSE, startRow = 10, startCol = 5) + saveWorkbook(wb, tempFile, overwrite = TRUE) + + cols <- 1:300 + rows <- 1:1000 + x <- read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) + y <- read.xlsx(tempFile, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) + + # + expect_equal(object = mtcars, expected = x, check.attributes = FALSE) + expect_equal(object = x, expected = y, check.attributes = TRUE) + expect_equal(object = colnames(mtcars), expected = colnames(x), check.attributes = FALSE) + + + cols <- 1:3 + rows <- 12:13 + x <- suppressWarnings(read.xlsx(wb, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols)) + y <- suppressWarnings(read.xlsx(tempFile, sheet = 2, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols)) + + + expect_equal(object = NULL, expected = x, check.attributes = FALSE) + expect_equal(object = NULL, expected = y, check.attributes = TRUE) + + + + ## 3 + writeData(wb, sheet = 3, x = mtcars, colNames = TRUE, rowNames = FALSE) + saveWorkbook(wb, tempFile, overwrite = TRUE) + + cols <- c(2, 4, 6) + rows <- seq(1, 31, by = 2) + + x <- read.xlsx(wb, sheet = 3, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) + y <- read.xlsx(tempFile, sheet = 3, colNames = TRUE, rowNames = FALSE, rows = rows, cols = cols) + + df <- mtcars[sort((rows - 1)[(rows - 1) <= nrow(mtcars)]), sort(cols[cols <= ncol(mtcars)])] + rownames(df) <- seq_len(nrow(df)) + + expect_equal(object = x, expected = y, check.attributes = FALSE) + expect_equal(object = df, expected = x, check.attributes = FALSE) + + + + ## 4 + writeData(wb, sheet = 4, x = mtcars, colNames = TRUE, rowNames = TRUE) + saveWorkbook(wb, tempFile, overwrite = TRUE) + + cols <- c(1, 6, 12) + rows <- seq(1, 31, by = 2) + x <- read.xlsx(wb, sheet = 4, colNames = TRUE, rowNames = TRUE, rows = rows, cols = cols) + y <- read.xlsx(tempFile, sheet = 4, colNames = TRUE, rowNames = TRUE, rows = rows, cols = cols) + + df <- mtcars[sort((rows - 1)[(rows - 1) <= nrow(mtcars)]), cols[-1] - 1] + expect_equal(object = x, expected = y, check.attributes = FALSE) + expect_equal(object = df, expected = x, check.attributes = FALSE) + + rm(wb) + unlink(tempFile, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-read_from_loaded_workbook.R r-cran-openxlsx-4.2.5/tests/testthat/test-read_from_loaded_workbook.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-read_from_loaded_workbook.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-read_from_loaded_workbook.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,323 +1,323 @@ - - - -context("Reading from workbook is identical to reading from file readTest.xlsx") - - - -test_that("Reading example workbook readTest.xlsx", { - curr_wd <- getwd() - xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - wb <- loadWorkbook(xlsxFile) - - ## sheet 1 - sheet <- 1 - x <- read.xlsx(xlsxFile, sheet) - y <- read.xlsx(wb, sheet) - expect_equal(dim(x), c(10, 7)) - expect_equal(dim(y), c(10, 7)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, detectDates = TRUE) - y <- read.xlsx(wb, sheet, detectDates = TRUE) - expect_equal(dim(x), c(10, 7)) - expect_equal(dim(y), c(10, 7)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - expect_equal(dim(x), c(9, 5)) - expect_equal(dim(y), c(9, 5)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) - expect_equal(dim(x), c(2, 6)) - expect_equal(dim(y), c(2, 6)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) - expect_equal(dim(x), c(3, 6)) - expect_equal(dim(y), c(3, 6)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) - expect_equal(dim(x), c(3, 6)) - expect_equal(dim(y), c(3, 6)) - expect_equal(x, y) - - - x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - expect_equal(dim(x), c(9, 2)) - expect_equal(dim(y), c(9, 2)) - expect_equal(x, y) - - - - - ## sheet 2 - sheet <- 2 - x <- read.xlsx(xlsxFile, sheet) - y <- read.xlsx(wb, sheet) - expect_equal(dim(x), c(33, 9)) - expect_equal(dim(y), c(33, 9)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - expect_equal(dim(x), c(32, 9)) - expect_equal(dim(y), c(32, 9)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) - expect_equal(dim(x), c(2, 9)) - expect_equal(dim(y), c(2, 9)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) - expect_equal(dim(x), c(3, 9)) - expect_equal(dim(y), c(3, 9)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) - expect_equal(dim(x), c(3, 9)) - expect_equal(dim(y), c(3, 9)) - expect_equal(x, y) - - - x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - expect_equal(dim(x), c(21, 3)) - expect_equal(dim(y), c(21, 3)) - expect_equal(x, y) - - - - ## sheet 3 - sheet <- 3 - x <- read.xlsx(xlsxFile, sheet) - y <- read.xlsx(wb, sheet) - expect_equal(dim(x), c(2083, 5)) - expect_equal(dim(y), c(2083, 5)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - expect_equal(dim(x), c(2084, 5)) - expect_equal(dim(y), c(2084, 5)) - expect_equal(x, y) - - x <- suppressWarnings(read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE)) - y <- suppressWarnings(read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE)) - expect_equal(dim(x), NULL) - expect_equal(dim(y), NULL) - expect_equal(x, y) - - x <- suppressWarnings(read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE)) - y <- suppressWarnings(read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE)) - expect_equal(dim(x), NULL) - expect_equal(dim(y), NULL) - expect_equal(x, NULL) - expect_equal(y, NULL) - expect_equal(x, y) - - x <- suppressWarnings(read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE)) - y <- suppressWarnings(read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE)) - expect_equal(dim(x), NULL) - expect_equal(dim(y), NULL) - expect_equal(x, NULL) - expect_equal(y, NULL) - expect_equal(x, y) - - - x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - expect_equal(dim(x), c(2084, 2)) - expect_equal(dim(y), c(2084, 2)) - expect_equal(x, y) - - - - ## sheet 5 - sheet <- 5 - x <- read.xlsx(xlsxFile, sheet) - y <- read.xlsx(wb, sheet) - expect_equal(dim(x), c(271, 297)) - expect_equal(dim(y), c(271, 297)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) - expect_equal(dim(x), c(270, 297)) - expect_equal(dim(y), c(270, 297)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) - expect_equal(dim(x), c(2, 297)) - expect_equal(dim(y), c(2, 297)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) - expect_equal(dim(x), c(3, 297)) - expect_equal(dim(y), c(3, 297)) - expect_equal(x, y) - - x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) - y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) - expect_equal(dim(x), c(3, 297)) - expect_equal(dim(y), c(3, 297)) - expect_equal(x, y) - - - x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) - expect_equal(dim(x), c(272, 3)) - expect_equal(dim(y), c(272, 3)) - expect_equal(x, y) - - expect_equal(object = getwd(), curr_wd) -}) - - - - - - -test_that("Load read - Skip Empty rows/cols", { - curr_wd <- getwd() - xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - wb <- loadWorkbook(xlsxFile) - - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 4L) - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 4L) - - - ############################################################## - ## FALSE FALSE FALSE - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## FALSE FALSE TRUE - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[2, ]))) - - - - ############################################################## - ## FALSE TRUE FALSE - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - - ############################################################## - ## FALSE TRUE TRUE - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - ############################################################## - ## TRUE FALSE FALSE - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 4L) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## TRUE FALSE TRUE - - x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 4L) - - - ## NA rows - expect_true(all(is.na(x[2, ]))) - - expect_equal(object = getwd(), curr_wd) -}) - - - - -context("Reading from workbook is identical to reading from file read_failure_test.xlsx") - -test_that("Reading example workbook read_failure_test.xlsx", { - curr_wd <- getwd() - fl <- system.file("extdata", "read_failure_test.xlsx", package = "openxlsx") - wb <- loadWorkbook(fl) - - x <- read.xlsx(fl, sheet = 1, skipEmptyCols = TRUE) - y <- read.xlsx(wb, sheet = 1, skipEmptyCols = TRUE) - expect_true(all.equal(x, y)) - - x <- read.xlsx(fl, sheet = 1, skipEmptyCols = FALSE) - y <- read.xlsx(wb, sheet = 1, skipEmptyCols = FALSE) - expect_true(all.equal(x, y)) - - expect_equal(object = getwd(), curr_wd) -}) + + + +context("Reading from workbook is identical to reading from file readTest.xlsx") + + + +test_that("Reading example workbook readTest.xlsx", { + curr_wd <- getwd() + xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + wb <- loadWorkbook(xlsxFile) + + ## sheet 1 + sheet <- 1 + x <- read.xlsx(xlsxFile, sheet) + y <- read.xlsx(wb, sheet) + expect_equal(dim(x), c(10, 7)) + expect_equal(dim(y), c(10, 7)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, detectDates = TRUE) + y <- read.xlsx(wb, sheet, detectDates = TRUE) + expect_equal(dim(x), c(10, 7)) + expect_equal(dim(y), c(10, 7)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + expect_equal(dim(x), c(9, 5)) + expect_equal(dim(y), c(9, 5)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) + expect_equal(dim(x), c(2, 6)) + expect_equal(dim(y), c(2, 6)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) + expect_equal(dim(x), c(3, 6)) + expect_equal(dim(y), c(3, 6)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) + expect_equal(dim(x), c(3, 6)) + expect_equal(dim(y), c(3, 6)) + expect_equal(x, y) + + + x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + expect_equal(dim(x), c(9, 2)) + expect_equal(dim(y), c(9, 2)) + expect_equal(x, y) + + + + + ## sheet 2 + sheet <- 2 + x <- read.xlsx(xlsxFile, sheet) + y <- read.xlsx(wb, sheet) + expect_equal(dim(x), c(33, 9)) + expect_equal(dim(y), c(33, 9)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + expect_equal(dim(x), c(32, 9)) + expect_equal(dim(y), c(32, 9)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) + expect_equal(dim(x), c(2, 9)) + expect_equal(dim(y), c(2, 9)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) + expect_equal(dim(x), c(3, 9)) + expect_equal(dim(y), c(3, 9)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) + expect_equal(dim(x), c(3, 9)) + expect_equal(dim(y), c(3, 9)) + expect_equal(x, y) + + + x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + expect_equal(dim(x), c(21, 3)) + expect_equal(dim(y), c(21, 3)) + expect_equal(x, y) + + + + ## sheet 3 + sheet <- 3 + x <- read.xlsx(xlsxFile, sheet) + y <- read.xlsx(wb, sheet) + expect_equal(dim(x), c(2083, 5)) + expect_equal(dim(y), c(2083, 5)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + expect_equal(dim(x), c(2084, 5)) + expect_equal(dim(y), c(2084, 5)) + expect_equal(x, y) + + x <- suppressWarnings(read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE)) + y <- suppressWarnings(read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE)) + expect_equal(dim(x), NULL) + expect_equal(dim(y), NULL) + expect_equal(x, y) + + x <- suppressWarnings(read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE)) + y <- suppressWarnings(read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE)) + expect_equal(dim(x), NULL) + expect_equal(dim(y), NULL) + expect_equal(x, NULL) + expect_equal(y, NULL) + expect_equal(x, y) + + x <- suppressWarnings(read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE)) + y <- suppressWarnings(read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE)) + expect_equal(dim(x), NULL) + expect_equal(dim(y), NULL) + expect_equal(x, NULL) + expect_equal(y, NULL) + expect_equal(x, y) + + + x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + expect_equal(dim(x), c(2084, 2)) + expect_equal(dim(y), c(2084, 2)) + expect_equal(x, y) + + + + ## sheet 5 + sheet <- 5 + x <- read.xlsx(xlsxFile, sheet) + y <- read.xlsx(wb, sheet) + expect_equal(dim(x), c(271, 297)) + expect_equal(dim(y), c(271, 297)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, startRow = 3, colNames = FALSE, detectDates = TRUE) + expect_equal(dim(x), c(270, 297)) + expect_equal(dim(y), c(270, 297)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = TRUE, detectDates = TRUE) + expect_equal(dim(x), c(2, 297)) + expect_equal(dim(y), c(2, 297)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = TRUE) + expect_equal(dim(x), c(3, 297)) + expect_equal(dim(y), c(3, 297)) + expect_equal(x, y) + + x <- read.xlsx(xlsxFile, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) + y <- read.xlsx(wb, sheet, rows = 2:4, colNames = FALSE, detectDates = FALSE) + expect_equal(dim(x), c(3, 297)) + expect_equal(dim(y), c(3, 297)) + expect_equal(x, y) + + + x <- read.xlsx(xlsxFile, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + y <- read.xlsx(wb, sheet, colNames = FALSE, detectDates = FALSE, cols = 2:4) + expect_equal(dim(x), c(272, 3)) + expect_equal(dim(y), c(272, 3)) + expect_equal(x, y) + + expect_equal(object = getwd(), curr_wd) +}) + + + + + + +test_that("Load read - Skip Empty rows/cols", { + curr_wd <- getwd() + xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + wb <- loadWorkbook(xlsxFile) + + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 4L) + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 4L) + + + ############################################################## + ## FALSE FALSE FALSE + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## FALSE FALSE TRUE + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[2, ]))) + + + + ############################################################## + ## FALSE TRUE FALSE + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + + ############################################################## + ## FALSE TRUE TRUE + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + ############################################################## + ## TRUE FALSE FALSE + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 4L) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## TRUE FALSE TRUE + + x <- read.xlsx(xlsxFile = xlsxFile, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 4L) + + + ## NA rows + expect_true(all(is.na(x[2, ]))) + + expect_equal(object = getwd(), curr_wd) +}) + + + + +context("Reading from workbook is identical to reading from file read_failure_test.xlsx") + +test_that("Reading example workbook read_failure_test.xlsx", { + curr_wd <- getwd() + fl <- system.file("extdata", "read_failure_test.xlsx", package = "openxlsx") + wb <- loadWorkbook(fl) + + x <- read.xlsx(fl, sheet = 1, skipEmptyCols = TRUE) + y <- read.xlsx(wb, sheet = 1, skipEmptyCols = TRUE) + expect_true(all.equal(x, y)) + + x <- read.xlsx(fl, sheet = 1, skipEmptyCols = FALSE) + y <- read.xlsx(wb, sheet = 1, skipEmptyCols = FALSE) + expect_true(all.equal(x, y)) + + expect_equal(object = getwd(), curr_wd) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-read_sources.R r-cran-openxlsx-4.2.5/tests/testthat/test-read_sources.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-read_sources.R 2021-06-08 10:46:46.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-read_sources.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,65 +1,65 @@ - - - - - -context("Read Sources") - - - -test_that("read.xlsx from different sources", { - - ## URL - xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest.xlsx" - df_url <- read.xlsx(xlsxFile) - - ## File - xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - df_file <- read.xlsx(xlsxFile) - - expect_true(all.equal(df_url, df_file), label = "Read from URL") - - - ## Non-existing URL - xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest2.xlsx" - expect_error(suppressWarnings(read.xlsx(xlsxFile))) - - - ## Non-existing File - xlsxFile <- file.path(dirname(system.file("extdata", "readTest.xlsx", package = "openxlsx")), "readTest00.xlsx") - expect_error(read.xlsx(xlsxFile), regexp = "File does not exist.") -}) - - - - -test_that("loadWorkbook from different sources", { - - ## URL - xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest.xlsx" - wb_url <- loadWorkbook(xlsxFile) - - ## File - xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - wb_file <- loadWorkbook(xlsxFile) - - ## check - expect_true(all.equal.Workbook(wb_url, wb_file), "Loading from URL vs local not equal") -}) - - - -test_that("getDateOrigin from different sources", { - - ## URL - xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest.xlsx" - origin_url <- getDateOrigin(xlsxFile) - - ## File - xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - origin_file <- getDateOrigin(xlsxFile) - - ## check - expect_equal(origin_url, origin_file) - expect_equal(origin_url, "1900-01-01") -}) + + + + + +context("Read Sources") + + + +test_that("read.xlsx from different sources", { + + ## URL + xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest.xlsx" + df_url <- read.xlsx(xlsxFile) + + ## File + xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + df_file <- read.xlsx(xlsxFile) + + expect_true(all.equal(df_url, df_file), label = "Read from URL") + + + ## Non-existing URL + xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest2.xlsx" + expect_error(suppressWarnings(read.xlsx(xlsxFile))) + + + ## Non-existing File + xlsxFile <- file.path(dirname(system.file("extdata", "readTest.xlsx", package = "openxlsx")), "readTest00.xlsx") + expect_error(read.xlsx(xlsxFile), regexp = "File does not exist.") +}) + + + + +test_that("loadWorkbook from different sources", { + + ## URL + xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest.xlsx" + wb_url <- loadWorkbook(xlsxFile) + + ## File + xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + wb_file <- loadWorkbook(xlsxFile) + + ## check + expect_true(all.equal.Workbook(wb_url, wb_file), "Loading from URL vs local not equal") +}) + + + +test_that("getDateOrigin from different sources", { + + ## URL + xlsxFile <- "https://github.com/ycphs/openxlsx/raw/master/inst/extdata/readTest.xlsx" + origin_url <- getDateOrigin(xlsxFile) + + ## File + xlsxFile <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + origin_file <- getDateOrigin(xlsxFile) + + ## check + expect_equal(origin_url, origin_file) + expect_equal(origin_url, "1900-01-01") +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-read_write_logicals.R r-cran-openxlsx-4.2.5/tests/testthat/test-read_write_logicals.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-read_write_logicals.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-read_write_logicals.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,47 +1,47 @@ - - - -context("Readind and Writing Logicals") - - - -test_that("TRUE, FALSE, NA", { - curr_wd <- getwd() - fileName <- file.path(tempdir(), "T_F_NA.xlsx") - - x <- iris - x$Species <- as.character(x$Species) - x$all_t <- TRUE - x$all_f <- FALSE - x$tf <- sample(c(TRUE, FALSE), size = 150, replace = TRUE) - x$t_na <- sample(c(TRUE, NA), size = 150, replace = TRUE) - x$f_na <- sample(c(FALSE, NA), size = 150, replace = TRUE) - x$tf_na <- sample(c(TRUE, FALSE, NA), size = 150, replace = TRUE) - - wb <- write.xlsx(x, file = fileName, colNames = TRUE) - - y <- read.xlsx(fileName, sheet = 1) - expect_equal(x, y) - - ## T becomes false TRUE and NA exist in a columns - expect_equal(x$t_na, y$t_na) - expect_equal(x$f_na, y$f_na) - - expect_equal(is.na(x$f_na), is.na(y$f_na)) - expect_equal(is.na(x$tf_na), is.na(y$tf_na)) - - ## From Workbook - y <- read.xlsx(wb, sheet = 1) - expect_equal(x, y) - - - ## T becomes false TRUE and NA exist in a columns - expect_equal(x$t_na, y$t_na) - expect_equal(x$f_na, y$f_na) - - expect_equal(is.na(x$f_na), is.na(y$f_na)) - expect_equal(is.na(x$tf_na), is.na(y$tf_na)) - - expect_equal(object = getwd(), curr_wd) - unlink(fileName, recursive = TRUE, force = TRUE) -}) + + + +context("Readind and Writing Logicals") + + + +test_that("TRUE, FALSE, NA", { + curr_wd <- getwd() + fileName <- file.path(tempdir(), "T_F_NA.xlsx") + + x <- iris + x$Species <- as.character(x$Species) + x$all_t <- TRUE + x$all_f <- FALSE + x$tf <- sample(c(TRUE, FALSE), size = 150, replace = TRUE) + x$t_na <- sample(c(TRUE, NA), size = 150, replace = TRUE) + x$f_na <- sample(c(FALSE, NA), size = 150, replace = TRUE) + x$tf_na <- sample(c(TRUE, FALSE, NA), size = 150, replace = TRUE) + + wb <- write.xlsx(x, file = fileName, colNames = TRUE) + + y <- read.xlsx(fileName, sheet = 1) + expect_equal(x, y) + + ## T becomes false TRUE and NA exist in a columns + expect_equal(x$t_na, y$t_na) + expect_equal(x$f_na, y$f_na) + + expect_equal(is.na(x$f_na), is.na(y$f_na)) + expect_equal(is.na(x$tf_na), is.na(y$tf_na)) + + ## From Workbook + y <- read.xlsx(wb, sheet = 1) + expect_equal(x, y) + + + ## T becomes false TRUE and NA exist in a columns + expect_equal(x$t_na, y$t_na) + expect_equal(x$f_na, y$f_na) + + expect_equal(is.na(x$f_na), is.na(y$f_na)) + expect_equal(is.na(x$tf_na), is.na(y$tf_na)) + + expect_equal(object = getwd(), curr_wd) + unlink(fileName, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-read_xlsx_correct_sheet.R r-cran-openxlsx-4.2.5/tests/testthat/test-read_xlsx_correct_sheet.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-read_xlsx_correct_sheet.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-read_xlsx_correct_sheet.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,32 +1,32 @@ - - -context("Read xlsx") - - -test_that("read.xlsx correct sheet", { - fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - sheet_names <- getSheetNames(file = fl) - - expected_sheet_names <- c( - "Sheet1", "Sheet2", "Sheet 3", - "Sheet 4", "Sheet 5", "Sheet 6", - "1", "11", "111", "1111", "11111", "111111" - ) - - - expect_equal(object = sheet_names, expected = expected_sheet_names) - - expect_equal(read.xlsx(xlsxFile = fl, sheet = 7), data.frame(x = 1)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = 8), data.frame(x = 11)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = 9), data.frame(x = 111)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = 10), data.frame(x = 1111)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = 11), data.frame(x = 11111)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = 12), data.frame(x = 111111)) - - expect_equal(read.xlsx(xlsxFile = fl, sheet = "1"), data.frame(x = 1)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = "11"), data.frame(x = 11)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = "111"), data.frame(x = 111)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = "1111"), data.frame(x = 1111)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = "11111"), data.frame(x = 11111)) - expect_equal(read.xlsx(xlsxFile = fl, sheet = "111111"), data.frame(x = 111111)) -}) + + +context("Read xlsx") + + +test_that("read.xlsx correct sheet", { + fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + sheet_names <- getSheetNames(file = fl) + + expected_sheet_names <- c( + "Sheet1", "Sheet2", "Sheet 3", + "Sheet 4", "Sheet 5", "Sheet 6", + "1", "11", "111", "1111", "11111", "111111" + ) + + + expect_equal(object = sheet_names, expected = expected_sheet_names) + + expect_equal(read.xlsx(xlsxFile = fl, sheet = 7), data.frame(x = 1)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = 8), data.frame(x = 11)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = 9), data.frame(x = 111)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = 10), data.frame(x = 1111)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = 11), data.frame(x = 11111)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = 12), data.frame(x = 111111)) + + expect_equal(read.xlsx(xlsxFile = fl, sheet = "1"), data.frame(x = 1)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = "11"), data.frame(x = 11)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = "111"), data.frame(x = 111)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = "1111"), data.frame(x = 1111)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = "11111"), data.frame(x = 11111)) + expect_equal(read.xlsx(xlsxFile = fl, sheet = "111111"), data.frame(x = 111111)) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-read_xlsx_random_seed.R r-cran-openxlsx-4.2.5/tests/testthat/test-read_xlsx_random_seed.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-read_xlsx_random_seed.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-read_xlsx_random_seed.R 2021-12-13 08:14:44.000000000 +0000 @@ -0,0 +1,11 @@ +test_that("read_xlsx() does not change random seed", { + rs <- .Random.seed + expect_identical(rs, .Random.seed) + tf <- temp_xlsx() + expect_identical(rs, .Random.seed) + write.xlsx(data.frame(a = 1), tf) + expect_identical(rs, .Random.seed) + read.xlsx(tf) + expect_identical(rs, .Random.seed) + unlink(tf) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-remove_worksheets.R r-cran-openxlsx-4.2.5/tests/testthat/test-remove_worksheets.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-remove_worksheets.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-remove_worksheets.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,62 +1,62 @@ - - - - -context("Removing worksheets.") - -test_that("Deleting worksheets", { - tempFile <- temp_xlsx() - genWS <- function(wb, sheetName) { - addWorksheet(wb, sheetName) - writeDataTable(wb, sheetName, data.frame("X" = sprintf("This is sheet: %s", sheetName)), colNames = FALSE) - } - - wb <- createWorkbook() - genWS(wb, "Sheet 1") - genWS(wb, "Sheet 2") - genWS(wb, "Sheet 3") - - expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3")) - - removeWorksheet(wb, sheet = 1) - expect_equal(names(wb), c("Sheet 2", "Sheet 3")) - - - removeWorksheet(wb, sheet = 1) - expect_equal(names(wb), c("Sheet 3")) - - - ## add to end - genWS(wb, "Sheet 1") - genWS(wb, "Sheet 2") - expect_equal(names(wb), c("Sheet 3", "Sheet 1", "Sheet 2")) - - saveWorkbook(wb, tempFile, overwrite = TRUE) - - ## re-load & re-order worksheets - - wb <- loadWorkbook(tempFile) - expect_equal(names(wb), c("Sheet 3", "Sheet 1", "Sheet 2")) - - writeData(wb, sheet = "Sheet 2", x = iris[1:10, 1:4], startRow = 5) - expect_equal(iris[1:10, 1:4], read.xlsx(wb, "Sheet 2", startRow = 5)) - - - writeData(wb, sheet = 1, x = iris[1:20, 1:4], startRow = 5) - expect_equal(iris[1:20, 1:4], read.xlsx(wb, "Sheet 3", startRow = 5)) - - - removeWorksheet(wb, sheet = 1) - expect_equal("This is sheet: Sheet 1", read.xlsx(wb, 1, startRow = 1)[[1]]) - - removeWorksheet(wb, sheet = 2) - expect_equal("This is sheet: Sheet 1", read.xlsx(wb, 1, startRow = 1)[[1]]) - - removeWorksheet(wb, sheet = 1) - expect_equal(names(wb), character(0)) - - - - unlink(tempFile, recursive = TRUE, force = TRUE) - rm(wb) -}) + + + + +context("Removing worksheets.") + +test_that("Deleting worksheets", { + tempFile <- temp_xlsx() + genWS <- function(wb, sheetName) { + addWorksheet(wb, sheetName) + writeDataTable(wb, sheetName, data.frame("X" = sprintf("This is sheet: %s", sheetName)), colNames = FALSE) + } + + wb <- createWorkbook() + genWS(wb, "Sheet 1") + genWS(wb, "Sheet 2") + genWS(wb, "Sheet 3") + + expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3")) + + removeWorksheet(wb, sheet = 1) + expect_equal(names(wb), c("Sheet 2", "Sheet 3")) + + + removeWorksheet(wb, sheet = 1) + expect_equal(names(wb), c("Sheet 3")) + + + ## add to end + genWS(wb, "Sheet 1") + genWS(wb, "Sheet 2") + expect_equal(names(wb), c("Sheet 3", "Sheet 1", "Sheet 2")) + + saveWorkbook(wb, tempFile, overwrite = TRUE) + + ## re-load & re-order worksheets + + wb <- loadWorkbook(tempFile) + expect_equal(names(wb), c("Sheet 3", "Sheet 1", "Sheet 2")) + + writeData(wb, sheet = "Sheet 2", x = iris[1:10, 1:4], startRow = 5) + expect_equal(iris[1:10, 1:4], read.xlsx(wb, "Sheet 2", startRow = 5)) + + + writeData(wb, sheet = 1, x = iris[1:20, 1:4], startRow = 5) + expect_equal(iris[1:20, 1:4], read.xlsx(wb, "Sheet 3", startRow = 5)) + + + removeWorksheet(wb, sheet = 1) + expect_equal("This is sheet: Sheet 1", read.xlsx(wb, 1, startRow = 1)[[1]]) + + removeWorksheet(wb, sheet = 2) + expect_equal("This is sheet: Sheet 1", read.xlsx(wb, 1, startRow = 1)[[1]]) + + removeWorksheet(wb, sheet = 1) + expect_equal(names(wb), character(0)) + + + + unlink(tempFile, recursive = TRUE, force = TRUE) + rm(wb) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-saveWorkbook.R r-cran-openxlsx-4.2.5/tests/testthat/test-saveWorkbook.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-saveWorkbook.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-saveWorkbook.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,19 +1,63 @@ - -context("save workbook") - - -test_that("test return values for saveWorkbook", { - - tempFile <- temp_xlsx() - wb<-createWorkbook() - addWorksheet(wb,"name") - expect_true( saveWorkbook(wb,tempFile,returnValue = TRUE)) - - expect_error( saveWorkbook(wb,tempFile,returnValue = TRUE)) - - - expect_invisible( saveWorkbook(wb,tempFile,returnValue = FALSE ,overwrite = TRUE)) - unlink(tempFile, recursive = TRUE, force = TRUE) - -} -) + +context("save workbook") + + +test_that("test return values for saveWorkbook", { + + tempFile <- temp_xlsx() + wb<-createWorkbook() + addWorksheet(wb,"name") + expect_true( saveWorkbook(wb,tempFile,returnValue = TRUE)) + + expect_error( saveWorkbook(wb,tempFile,returnValue = TRUE)) + + + expect_invisible( saveWorkbook(wb,tempFile,returnValue = FALSE ,overwrite = TRUE)) + unlink(tempFile, recursive = TRUE, force = TRUE) + +} +) + +# regression test for a typo +test_that("regression test for #248", { + + # Basic data frame + df <- data.frame(number = 1:3, percent = 4:6/100) + tempFile <- temp_xlsx() + + # no formatting + expect_silent(write.xlsx(df, tempFile, borders = "columns", overwrite = TRUE)) + + # Change column class to percentage + class(df$percent) <- "percentage" + expect_silent(write.xlsx(df, tempFile, borders = "columns", overwrite = TRUE)) +}) + + +# test for hyperrefs +test_that("creating hyperlinks", { + + # prepare a file + tempFile <- temp_xlsx() + wb <- createWorkbook() + sheet <- "test" + addWorksheet(wb, sheet) + img <- "D:/somepath/somepicture.png" + + # warning: col and row provided, but not required + expect_warning( + linkString <- makeHyperlinkString(col = 1, row = 4, + text = "test.png", file = img)) + + linkString2 <- makeHyperlinkString(text = "test.png", file = img) + + # col and row not needed + expect_equal(linkString, linkString2) + + # write file without errors + writeFormula(wb, sheet, x = linkString, startCol = 1, startRow = 1) + expect_silent(saveWorkbook(wb, tempFile, overwrite = TRUE)) + + # TODO: add a check that the written xlsx file contains linkString + +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-skip_empty_cols.R r-cran-openxlsx-4.2.5/tests/testthat/test-skip_empty_cols.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-skip_empty_cols.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-skip_empty_cols.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,247 +1,247 @@ - -context("Skip Empty Cols") - -test_that("skip empty rows", { - xlsxfile <- temp_xlsx() - df <- data.frame("x" = c(1, NA, NA, 2), "y" = c(1, NA, NA, 3)) - - write.xlsx(df, xlsxfile) - - wb <- loadWorkbook(xlsxfile) - - df1 <- readWorkbook(xlsxfile, skipEmptyRows = FALSE) - df2 <- readWorkbook(wb, skipEmptyRows = FALSE) - - expect_equal(df, df1) - expect_equal(df, df2) - - v <- c("A1", "B1", "A2", "B2", "A5", "B5") - expect_equal(calc_number_rows(x = v, skipEmptyRows = TRUE), 3) - expect_equal(calc_number_rows(x = v, skipEmptyRows = FALSE), 5) - - ## DONT SKIP - df1 <- readWorkbook(xlsxfile, skipEmptyRows = TRUE) - df2 <- readWorkbook(wb, skipEmptyRows = TRUE) - - expect_equal(nrow(df1), 2) - expect_equal(nrow(df2), 2) - - expect_equivalent(df[c(1, 4), ], df1) - expect_equivalent(df[c(1, 4), ], df2) -}) - -test_that("Version 4 fixes from File", { - fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 4L) - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 4L) - - - ############################################################## - ## FALSE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## FALSE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[2, ]))) - - - - ############################################################## - ## FALSE TRUE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - - ############################################################## - ## FALSE TRUE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - ############################################################## - ## TRUE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 4L) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## TRUE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 4L) - - - ## NA rows - expect_true(all(is.na(x[2, ]))) -}) - - - - - - -test_that("Version 4 fixes from Workbook Objects", { - fl <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) - - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 4L) - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 4L) - - - ############################################################## - ## FALSE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## FALSE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[2, ]))) - - - - ############################################################## - ## FALSE TRUE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - - ############################################################## - ## FALSE TRUE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - ############################################################## - ## TRUE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 4L) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## TRUE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 4L) - - - ## NA rows - expect_true(all(is.na(x[2, ]))) -}) + +context("Skip Empty Cols") + +test_that("skip empty rows", { + xlsxfile <- temp_xlsx() + df <- data.frame("x" = c(1, NA, NA, 2), "y" = c(1, NA, NA, 3)) + + write.xlsx(df, xlsxfile) + + wb <- loadWorkbook(xlsxfile) + + df1 <- readWorkbook(xlsxfile, skipEmptyRows = FALSE) + df2 <- readWorkbook(wb, skipEmptyRows = FALSE) + + expect_equal(df, df1) + expect_equal(df, df2) + + v <- c("A1", "B1", "A2", "B2", "A5", "B5") + expect_equal(calc_number_rows(x = v, skipEmptyRows = TRUE), 3) + expect_equal(calc_number_rows(x = v, skipEmptyRows = FALSE), 5) + + ## DONT SKIP + df1 <- readWorkbook(xlsxfile, skipEmptyRows = TRUE) + df2 <- readWorkbook(wb, skipEmptyRows = TRUE) + + expect_equal(nrow(df1), 2) + expect_equal(nrow(df2), 2) + + expect_equivalent(df[c(1, 4), ], df1) + expect_equivalent(df[c(1, 4), ], df2) +}) + +test_that("Version 4 fixes from File", { + fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 4L) + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 4L) + + + ############################################################## + ## FALSE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## FALSE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[2, ]))) + + + + ############################################################## + ## FALSE TRUE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + + ############################################################## + ## FALSE TRUE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + ############################################################## + ## TRUE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 4L) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## TRUE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 4L) + + + ## NA rows + expect_true(all(is.na(x[2, ]))) +}) + + + + + + +test_that("Version 4 fixes from Workbook Objects", { + fl <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) + + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 4L) + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 4L) + + + ############################################################## + ## FALSE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## FALSE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[2, ]))) + + + + ############################################################## + ## FALSE TRUE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + + ############################################################## + ## FALSE TRUE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + ############################################################## + ## TRUE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 4L) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## TRUE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 4L) + + + ## NA rows + expect_true(all(is.na(x[2, ]))) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-skip_empty_rows.R r-cran-openxlsx-4.2.5/tests/testthat/test-skip_empty_rows.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-skip_empty_rows.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-skip_empty_rows.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,321 +1,321 @@ - -context("Skip Empty Rows") - -test_that("skip empty rows", { - xlsxfile <- temp_xlsx() - df <- data.frame("x" = c(1, NA, NA, 2), "y" = c(1, NA, NA, 3)) - - write.xlsx(df, xlsxfile) - - wb <- loadWorkbook(xlsxfile) - - df1 <- readWorkbook(xlsxfile, skipEmptyRows = FALSE) - df2 <- readWorkbook(wb, skipEmptyRows = FALSE) - - expect_equal(df, df1) - expect_equal(df, df2) - - - v <- c("A1", "B1", "A2", "B2", "A5", "B5") - expect_equal(calc_number_rows(x = v, skipEmptyRows = TRUE), 3) - expect_equal(calc_number_rows(x = v, skipEmptyRows = FALSE), 5) - - ## DONT SKIP - df1 <- readWorkbook(xlsxfile, skipEmptyRows = TRUE) - df2 <- readWorkbook(wb, skipEmptyRows = TRUE) - - expect_equal(nrow(df1), 2) - expect_equal(nrow(df2), 2) - - expect_equivalent(df[c(1, 4), ], df1) - expect_equivalent(df[c(1, 4), ], df2) -}) - -test_that("skip empty cols", { - xlsxfile <- temp_xlsx() - x <- data.frame("a" = c(1, NA, NA, 2), "b" = c(1, NA, NA, 3)) - y <- data.frame("x" = c(1, NA, NA, 2), "y" = c(1, NA, NA, 3)) - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - - writeData(wb, sheet = 1, x = x) - writeData(wb, sheet = 1, x = y, startCol = 4) - - saveWorkbook(wb, file = xlsxfile) - - - ## from file - res <- readWorkbook(xlsxfile, skipEmptyRows = FALSE, skipEmptyCols = FALSE) - expect_equal(ncol(res), 5) - expect_equal(nrow(res), 4) - - ## from file - res <- readWorkbook(xlsxfile, skipEmptyRows = TRUE, skipEmptyCols = TRUE) - expect_equal(ncol(res), 4) - expect_equal(nrow(res), 2) - expect_equivalent(cbind(x, y)[c(1, 4), ], res) - - ## from file - res <- readWorkbook(xlsxfile, skipEmptyRows = FALSE, skipEmptyCols = TRUE) - expect_equal(ncol(res), 4) - expect_equal(nrow(res), 4) - expect_equivalent(cbind(x, y), res) - - ## from file - res <- readWorkbook(xlsxfile, skipEmptyRows = TRUE, skipEmptyCols = FALSE) - expect_equal(ncol(res), 5) - expect_equal(nrow(res), 2) - expect_true(all(is.na(res$X3))) - - - - - ############################################################################# - ## Workbook object - - ## Workbook object - wb <- loadWorkbook(xlsxfile) - - ## from workbook object - res <- readWorkbook(wb, skipEmptyRows = FALSE, skipEmptyCols = FALSE) - expect_equal(ncol(res), 5) - expect_equal(nrow(res), 4) - - ## from workbook object - res <- readWorkbook(wb, skipEmptyRows = TRUE, skipEmptyCols = TRUE) - expect_equal(ncol(res), 4) - expect_equal(nrow(res), 2) - expect_equivalent(cbind(x, y)[c(1, 4), ], res) - - ## from workbook object - res <- readWorkbook(wb, skipEmptyRows = FALSE, skipEmptyCols = TRUE) - expect_equal(ncol(res), 4) - expect_equal(nrow(res), 4) - expect_equivalent(cbind(x, y), res) - - ## from workbook object - res <- readWorkbook(wb, skipEmptyRows = TRUE, skipEmptyCols = FALSE) - expect_equal(ncol(res), 5) - expect_equal(nrow(res), 2) - expect_true(all(is.na(res$X3))) -}) - - - -test_that("Version 4 fixes from File", { - fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 4L) - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 4L) - - - ############################################################## - ## FALSE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## FALSE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[2, ]))) - - - - ############################################################## - ## FALSE TRUE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - - ############################################################## - ## FALSE TRUE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - ############################################################## - ## TRUE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 4L) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## TRUE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 4L) - - - ## NA rows - expect_true(all(is.na(x[2, ]))) -}) - - - - - - -test_that("Version 4 fixes from Workbook Objects", { - fl <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) - - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 4L) - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 4L) - - - ############################################################## - ## FALSE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## FALSE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - ## NA rows - expect_true(all(is.na(x[2, ]))) - - - - ############################################################## - ## FALSE TRUE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) - expect_equal(nrow(x), 5L) - expect_equal(ncol(x), 8L) - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - - ############################################################## - ## FALSE TRUE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) - expect_equal(nrow(x), 5L - 1L) - expect_equal(ncol(x), 8L) - - - ## NA columns - expect_true(all(is.na(x$X1))) - expect_true(all(is.na(x$X2))) - expect_true(all(is.na(x$X3))) - expect_true(all(is.na(x$X7))) - - - - ############################################################## - ## TRUE FALSE FALSE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) - expect_equal(nrow(x), 6L) - expect_equal(ncol(x), 4L) - - ## NA rows - expect_true(all(is.na(x[3, ]))) - - - - ############################################################## - ## TRUE FALSE TRUE - - x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) - expect_equal(nrow(x), 6L - 1L) - expect_equal(ncol(x), 4L) - - - ## NA rows - expect_true(all(is.na(x[2, ]))) -}) + +context("Skip Empty Rows") + +test_that("skip empty rows", { + xlsxfile <- temp_xlsx() + df <- data.frame("x" = c(1, NA, NA, 2), "y" = c(1, NA, NA, 3)) + + write.xlsx(df, xlsxfile) + + wb <- loadWorkbook(xlsxfile) + + df1 <- readWorkbook(xlsxfile, skipEmptyRows = FALSE) + df2 <- readWorkbook(wb, skipEmptyRows = FALSE) + + expect_equal(df, df1) + expect_equal(df, df2) + + + v <- c("A1", "B1", "A2", "B2", "A5", "B5") + expect_equal(calc_number_rows(x = v, skipEmptyRows = TRUE), 3) + expect_equal(calc_number_rows(x = v, skipEmptyRows = FALSE), 5) + + ## DONT SKIP + df1 <- readWorkbook(xlsxfile, skipEmptyRows = TRUE) + df2 <- readWorkbook(wb, skipEmptyRows = TRUE) + + expect_equal(nrow(df1), 2) + expect_equal(nrow(df2), 2) + + expect_equivalent(df[c(1, 4), ], df1) + expect_equivalent(df[c(1, 4), ], df2) +}) + +test_that("skip empty cols", { + xlsxfile <- temp_xlsx() + x <- data.frame("a" = c(1, NA, NA, 2), "b" = c(1, NA, NA, 3)) + y <- data.frame("x" = c(1, NA, NA, 2), "y" = c(1, NA, NA, 3)) + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + writeData(wb, sheet = 1, x = x) + writeData(wb, sheet = 1, x = y, startCol = 4) + + saveWorkbook(wb, file = xlsxfile) + + + ## from file + res <- readWorkbook(xlsxfile, skipEmptyRows = FALSE, skipEmptyCols = FALSE) + expect_equal(ncol(res), 5) + expect_equal(nrow(res), 4) + + ## from file + res <- readWorkbook(xlsxfile, skipEmptyRows = TRUE, skipEmptyCols = TRUE) + expect_equal(ncol(res), 4) + expect_equal(nrow(res), 2) + expect_equivalent(cbind(x, y)[c(1, 4), ], res) + + ## from file + res <- readWorkbook(xlsxfile, skipEmptyRows = FALSE, skipEmptyCols = TRUE) + expect_equal(ncol(res), 4) + expect_equal(nrow(res), 4) + expect_equivalent(cbind(x, y), res) + + ## from file + res <- readWorkbook(xlsxfile, skipEmptyRows = TRUE, skipEmptyCols = FALSE) + expect_equal(ncol(res), 5) + expect_equal(nrow(res), 2) + expect_true(all(is.na(res$X3))) + + + + + ############################################################################# + ## Workbook object + + ## Workbook object + wb <- loadWorkbook(xlsxfile) + + ## from workbook object + res <- readWorkbook(wb, skipEmptyRows = FALSE, skipEmptyCols = FALSE) + expect_equal(ncol(res), 5) + expect_equal(nrow(res), 4) + + ## from workbook object + res <- readWorkbook(wb, skipEmptyRows = TRUE, skipEmptyCols = TRUE) + expect_equal(ncol(res), 4) + expect_equal(nrow(res), 2) + expect_equivalent(cbind(x, y)[c(1, 4), ], res) + + ## from workbook object + res <- readWorkbook(wb, skipEmptyRows = FALSE, skipEmptyCols = TRUE) + expect_equal(ncol(res), 4) + expect_equal(nrow(res), 4) + expect_equivalent(cbind(x, y), res) + + ## from workbook object + res <- readWorkbook(wb, skipEmptyRows = TRUE, skipEmptyCols = FALSE) + expect_equal(ncol(res), 5) + expect_equal(nrow(res), 2) + expect_true(all(is.na(res$X3))) +}) + + + +test_that("Version 4 fixes from File", { + fl <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 4L) + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 4L) + + + ############################################################## + ## FALSE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## FALSE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[2, ]))) + + + + ############################################################## + ## FALSE TRUE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + + ############################################################## + ## FALSE TRUE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + ############################################################## + ## TRUE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 4L) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## TRUE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 4L) + + + ## NA rows + expect_true(all(is.na(x[2, ]))) +}) + + + + + + +test_that("Version 4 fixes from Workbook Objects", { + fl <- loadWorkbook(system.file("extdata", "readTest.xlsx", package = "openxlsx")) + + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 4L) + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 4L) + + + ############################################################## + ## FALSE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## FALSE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + ## NA rows + expect_true(all(is.na(x[2, ]))) + + + + ############################################################## + ## FALSE TRUE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = FALSE) + expect_equal(nrow(x), 5L) + expect_equal(ncol(x), 8L) + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + + ############################################################## + ## FALSE TRUE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = FALSE, skipEmptyRows = TRUE, colNames = TRUE) + expect_equal(nrow(x), 5L - 1L) + expect_equal(ncol(x), 8L) + + + ## NA columns + expect_true(all(is.na(x$X1))) + expect_true(all(is.na(x$X2))) + expect_true(all(is.na(x$X3))) + expect_true(all(is.na(x$X7))) + + + + ############################################################## + ## TRUE FALSE FALSE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = FALSE) + expect_equal(nrow(x), 6L) + expect_equal(ncol(x), 4L) + + ## NA rows + expect_true(all(is.na(x[3, ]))) + + + + ############################################################## + ## TRUE FALSE TRUE + + x <- read.xlsx(xlsxFile = fl, sheet = 4, skipEmptyCols = TRUE, skipEmptyRows = FALSE, colNames = TRUE) + expect_equal(nrow(x), 6L - 1L) + expect_equal(ncol(x), 4L) + + + ## NA rows + expect_true(all(is.na(x[2, ]))) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-style_replacing.R r-cran-openxlsx-4.2.5/tests/testthat/test-style_replacing.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-style_replacing.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-style_replacing.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,24 +0,0 @@ - - - - -# context("Replacing styles") -# -# -# -# test_that("Replace styles", { -# -# # tempFile <- file.path(tempdir(), "temp.xlsx") -# # wb <- loadWorkbook(file = file.path(path.package("openxlsx"), "loadExample.xlsx")) -# # -# # ## create a new style and replace style 2 -# # -# # newStyle <- createStyle(fgFill = "#FF0000") -# # -# # ## replace style 2 -# # getStyles(wb) ## prints styles -# # replaceStyle(wb, 87, newStyle = newStyle) -# # -# # rm(wb) -# -# }) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-styles.R r-cran-openxlsx-4.2.5/tests/testthat/test-styles.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-styles.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-styles.R 2021-12-13 08:14:44.000000000 +0000 @@ -0,0 +1,50 @@ + +context("Styles") + +test_that("setStyle", { + + tmp_file <- temp_xlsx() + + # lorem ipsum + txt <- paste0( + "Lorem ipsum dolor sit amet, consectetur adipiscing elit, ", + "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. ", + "Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris", + "nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in ", + "reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla", + "pariatur. Excepteur sint occaecat cupidatat non proident, sunt in ", + "culpa qui officia deserunt mollit anim id est laborum." + ) + + ## create workbook + wb <- createWorkbook() + addWorksheet(wb, "Test") + writeData(wb, "Test", txt) + + ## create a style + s <- createStyle( + fontSize = 12, + fontColour = "black", + valign="center", + wrapText = TRUE, + halign = "justify" + ) + addStyle(wb, "Test", s, 1, 1) + setColWidths(wb, "Test", 1, 50) + setRowHeights(wb, "Test", 1, 150) + + ## save workbook + saveWorkbook(wb, tmp_file) + + ## load it again + wb2 <- loadWorkbook(tmp_file) + s2 <- getStyles(wb2)[[1]] + + ## test that the style survived the round trip + expect_equal(s2$fontSize, c(val="12")) + expect_equal(s2$fontColour, c(rgb="FF000000")) + expect_equal(s2$valign, "center") + expect_equal(s2$wrapText, TRUE) + expect_equal(s2$halign, "justify") + +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-table_overlaps.R r-cran-openxlsx-4.2.5/tests/testthat/test-table_overlaps.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-table_overlaps.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-table_overlaps.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,103 +1,103 @@ - - - - - -context("Writing over tables") - - - -test_that("writeDataTable over tables", { - overwrite_table_error <- "Cannot overwrite existing table with another table" - df1 <- data.frame("X" = 1:10) - - wb <- createWorkbook() - addWorksheet(wb, "Sheet1") - - ## table covers rows 4->10 and cols 4->8 - writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 4) - - ## should all run without error - writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 3, startRow = 2) - writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 9, startRow = 2) - writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 4, startRow = 11) - writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 5, startRow = 11) - writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 6, startRow = 11) - writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 7, startRow = 11) - writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 8, startRow = 11) - writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 1) - - - - ## Now error - expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = "H", startRow = 21), regexp = overwrite_table_error) - expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 3, startRow = 12), regexp = overwrite_table_error) - expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 9, startRow = 12), regexp = overwrite_table_error) - expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = "i", startRow = 12), regexp = overwrite_table_error) - - - ## more errors - expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris)), regexp = overwrite_table_error) - expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 21), regexp = overwrite_table_error) - - ## should work - writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 22) - writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 40) - - - ## more errors - expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 38), regexp = overwrite_table_error) - expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 38, colNames = FALSE), regexp = overwrite_table_error) - - expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = "H", startRow = 40), regexp = overwrite_table_error) - writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = "I", startRow = 40) - writeDataTable(wb = wb, sheet = 1, x = head(iris)[, 1:3], startCol = "A", startRow = 40) - - expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 38, colNames = FALSE), regexp = overwrite_table_error) - expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 1, startRow = 46, colNames = FALSE), regexp = overwrite_table_error) -}) - - - - - -test_that("writeData over tables", { - overwrite_table_error <- "Cannot overwrite table headers. Avoid writing over the header row" - df1 <- data.frame("X" = 1:10) - - wb <- createWorkbook() - addWorksheet(wb, "Sheet1") - - ## table covers rows 4->10 and cols 4->8 - writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 4) - - ## Anywhere on row 5 is fine - for (i in 1:10) { - writeData(wb = wb, sheet = 1, x = head(iris), startRow = 5, startCol = i) - } - - ## Anywhere on col i is fine - for (i in 1:10) { - writeData(wb = wb, sheet = 1, x = head(iris), startRow = i, startCol = "i") - } - - - - ## Now errors on headers - expect_error(writeData(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 4), regexp = overwrite_table_error) - writeData(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 5) - writeData(wb = wb, sheet = 1, x = head(iris)[1:3]) - writeData(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4) - writeData(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, colNames = FALSE) - - - ## Example of how this should be used - writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 30) - writeData(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 31, colNames = FALSE) - - writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 10, startRow = 30) - writeData(wb = wb, sheet = 1, x = tail(iris), startCol = 10, startRow = 31, colNames = FALSE) - - writeDataTable(wb = wb, sheet = 1, x = head(iris)[, 1:3], startCol = 1, startRow = 30) - writeData(wb = wb, sheet = 1, x = tail(iris), startCol = 1, startRow = 31, colNames = FALSE) -}) + + + + + +context("Writing over tables") + + + +test_that("writeDataTable over tables", { + overwrite_table_error <- "Cannot overwrite existing table with another table" + df1 <- data.frame("X" = 1:10) + + wb <- createWorkbook() + addWorksheet(wb, "Sheet1") + + ## table covers rows 4->10 and cols 4->8 + writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 4) + + ## should all run without error + writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 3, startRow = 2) + writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 9, startRow = 2) + writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 4, startRow = 11) + writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 5, startRow = 11) + writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 6, startRow = 11) + writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 7, startRow = 11) + writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 8, startRow = 11) + writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 1) + + + + ## Now error + expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = "H", startRow = 21), regexp = overwrite_table_error) + expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 3, startRow = 12), regexp = overwrite_table_error) + expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = 9, startRow = 12), regexp = overwrite_table_error) + expect_error(writeDataTable(wb = wb, sheet = 1, x = df1, startCol = "i", startRow = 12), regexp = overwrite_table_error) + + + ## more errors + expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris)), regexp = overwrite_table_error) + expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 21), regexp = overwrite_table_error) + + ## should work + writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 22) + writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 40) + + + ## more errors + expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 38), regexp = overwrite_table_error) + expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 38, colNames = FALSE), regexp = overwrite_table_error) + + expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = "H", startRow = 40), regexp = overwrite_table_error) + writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = "I", startRow = 40) + writeDataTable(wb = wb, sheet = 1, x = head(iris)[, 1:3], startCol = "A", startRow = 40) + + expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, startRow = 38, colNames = FALSE), regexp = overwrite_table_error) + expect_error(writeDataTable(wb = wb, sheet = 1, x = head(iris, 2), startCol = 1, startRow = 46, colNames = FALSE), regexp = overwrite_table_error) +}) + + + + + +test_that("writeData over tables", { + overwrite_table_error <- "Cannot overwrite table headers. Avoid writing over the header row" + df1 <- data.frame("X" = 1:10) + + wb <- createWorkbook() + addWorksheet(wb, "Sheet1") + + ## table covers rows 4->10 and cols 4->8 + writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 4) + + ## Anywhere on row 5 is fine + for (i in 1:10) { + writeData(wb = wb, sheet = 1, x = head(iris), startRow = 5, startCol = i) + } + + ## Anywhere on col i is fine + for (i in 1:10) { + writeData(wb = wb, sheet = 1, x = head(iris), startRow = i, startCol = "i") + } + + + + ## Now errors on headers + expect_error(writeData(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 4), regexp = overwrite_table_error) + writeData(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 5) + writeData(wb = wb, sheet = 1, x = head(iris)[1:3]) + writeData(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4) + writeData(wb = wb, sheet = 1, x = head(iris, 2), startCol = 4, colNames = FALSE) + + + ## Example of how this should be used + writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 30) + writeData(wb = wb, sheet = 1, x = head(iris), startCol = 4, startRow = 31, colNames = FALSE) + + writeDataTable(wb = wb, sheet = 1, x = head(iris), startCol = 10, startRow = 30) + writeData(wb = wb, sheet = 1, x = tail(iris), startCol = 10, startRow = 31, colNames = FALSE) + + writeDataTable(wb = wb, sheet = 1, x = head(iris)[, 1:3], startCol = 1, startRow = 30) + writeData(wb = wb, sheet = 1, x = tail(iris), startCol = 1, startRow = 31, colNames = FALSE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-trying_to_break_openxlsx.R r-cran-openxlsx-4.2.5/tests/testthat/test-trying_to_break_openxlsx.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-trying_to_break_openxlsx.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-trying_to_break_openxlsx.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,212 +1,212 @@ - - - -context("Images and Tables.") - - -test_that("Images and Tables - reordering and removing", { - if (FALSE) { - options("stringsAsFactors" = FALSE) - tempFile <- temp_xlsx("break") - - getPlot <- function(i) { - n <- 5000 - plot(1:n, rnorm(n)) - title(main = sprintf("Plot for Sheet: %s", i)) - } - - df1 <- iris[1:5, 1:4] - df2 <- mtcars - - - df3 <- data.frame( - "Date" = Sys.Date() - 0:10, - "Logical" = sample(c(TRUE, FALSE), 1, replace = TRUE), - "Currency" = as.numeric(-5:5) * 100, - "Accounting" = as.numeric(-5:5), - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(-5, 5, length.out = 11), - "TinyNumber" = runif(11) / 1E9, stringsAsFactors = FALSE - ) - - df3U <- df3 - - class(df3$Currency) <- "currency" - class(df3$Accounting) <- "accounting" - class(df3$hLink) <- "hyperlink" - class(df3$Percentage) <- "percentage" - class(df3$TinyNumber) <- "scientific" - - - df4 <- data.frame("X" = 1:10000, "Y" = sample(LETTERS, size = 10000, replace = TRUE)) - df5 <- USJudgeRatings - - hs <- createStyle(fontColour = "blue", textRotation = 45) - - - wb <- createWorkbook() - expect_equal(names(wb), character(0)) - - addWorksheet(wb = wb, sheetName = "Sheet 1", gridLines = FALSE, tabColour = "red", zoom = 75) - writeDataTable(wb, sheet = 1, x = df1, startCol = 7, startRow = 10, tableName = "Sheet1Table1") - expect_equal(names(wb), "Sheet 1") - - - addWorksheet(wb, sheetName = "Sheet 2", tabColour = "purple") - writeDataTable(wb, sheet = "Sheet 2", x = df2, startCol = 2, startRow = 2, rowNames = TRUE) - expect_equal(names(wb), c("Sheet 1", "Sheet 2")) - - - - addWorksheet(wb, sheetName = "Sheet 3", tabColour = "green") - writeDataTable(wb, sheet = 3, x = df3, startCol = 1, startRow = 1) - expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3")) - - addWorksheet(wb, sheetName = "Sheet 4", tabColour = "orange") - writeDataTable(wb, sheet = 4, x = df4) - expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4")) - - addWorksheet(wb, sheetName = "Sheet 5", tabColour = "yellow") - writeData(wb, sheet = "Sheet 5", x = df5, rowNames = TRUE) - expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4", "Sheet 5")) - - - - worksheetOrder(wb) <- c(1, 3, 5, 4, 2) - expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4", "Sheet 5")) - - ## save and load 1 - saveWorkbook(wb, file = tempFile, overwrite = TRUE) - - wb <- loadWorkbook(tempFile) - expect_equal(names(wb), c("Sheet 1", "Sheet 3", "Sheet 5", "Sheet 4", "Sheet 2")) - - - expect_equal(df1, read.xlsx(wb, sheet = 1)) - expect_equal(df1, read.xlsx(wb, sheet = "Sheet 1")) - expect_equal(df1, read.xlsx(tempFile, sheet = 1)) - expect_equal(df1, read.xlsx(tempFile, sheet = "Sheet 1")) - - - expect_equal(df3U, read.xlsx(wb, sheet = 2, detectDates = TRUE)) - expect_equal(df3U, read.xlsx(wb, sheet = "Sheet 3", detectDates = TRUE)) - expect_equal(df3U, read.xlsx(tempFile, sheet = 2, detectDates = TRUE)) - expect_equal(df3U, read.xlsx(tempFile, sheet = "Sheet 3", detectDates = TRUE)) - - - expect_equal(df5, read.xlsx(wb, sheet = 3, rowNames = TRUE)) - expect_equal(df5, read.xlsx(wb, sheet = "Sheet 5", rowNames = TRUE)) - expect_equal(df5, read.xlsx(tempFile, sheet = 3, rowNames = TRUE)) - expect_equal(df5, read.xlsx(tempFile, sheet = "Sheet 5", rowNames = TRUE)) - - - expect_equal(df4, read.xlsx(wb, sheet = 4)) - expect_equal(df4, read.xlsx(wb, sheet = "Sheet 4")) - expect_equal(df4, read.xlsx(tempFile, sheet = 4)) - expect_equal(df4, read.xlsx(tempFile, sheet = "Sheet 4")) - - - expect_equal(df2, read.xlsx(wb, sheet = 5, rowNames = TRUE)) - expect_equal(df2, read.xlsx(wb, sheet = "Sheet 2", rowNames = TRUE)) - expect_equal(df2, read.xlsx(tempFile, sheet = 5, rowNames = TRUE)) - expect_equal(df2, read.xlsx(tempFile, sheet = "Sheet 2", rowNames = TRUE)) - - - - ## remove "Sheet 5" by index (3) - removeWorksheet(wb, sheet = 3) - expect_equal(names(wb), c("Sheet 1", "Sheet 3", "Sheet 4", "Sheet 2")) - - ## remove sheet "Sheet 4" - removeWorksheet(wb, sheet = "Sheet 4") - expect_equal(names(wb), c("Sheet 1", "Sheet 3", "Sheet 2")) - - - ## Introduce some images - getPlot(1) - insertPlot(wb = wb, sheet = "Sheet 1", startCol = 14, startRow = 3) - - getPlot(2) - insertPlot(wb = wb, sheet = "Sheet 2", startCol = 14, startRow = 3) - - getPlot(3) - insertPlot(wb = wb, sheet = "Sheet 3", startCol = 14, startRow = 3) - - - expect_true(any(grepl("image1", wb$drawings_rels[[1]]))) - expect_true(any(grepl("image3", wb$drawings_rels[[2]]))) - expect_true(any(grepl("image2", wb$drawings_rels[[3]]))) - - - - ## put back to original order - worksheetOrder(wb) <- c(1, 3, 2) - saveWorkbook(wb, file = tempFile, overwrite = TRUE) - - wb <- loadWorkbook(file = tempFile) - - - ## drawings added in order - expect_true(any(grepl("image1", wb$drawings_rels[[1]]))) - expect_true(any(grepl("image2", wb$drawings_rels[[2]]))) - expect_true(any(grepl("image3", wb$drawings_rels[[3]]))) - - - ## Introduce some more images - getPlot("1_2") - insertPlot(wb = wb, sheet = "Sheet 1", startCol = 14, startRow = 25) - - getPlot("2_2") - insertPlot(wb = wb, sheet = "Sheet 2", startCol = 14, startRow = 25) - - - getPlot("3_2") - insertPlot(wb = wb, sheet = "Sheet 3", startCol = 14, startRow = 25) - - saveWorkbook(wb, file = tempFile, overwrite = TRUE) - wb <- loadWorkbook(tempFile) - - worksheetOrder(wb) <- c(3, 2, 1) - saveWorkbook(wb, file = tempFile, overwrite = TRUE) - wb <- loadWorkbook(tempFile) - - - hl <- rep("https://google.com.au", 5) - names(hl) <- sprintf("Link to google %s", 1:5) - class(hl) <- "hyperlink" - writeData(wb, "Sheet 1", hl) - - ## Add in some column widths - - setColWidths(wb, sheet = 1, cols = 1:50, widths = "auto") - worksheetOrder(wb) <- c(3, 2, 1) - removeWorksheet(wb, sheet = "Sheet 2") - - saveWorkbook(wb, file = tempFile, overwrite = TRUE) - wb <- loadWorkbook(tempFile) - - expect_equal(names(wb), c("Sheet 1", "Sheet 3")) - expect_equal(df1, read.xlsx(tempFile, sheet = 1, startRow = 10)) - expect_equal(df3U, read.xlsx(tempFile, sheet = 2, detectDates = TRUE)) - - expect_equal(df1, read.xlsx(wb, sheet = 1, startRow = 10)) - expect_equal(df3U, read.xlsx(wb, sheet = 2, detectDates = TRUE)) - - - unlink(tempFile, recursive = TRUE, force = TRUE) - rm(wb) - } -}) - -test_that("setColWidths() should support zero-length cols", { - file <- temp_xlsx() - on.exit(unlink(file), add = TRUE) - wb <- createWorkbook() - ws <- addWorksheet(wb, "empty") - tbl <- data.frame(A = 1:3) - writeData(wb, ws, tbl) - setColWidths(wb, ws, integer(0L), widths = 12) - saveWorkbook(wb, file) - x <- readWorkbook(file) - expect_equal(x, tbl) -}) + + + +context("Images and Tables.") + + +test_that("Images and Tables - reordering and removing", { + if (FALSE) { + options("stringsAsFactors" = FALSE) + tempFile <- temp_xlsx("break") + + getPlot <- function(i) { + n <- 5000 + plot(1:n, rnorm(n)) + title(main = sprintf("Plot for Sheet: %s", i)) + } + + df1 <- iris[1:5, 1:4] + df2 <- mtcars + + + df3 <- data.frame( + "Date" = Sys.Date() - 0:10, + "Logical" = sample(c(TRUE, FALSE), 1, replace = TRUE), + "Currency" = as.numeric(-5:5) * 100, + "Accounting" = as.numeric(-5:5), + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(-5, 5, length.out = 11), + "TinyNumber" = runif(11) / 1E9, stringsAsFactors = FALSE + ) + + df3U <- df3 + + class(df3$Currency) <- "currency" + class(df3$Accounting) <- "accounting" + class(df3$hLink) <- "hyperlink" + class(df3$Percentage) <- "percentage" + class(df3$TinyNumber) <- "scientific" + + + df4 <- data.frame("X" = 1:10000, "Y" = sample(LETTERS, size = 10000, replace = TRUE)) + df5 <- USJudgeRatings + + hs <- createStyle(fontColour = "blue", textRotation = 45) + + + wb <- createWorkbook() + expect_equal(names(wb), character(0)) + + addWorksheet(wb = wb, sheetName = "Sheet 1", gridLines = FALSE, tabColour = "red", zoom = 75) + writeDataTable(wb, sheet = 1, x = df1, startCol = 7, startRow = 10, tableName = "Sheet1Table1") + expect_equal(names(wb), "Sheet 1") + + + addWorksheet(wb, sheetName = "Sheet 2", tabColour = "purple") + writeDataTable(wb, sheet = "Sheet 2", x = df2, startCol = 2, startRow = 2, rowNames = TRUE) + expect_equal(names(wb), c("Sheet 1", "Sheet 2")) + + + + addWorksheet(wb, sheetName = "Sheet 3", tabColour = "green") + writeDataTable(wb, sheet = 3, x = df3, startCol = 1, startRow = 1) + expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3")) + + addWorksheet(wb, sheetName = "Sheet 4", tabColour = "orange") + writeDataTable(wb, sheet = 4, x = df4) + expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4")) + + addWorksheet(wb, sheetName = "Sheet 5", tabColour = "yellow") + writeData(wb, sheet = "Sheet 5", x = df5, rowNames = TRUE) + expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4", "Sheet 5")) + + + + worksheetOrder(wb) <- c(1, 3, 5, 4, 2) + expect_equal(names(wb), c("Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4", "Sheet 5")) + + ## save and load 1 + saveWorkbook(wb, file = tempFile, overwrite = TRUE) + + wb <- loadWorkbook(tempFile) + expect_equal(names(wb), c("Sheet 1", "Sheet 3", "Sheet 5", "Sheet 4", "Sheet 2")) + + + expect_equal(df1, read.xlsx(wb, sheet = 1)) + expect_equal(df1, read.xlsx(wb, sheet = "Sheet 1")) + expect_equal(df1, read.xlsx(tempFile, sheet = 1)) + expect_equal(df1, read.xlsx(tempFile, sheet = "Sheet 1")) + + + expect_equal(df3U, read.xlsx(wb, sheet = 2, detectDates = TRUE)) + expect_equal(df3U, read.xlsx(wb, sheet = "Sheet 3", detectDates = TRUE)) + expect_equal(df3U, read.xlsx(tempFile, sheet = 2, detectDates = TRUE)) + expect_equal(df3U, read.xlsx(tempFile, sheet = "Sheet 3", detectDates = TRUE)) + + + expect_equal(df5, read.xlsx(wb, sheet = 3, rowNames = TRUE)) + expect_equal(df5, read.xlsx(wb, sheet = "Sheet 5", rowNames = TRUE)) + expect_equal(df5, read.xlsx(tempFile, sheet = 3, rowNames = TRUE)) + expect_equal(df5, read.xlsx(tempFile, sheet = "Sheet 5", rowNames = TRUE)) + + + expect_equal(df4, read.xlsx(wb, sheet = 4)) + expect_equal(df4, read.xlsx(wb, sheet = "Sheet 4")) + expect_equal(df4, read.xlsx(tempFile, sheet = 4)) + expect_equal(df4, read.xlsx(tempFile, sheet = "Sheet 4")) + + + expect_equal(df2, read.xlsx(wb, sheet = 5, rowNames = TRUE)) + expect_equal(df2, read.xlsx(wb, sheet = "Sheet 2", rowNames = TRUE)) + expect_equal(df2, read.xlsx(tempFile, sheet = 5, rowNames = TRUE)) + expect_equal(df2, read.xlsx(tempFile, sheet = "Sheet 2", rowNames = TRUE)) + + + + ## remove "Sheet 5" by index (3) + removeWorksheet(wb, sheet = 3) + expect_equal(names(wb), c("Sheet 1", "Sheet 3", "Sheet 4", "Sheet 2")) + + ## remove sheet "Sheet 4" + removeWorksheet(wb, sheet = "Sheet 4") + expect_equal(names(wb), c("Sheet 1", "Sheet 3", "Sheet 2")) + + + ## Introduce some images + getPlot(1) + insertPlot(wb = wb, sheet = "Sheet 1", startCol = 14, startRow = 3) + + getPlot(2) + insertPlot(wb = wb, sheet = "Sheet 2", startCol = 14, startRow = 3) + + getPlot(3) + insertPlot(wb = wb, sheet = "Sheet 3", startCol = 14, startRow = 3) + + + expect_true(any(grepl("image1", wb$drawings_rels[[1]]))) + expect_true(any(grepl("image3", wb$drawings_rels[[2]]))) + expect_true(any(grepl("image2", wb$drawings_rels[[3]]))) + + + + ## put back to original order + worksheetOrder(wb) <- c(1, 3, 2) + saveWorkbook(wb, file = tempFile, overwrite = TRUE) + + wb <- loadWorkbook(file = tempFile) + + + ## drawings added in order + expect_true(any(grepl("image1", wb$drawings_rels[[1]]))) + expect_true(any(grepl("image2", wb$drawings_rels[[2]]))) + expect_true(any(grepl("image3", wb$drawings_rels[[3]]))) + + + ## Introduce some more images + getPlot("1_2") + insertPlot(wb = wb, sheet = "Sheet 1", startCol = 14, startRow = 25) + + getPlot("2_2") + insertPlot(wb = wb, sheet = "Sheet 2", startCol = 14, startRow = 25) + + + getPlot("3_2") + insertPlot(wb = wb, sheet = "Sheet 3", startCol = 14, startRow = 25) + + saveWorkbook(wb, file = tempFile, overwrite = TRUE) + wb <- loadWorkbook(tempFile) + + worksheetOrder(wb) <- c(3, 2, 1) + saveWorkbook(wb, file = tempFile, overwrite = TRUE) + wb <- loadWorkbook(tempFile) + + + hl <- rep("https://google.com.au", 5) + names(hl) <- sprintf("Link to google %s", 1:5) + class(hl) <- "hyperlink" + writeData(wb, "Sheet 1", hl) + + ## Add in some column widths + + setColWidths(wb, sheet = 1, cols = 1:50, widths = "auto") + worksheetOrder(wb) <- c(3, 2, 1) + removeWorksheet(wb, sheet = "Sheet 2") + + saveWorkbook(wb, file = tempFile, overwrite = TRUE) + wb <- loadWorkbook(tempFile) + + expect_equal(names(wb), c("Sheet 1", "Sheet 3")) + expect_equal(df1, read.xlsx(tempFile, sheet = 1, startRow = 10)) + expect_equal(df3U, read.xlsx(tempFile, sheet = 2, detectDates = TRUE)) + + expect_equal(df1, read.xlsx(wb, sheet = 1, startRow = 10)) + expect_equal(df3U, read.xlsx(wb, sheet = 2, detectDates = TRUE)) + + + unlink(tempFile, recursive = TRUE, force = TRUE) + rm(wb) + } +}) + +test_that("setColWidths() should support zero-length cols", { + file <- temp_xlsx() + on.exit(unlink(file), add = TRUE) + wb <- createWorkbook() + ws <- addWorksheet(wb, "empty") + tbl <- data.frame(A = 1:3) + writeData(wb, ws, tbl) + setColWidths(wb, ws, integer(0L), widths = 12) + saveWorkbook(wb, file) + x <- readWorkbook(file) + expect_equal(x, tbl) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-v3_0_0_bugs.R r-cran-openxlsx-4.2.5/tests/testthat/test-v3_0_0_bugs.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-v3_0_0_bugs.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-v3_0_0_bugs.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,14 +1,14 @@ - - -context("v3.0.0 Bug Fixes") - - - -test_that("read.xlsx bug fixes", { - file <- system.file("extdata", "readTest.xlsx", package = "openxlsx") - df <- read.xlsx(file, sheet = 1, rows = 1:2, cols = 1) - expect_equal(df, data.frame("Var1" = TRUE)) - - df <- read.xlsx(file, sheet = 1, rows = 1, cols = 1, colNames = FALSE) - expect_equal(df, data.frame("X1" = "Var1", stringsAsFactors = FALSE)) -}) + + +context("v3.0.0 Bug Fixes") + + + +test_that("read.xlsx bug fixes", { + file <- system.file("extdata", "readTest.xlsx", package = "openxlsx") + df <- read.xlsx(file, sheet = 1, rows = 1:2, cols = 1) + expect_equal(df, data.frame("Var1" = TRUE)) + + df <- read.xlsx(file, sheet = 1, rows = 1, cols = 1, colNames = FALSE) + expect_equal(df, data.frame("X1" = "Var1", stringsAsFactors = FALSE)) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-validate_table_name.R r-cran-openxlsx-4.2.5/tests/testthat/test-validate_table_name.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-validate_table_name.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-validate_table_name.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,49 +1,49 @@ - - - -test_that("Validate Table Names", { - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - - ## case - expect_equal(wb$validate_table_name("test"), "test") - expect_equal(wb$validate_table_name("TEST"), "test") - expect_equal(wb$validate_table_name("Test"), "test") - - ## length - expect_error(wb$validate_table_name(paste(sample(LETTERS, size = 300, replace = TRUE), collapse = "")), regexp = "tableName must be less than 255 characters") - - ## look like cell ref - expect_error(wb$validate_table_name("R1C2"), regexp = "tableName cannot be the same as a cell reference, such as R1C1", fixed = TRUE) - expect_error(wb$validate_table_name("A1"), regexp = "tableName cannot be the same as a cell reference", fixed = TRUE) - - expect_error(wb$validate_table_name("R06821C9682"), regexp = "tableName cannot be the same as a cell reference, such as R1C1", fixed = TRUE) - expect_error(wb$validate_table_name("ABD918751"), regexp = "tableName cannot be the same as a cell reference", fixed = TRUE) - - expect_error(wb$validate_table_name("A$100"), regexp = "'$' character cannot exist in a tableName", fixed = TRUE) - expect_error(wb$validate_table_name("A12$100"), regexp = "'$' character cannot exist in a tableName", fixed = TRUE) - - tbl_nm <- "性別" - expect_equal(wb$validate_table_name(tbl_nm), tbl_nm) -}) - - - - - -test_that("Existing Table Names", { - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - - ## Existing names - case in-sensitive - - writeDataTable(wb, sheet = 1, x = head(iris), tableName = "Table1") - expect_error(wb$validate_table_name("Table1"), regexp = "Table with name 'table1' already exists", fixed = TRUE) - expect_error(writeDataTable(wb, sheet = 1, x = head(iris), tableName = "Table1", startCol = 10), regexp = "Table with name 'table1' already exists", fixed = TRUE) - - expect_error(wb$validate_table_name("TABLE1"), regexp = "Table with name 'table1' already exists", fixed = TRUE) - expect_error(writeDataTable(wb, sheet = 1, x = head(iris), tableName = "TABLE1", startCol = 20), regexp = "Table with name 'table1' already exists", fixed = TRUE) - - expect_error(wb$validate_table_name("table1"), regexp = "Table with name 'table1' already exists", fixed = TRUE) - expect_error(writeDataTable(wb, sheet = 1, x = head(iris), tableName = "table1", startCol = 30), regexp = "Table with name 'table1' already exists", fixed = TRUE) -}) + + + +test_that("Validate Table Names", { + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + ## case + expect_equal(wb$validate_table_name("test"), "test") + expect_equal(wb$validate_table_name("TEST"), "test") + expect_equal(wb$validate_table_name("Test"), "test") + + ## length + expect_error(wb$validate_table_name(paste(sample(LETTERS, size = 300, replace = TRUE), collapse = "")), regexp = "tableName must be less than 255 characters") + + ## look like cell ref + expect_error(wb$validate_table_name("R1C2"), regexp = "tableName cannot be the same as a cell reference, such as R1C1", fixed = TRUE) + expect_error(wb$validate_table_name("A1"), regexp = "tableName cannot be the same as a cell reference", fixed = TRUE) + + expect_error(wb$validate_table_name("R06821C9682"), regexp = "tableName cannot be the same as a cell reference, such as R1C1", fixed = TRUE) + expect_error(wb$validate_table_name("ABD918751"), regexp = "tableName cannot be the same as a cell reference", fixed = TRUE) + + expect_error(wb$validate_table_name("A$100"), regexp = "'$' character cannot exist in a tableName", fixed = TRUE) + expect_error(wb$validate_table_name("A12$100"), regexp = "'$' character cannot exist in a tableName", fixed = TRUE) + + tbl_nm <- "性別" + expect_equal(wb$validate_table_name(tbl_nm), tbl_nm) +}) + + + + + +test_that("Existing Table Names", { + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + + ## Existing names - case in-sensitive + + writeDataTable(wb, sheet = 1, x = head(iris), tableName = "Table1") + expect_error(wb$validate_table_name("Table1"), regexp = "Table with name 'table1' already exists", fixed = TRUE) + expect_error(writeDataTable(wb, sheet = 1, x = head(iris), tableName = "Table1", startCol = 10), regexp = "Table with name 'table1' already exists", fixed = TRUE) + + expect_error(wb$validate_table_name("TABLE1"), regexp = "Table with name 'table1' already exists", fixed = TRUE) + expect_error(writeDataTable(wb, sheet = 1, x = head(iris), tableName = "TABLE1", startCol = 20), regexp = "Table with name 'table1' already exists", fixed = TRUE) + + expect_error(wb$validate_table_name("table1"), regexp = "Table with name 'table1' already exists", fixed = TRUE) + expect_error(writeDataTable(wb, sheet = 1, x = head(iris), tableName = "table1", startCol = 30), regexp = "Table with name 'table1' already exists", fixed = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-Workbook_properties.R r-cran-openxlsx-4.2.5/tests/testthat/test-Workbook_properties.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-Workbook_properties.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-Workbook_properties.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,40 +1,50 @@ - -context("Workbook properties") - -test_that("Workbook properties", { - - ## check creator - wb <- createWorkbook(creator = "Alex", title = "title here", subject = "this & that", category = "some category") - - expect_true(grepl("Alex", wb$core)) - expect_true(grepl("title here", wb$core)) - expect_true(grepl("this & that", wb$core)) - expect_true(grepl("some category", wb$core)) - - fl <- tempfile(fileext = ".xlsx") - wb <- write.xlsx( - x = iris, file = fl, - creator = "Alex 2", - title = "title here 2", - subject = "this & that 2", - category = "some category 2" - ) - - expect_true(grepl("Alex 2", wb$core)) - expect_true(grepl("title here 2", wb$core)) - expect_true(grepl("this & that 2", wb$core)) - expect_true(grepl("some category 2", wb$core)) - - ## maintain on load - wb_loaded <- loadWorkbook(fl) - expect_equal(object = wb_loaded$core, expected = paste0(wb$core, collapse = "")) - - - wb <- createWorkbook(creator = "Philipp", title = "title here", subject = "this & that", category = "some category") - addCreator(wb, "test") - expect_true(grepl("Philipp;test", wb$core)) - - expect_equal(getCreators(wb), c("Philipp", "test")) - setLastModifiedBy(wb, "Philipp 2") - expect_true(grepl("Philipp 2", wb$core)) -}) + +context("Workbook properties") + +test_that("Workbook properties", { + + ## check creator + wb <- createWorkbook(creator = "Alex", title = "title here", subject = "this & that", category = "some category") + + expect_true(grepl("Alex", wb$core)) + expect_true(grepl("title here", wb$core)) + expect_true(grepl("this & that", wb$core)) + expect_true(grepl("some category", wb$core)) + + fl <- tempfile(fileext = ".xlsx") + wb <- write.xlsx( + x = iris, file = fl, + creator = "Alex 2", + title = "title here 2", + subject = "this & that 2", + category = "some category 2" + ) + + expect_true(grepl("Alex 2", wb$core)) + expect_true(grepl("title here 2", wb$core)) + expect_true(grepl("this & that 2", wb$core)) + expect_true(grepl("some category 2", wb$core)) + + ## maintain on load + wb_loaded <- loadWorkbook(fl) + expect_equal(object = wb_loaded$core, expected = paste0(wb$core, collapse = "")) + + + wb <- createWorkbook(creator = "Philipp", title = "title here", subject = "this & that", category = "some category") + addCreator(wb, "test") + expect_true(grepl("Philipp;test", wb$core)) + + expect_equal(getCreators(wb), c("Philipp", "test")) + setLastModifiedBy(wb, "Philipp 2") + expect_true(grepl("Philipp 2", wb$core)) +}) + + +test_that("Workbook can print with 0 sheets [240]", { + + compare_text <- "A Workbook object.\n \nWorksheets:\n No worksheets attached\n" + printed_text <- capture_output(x <- createWorkbook()$show()) + expect_null(x) + expect_equal(compare_text, printed_text) + +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-Worksheet_naming.R r-cran-openxlsx-4.2.5/tests/testthat/test-Worksheet_naming.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-Worksheet_naming.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-Worksheet_naming.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,46 +1,46 @@ - -context("Worksheet naming") - -test_that("Worksheet names", { - - ### test for names without special character - wb <- createWorkbook() - sheetname <- "test" - addWorksheet(wb, sheetname) - - expect_equal(sheetname,names(wb)) - - ### test for names with & - - wb <- createWorkbook() - sheetname <- "S&P 500" - addWorksheet(wb, sheetname) - - expect_equal(sheetname,names(wb)) - expect_equal("S&P 500",wb$sheet_names) - ### test for names with < - - wb <- createWorkbook() - sheetname <- "<24 h" - addWorksheet(wb, sheetname) - - expect_equal(sheetname,names(wb)) - expect_equal("<24 h",wb$sheet_names) - ### test for names with > - - wb <- createWorkbook() - sheetname <- ">24 h" - addWorksheet(wb, sheetname) - - expect_equal(sheetname,names(wb)) - expect_equal(">24 h",wb$sheet_names) - - ### test for names with " - - wb <- createWorkbook() - sheetname <- 'test "A"' - addWorksheet(wb, sheetname) - - expect_equal(sheetname,names(wb)) - expect_equal("test "A"",wb$sheet_names) -}) + +context("Worksheet naming") + +test_that("Worksheet names", { + + ### test for names without special character + wb <- createWorkbook() + sheetname <- "test" + addWorksheet(wb, sheetname) + + expect_equal(sheetname,names(wb)) + + ### test for names with & + + wb <- createWorkbook() + sheetname <- "S&P 500" + addWorksheet(wb, sheetname) + + expect_equal(sheetname,names(wb)) + expect_equal("S&P 500",wb$sheet_names) + ### test for names with < + + wb <- createWorkbook() + sheetname <- "<24 h" + addWorksheet(wb, sheetname) + + expect_equal(sheetname,names(wb)) + expect_equal("<24 h",wb$sheet_names) + ### test for names with > + + wb <- createWorkbook() + sheetname <- ">24 h" + addWorksheet(wb, sheetname) + + expect_equal(sheetname,names(wb)) + expect_equal(">24 h",wb$sheet_names) + + ### test for names with " + + wb <- createWorkbook() + sheetname <- 'test "A"' + addWorksheet(wb, sheetname) + + expect_equal(sheetname,names(wb)) + expect_equal("test "A"",wb$sheet_names) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-worksheet_ordering.R r-cran-openxlsx-4.2.5/tests/testthat/test-worksheet_ordering.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-worksheet_ordering.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-worksheet_ordering.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,284 +1,284 @@ - - - - - - - -context("Re-ordering worksheets.") - - - -test_that("Worksheet ordering from new Workbook", { - genWS <- function(wb, sheetName) { - addWorksheet(wb, sheetName) - writeDataTable(wb, sheetName, data.frame("X" = sprintf("This is sheet: %s", sheetName)), colNames = FALSE) - } - - wb <- createWorkbook() - genWS(wb, "Sheet 1") - genWS(wb, "Sheet 2") - genWS(wb, "Sheet 3") - - - tempFile <- temp_xlsx("orderingTest") - - ## no ordering - saveWorkbook(wb, file = tempFile, overwrite = TRUE) - expect_equal(names(wb), sprintf("Sheet %s", 1:3)) - - wb <- loadWorkbook(tempFile) - expect_equal(names(wb), sprintf("Sheet %s", 1:3)) - - - ## re-order doesnt do anything - worksheetOrder(wb) <- c(3, 2, 1) - expect_equal(names(wb), sprintf("Sheet %s", 1:3)) - - saveWorkbook(wb, file = tempFile, overwrite = TRUE) - expect_equal(names(wb), sprintf("Sheet %s", 1:3)) - - - - ## reloading - reordered - wb <- loadWorkbook(file = tempFile) - expect_equal(names(wb), sprintf("Sheet %s", 3:1)) - - x <- read.xlsx(tempFile, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(tempFile, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(tempFile, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - - ## reloading - reordered - reading from the workbook object - x <- read.xlsx(wb, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(wb, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(wb, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - - - ## save and re-load again - saveWorkbook(wb, tempFile, overwrite = TRUE) - wb <- loadWorkbook(tempFile) - expect_equal(names(wb), sprintf("Sheet %s", 3:1)) - - x <- read.xlsx(wb, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(wb, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(wb, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - x <- read.xlsx(wb, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(wb, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(wb, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - - - - ###### re-order again - worksheetOrder(wb) <- c(2, 3, 1) - saveWorkbook(wb, tempFile, overwrite = TRUE) - - x <- read.xlsx(tempFile, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(tempFile, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - x <- read.xlsx(tempFile, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - - wb <- loadWorkbook(tempFile) - expect_equal(names(wb), sprintf("Sheet %s", c(2, 1, 3))) - - x <- read.xlsx(wb, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(wb, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - x <- read.xlsx(wb, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - - - - ## add a worksheet - genWS(wb, sheetName = "Sheet 4") - - x <- read.xlsx(wb, sheet = 4)[[1]] - expect_equal(x, "This is sheet: Sheet 4") - - ## re-order and add worksheet then save - worksheetOrder(wb) <- c(3, 1, 4, 2) - names(wb) - - saveWorkbook(wb, tempFile, overwrite = TRUE) - - ## read from file - x <- read.xlsx(tempFile, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(tempFile, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(tempFile, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 4") - - x <- read.xlsx(tempFile, sheet = 4)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - x <- read.xlsx(tempFile, sheet = "Sheet 3")[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(tempFile, sheet = "Sheet 2")[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(tempFile, sheet = "Sheet 4")[[1]] - expect_equal(x, "This is sheet: Sheet 4") - - x <- read.xlsx(tempFile, sheet = "Sheet 1")[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - - - - - - - ## read from workbook - wb <- loadWorkbook(tempFile) - x <- read.xlsx(wb, sheet = 1)[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(wb, sheet = 2)[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(wb, sheet = 3)[[1]] - expect_equal(x, "This is sheet: Sheet 4") - - x <- read.xlsx(wb, sheet = 4)[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - - - - ## read from workbook using name - wb <- loadWorkbook(tempFile) - x <- read.xlsx(wb, sheet = "Sheet 3")[[1]] - expect_equal(x, "This is sheet: Sheet 3") - - x <- read.xlsx(wb, sheet = "Sheet 2")[[1]] - expect_equal(x, "This is sheet: Sheet 2") - - x <- read.xlsx(wb, sheet = "Sheet 1")[[1]] - expect_equal(x, "This is sheet: Sheet 1") - - x <- read.xlsx(wb, sheet = "Sheet 4")[[1]] - expect_equal(x, "This is sheet: Sheet 4") - - - writeData(wb, sheet = "Sheet 3", iris[1:10, 1:4], startRow = 5) - x <- read.xlsx(wb, sheet = "Sheet 3", startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:10, 1:4]) - - - writeData(wb, sheet = 4, iris[1:20, 1:4], startRow = 5) - x <- read.xlsx(wb, sheet = 4, startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:20, 1:4]) - - - writeData(wb, sheet = 2, iris[1:30, 1:4], startRow = 5) - x <- read.xlsx(wb, sheet = 2, startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:30, 1:4]) - - - ## reading from saved file - saveWorkbook(wb, tempFile, TRUE) - - x <- read.xlsx(tempFile, sheet = "Sheet 3", startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:10, 1:4]) - - x <- read.xlsx(tempFile, sheet = 4, startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:20, 1:4]) - - x <- read.xlsx(tempFile, sheet = 2, startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:30, 1:4]) - - - ## And finally load again - wb <- loadWorkbook(tempFile) - - x <- read.xlsx(wb, sheet = "Sheet 3", startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:10, 1:4]) - - x <- read.xlsx(wb, sheet = 4, startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:20, 1:4]) - - x <- read.xlsx(wb, sheet = 2, startRow = 5, colNames = TRUE) - expect_equal(x, iris[1:30, 1:4]) - - - unlink(tempFile, recursive = TRUE, force = TRUE) - rm(wb) -}) - - - -test_that("Worksheet ordering from new Workbook", { - tempFile <- temp_xlsx() - - wb <- createWorkbook() - addWorksheet(wb = wb, sheetName = "Sheet 1", gridLines = FALSE) - writeDataTable(wb = wb, sheet = 1, x = iris) - - addWorksheet(wb = wb, sheetName = "mtcars (Sheet 2)", gridLines = FALSE) - writeData(wb = wb, sheet = 2, x = mtcars) - - addWorksheet(wb = wb, sheetName = "Sheet 3", gridLines = FALSE) - writeData(wb = wb, sheet = 3, x = Formaldehyde) - - worksheetOrder(wb) - names(wb) - worksheetOrder(wb) <- c(1, 3, 2) # switch position of sheets 2 & 3 - - names(wb) - writeData(wb, 2, 'This is still the "mtcars" worksheet', startCol = 15) - - names(wb) - writeData(wb, "Sheet 3", "writing to sheet 3", startCol = 15) - - worksheetOrder(wb) - names(wb) ## ordering within workbook is not changed - - saveWorkbook(wb, tempFile, overwrite = TRUE) - - worksheetOrder(wb) <- c(3, 2, 1) - saveWorkbook(wb, tempFile, overwrite = TRUE) - - - wb <- loadWorkbook(tempFile) - worksheetOrder(wb) <- c(3, 2, 1) - - - unlink(tempFile, recursive = TRUE, force = TRUE) - rm(wb) -}) + + + + + + + +context("Re-ordering worksheets.") + + + +test_that("Worksheet ordering from new Workbook", { + genWS <- function(wb, sheetName) { + addWorksheet(wb, sheetName) + writeDataTable(wb, sheetName, data.frame("X" = sprintf("This is sheet: %s", sheetName)), colNames = FALSE) + } + + wb <- createWorkbook() + genWS(wb, "Sheet 1") + genWS(wb, "Sheet 2") + genWS(wb, "Sheet 3") + + + tempFile <- temp_xlsx("orderingTest") + + ## no ordering + saveWorkbook(wb, file = tempFile, overwrite = TRUE) + expect_equal(names(wb), sprintf("Sheet %s", 1:3)) + + wb <- loadWorkbook(tempFile) + expect_equal(names(wb), sprintf("Sheet %s", 1:3)) + + + ## re-order doesnt do anything + worksheetOrder(wb) <- c(3, 2, 1) + expect_equal(names(wb), sprintf("Sheet %s", 1:3)) + + saveWorkbook(wb, file = tempFile, overwrite = TRUE) + expect_equal(names(wb), sprintf("Sheet %s", 1:3)) + + + + ## reloading - reordered + wb <- loadWorkbook(file = tempFile) + expect_equal(names(wb), sprintf("Sheet %s", 3:1)) + + x <- read.xlsx(tempFile, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(tempFile, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(tempFile, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + + ## reloading - reordered - reading from the workbook object + x <- read.xlsx(wb, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(wb, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(wb, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + + + ## save and re-load again + saveWorkbook(wb, tempFile, overwrite = TRUE) + wb <- loadWorkbook(tempFile) + expect_equal(names(wb), sprintf("Sheet %s", 3:1)) + + x <- read.xlsx(wb, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(wb, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(wb, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + x <- read.xlsx(wb, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(wb, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(wb, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + + + + ###### re-order again + worksheetOrder(wb) <- c(2, 3, 1) + saveWorkbook(wb, tempFile, overwrite = TRUE) + + x <- read.xlsx(tempFile, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(tempFile, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + x <- read.xlsx(tempFile, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + + wb <- loadWorkbook(tempFile) + expect_equal(names(wb), sprintf("Sheet %s", c(2, 1, 3))) + + x <- read.xlsx(wb, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(wb, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + x <- read.xlsx(wb, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + + + + ## add a worksheet + genWS(wb, sheetName = "Sheet 4") + + x <- read.xlsx(wb, sheet = 4)[[1]] + expect_equal(x, "This is sheet: Sheet 4") + + ## re-order and add worksheet then save + worksheetOrder(wb) <- c(3, 1, 4, 2) + names(wb) + + saveWorkbook(wb, tempFile, overwrite = TRUE) + + ## read from file + x <- read.xlsx(tempFile, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(tempFile, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(tempFile, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 4") + + x <- read.xlsx(tempFile, sheet = 4)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + x <- read.xlsx(tempFile, sheet = "Sheet 3")[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(tempFile, sheet = "Sheet 2")[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(tempFile, sheet = "Sheet 4")[[1]] + expect_equal(x, "This is sheet: Sheet 4") + + x <- read.xlsx(tempFile, sheet = "Sheet 1")[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + + + + + + + ## read from workbook + wb <- loadWorkbook(tempFile) + x <- read.xlsx(wb, sheet = 1)[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(wb, sheet = 2)[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(wb, sheet = 3)[[1]] + expect_equal(x, "This is sheet: Sheet 4") + + x <- read.xlsx(wb, sheet = 4)[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + + + + ## read from workbook using name + wb <- loadWorkbook(tempFile) + x <- read.xlsx(wb, sheet = "Sheet 3")[[1]] + expect_equal(x, "This is sheet: Sheet 3") + + x <- read.xlsx(wb, sheet = "Sheet 2")[[1]] + expect_equal(x, "This is sheet: Sheet 2") + + x <- read.xlsx(wb, sheet = "Sheet 1")[[1]] + expect_equal(x, "This is sheet: Sheet 1") + + x <- read.xlsx(wb, sheet = "Sheet 4")[[1]] + expect_equal(x, "This is sheet: Sheet 4") + + + writeData(wb, sheet = "Sheet 3", iris[1:10, 1:4], startRow = 5) + x <- read.xlsx(wb, sheet = "Sheet 3", startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:10, 1:4]) + + + writeData(wb, sheet = 4, iris[1:20, 1:4], startRow = 5) + x <- read.xlsx(wb, sheet = 4, startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:20, 1:4]) + + + writeData(wb, sheet = 2, iris[1:30, 1:4], startRow = 5) + x <- read.xlsx(wb, sheet = 2, startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:30, 1:4]) + + + ## reading from saved file + saveWorkbook(wb, tempFile, TRUE) + + x <- read.xlsx(tempFile, sheet = "Sheet 3", startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:10, 1:4]) + + x <- read.xlsx(tempFile, sheet = 4, startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:20, 1:4]) + + x <- read.xlsx(tempFile, sheet = 2, startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:30, 1:4]) + + + ## And finally load again + wb <- loadWorkbook(tempFile) + + x <- read.xlsx(wb, sheet = "Sheet 3", startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:10, 1:4]) + + x <- read.xlsx(wb, sheet = 4, startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:20, 1:4]) + + x <- read.xlsx(wb, sheet = 2, startRow = 5, colNames = TRUE) + expect_equal(x, iris[1:30, 1:4]) + + + unlink(tempFile, recursive = TRUE, force = TRUE) + rm(wb) +}) + + + +test_that("Worksheet ordering from new Workbook", { + tempFile <- temp_xlsx() + + wb <- createWorkbook() + addWorksheet(wb = wb, sheetName = "Sheet 1", gridLines = FALSE) + writeDataTable(wb = wb, sheet = 1, x = iris) + + addWorksheet(wb = wb, sheetName = "mtcars (Sheet 2)", gridLines = FALSE) + writeData(wb = wb, sheet = 2, x = mtcars) + + addWorksheet(wb = wb, sheetName = "Sheet 3", gridLines = FALSE) + writeData(wb = wb, sheet = 3, x = Formaldehyde) + + worksheetOrder(wb) + names(wb) + worksheetOrder(wb) <- c(1, 3, 2) # switch position of sheets 2 & 3 + + names(wb) + writeData(wb, 2, 'This is still the "mtcars" worksheet', startCol = 15) + + names(wb) + writeData(wb, "Sheet 3", "writing to sheet 3", startCol = 15) + + worksheetOrder(wb) + names(wb) ## ordering within workbook is not changed + + saveWorkbook(wb, tempFile, overwrite = TRUE) + + worksheetOrder(wb) <- c(3, 2, 1) + saveWorkbook(wb, tempFile, overwrite = TRUE) + + + wb <- loadWorkbook(tempFile) + worksheetOrder(wb) <- c(3, 2, 1) + + + unlink(tempFile, recursive = TRUE, force = TRUE) + rm(wb) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-worksheet_renaming.R r-cran-openxlsx-4.2.5/tests/testthat/test-worksheet_renaming.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-worksheet_renaming.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-worksheet_renaming.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,58 +1,58 @@ - - - - - -context("Renaming worksheets.") - - - -test_that("Can rename worksheets under all conditions", { - tempFile <- file.path(tempdir(), "renaming.xlsx") - wb <- createWorkbook() - addWorksheet(wb, "sheet 1") - addWorksheet(wb, "sheet 2") - addWorksheet(wb, "sheet 3") - addWorksheet(wb, "sheet 4") - addWorksheet(wb, "sheet 5") - - renameWorksheet(wb, sheet = 2, "THis is SHEET 2") - expect_equal(names(wb), c("sheet 1", "THis is SHEET 2", "sheet 3", "sheet 4", "sheet 5")) - - - renameWorksheet(wb, sheet = "THis is SHEET 2", "THis is STILL SHEET 2") - expect_equal(names(wb), c("sheet 1", "THis is STILL SHEET 2", "sheet 3", "sheet 4", "sheet 5")) - - - renameWorksheet(wb, sheet = 5, "THis is SHEET 5") - expect_equal(names(wb), c("sheet 1", "THis is STILL SHEET 2", "sheet 3", "sheet 4", "THis is SHEET 5")) - - renameWorksheet(wb, sheet = 5, "THis is STILL SHEET 5") - expect_equal(names(wb), c("sheet 1", "THis is STILL SHEET 2", "sheet 3", "sheet 4", "THis is STILL SHEET 5")) - - - renameWorksheet(wb, sheet = 2, "Sheet 2") - expect_equal(names(wb), c("sheet 1", "Sheet 2", "sheet 3", "sheet 4", "THis is STILL SHEET 5")) - - renameWorksheet(wb, sheet = 5, "Sheet 5") - expect_equal(names(wb), c("sheet 1", "Sheet 2", "sheet 3", "sheet 4", "Sheet 5")) - - - ## re-ordering - worksheetOrder(wb) <- c(4, 3, 2, 5, 1) - saveWorkbook(wb, tempFile, overwrite = TRUE) - - wb <- loadWorkbook(file = tempFile) - renameWorksheet(wb, sheet = 2, "THIS is SHEET 3") - - wb <- loadWorkbook(tempFile) - renameWorksheet(wb, sheet = "Sheet 5", "THIS is NOW SHEET 5") - - expect_equal(names(wb), c("sheet 4", "sheet 3", "Sheet 2", "THIS is NOW SHEET 5", "sheet 1")) - - names(wb)[[1]] <- "THIS IS NOW SHEET 4" - expect_equal(names(wb), c("THIS IS NOW SHEET 4", "sheet 3", "Sheet 2", "THIS is NOW SHEET 5", "sheet 1")) - - - unlink(tempFile, recursive = TRUE, force = TRUE) -}) + + + + + +context("Renaming worksheets.") + + + +test_that("Can rename worksheets under all conditions", { + tempFile <- file.path(tempdir(), "renaming.xlsx") + wb <- createWorkbook() + addWorksheet(wb, "sheet 1") + addWorksheet(wb, "sheet 2") + addWorksheet(wb, "sheet 3") + addWorksheet(wb, "sheet 4") + addWorksheet(wb, "sheet 5") + + renameWorksheet(wb, sheet = 2, "THis is SHEET 2") + expect_equal(names(wb), c("sheet 1", "THis is SHEET 2", "sheet 3", "sheet 4", "sheet 5")) + + + renameWorksheet(wb, sheet = "THis is SHEET 2", "THis is STILL SHEET 2") + expect_equal(names(wb), c("sheet 1", "THis is STILL SHEET 2", "sheet 3", "sheet 4", "sheet 5")) + + + renameWorksheet(wb, sheet = 5, "THis is SHEET 5") + expect_equal(names(wb), c("sheet 1", "THis is STILL SHEET 2", "sheet 3", "sheet 4", "THis is SHEET 5")) + + renameWorksheet(wb, sheet = 5, "THis is STILL SHEET 5") + expect_equal(names(wb), c("sheet 1", "THis is STILL SHEET 2", "sheet 3", "sheet 4", "THis is STILL SHEET 5")) + + + renameWorksheet(wb, sheet = 2, "Sheet 2") + expect_equal(names(wb), c("sheet 1", "Sheet 2", "sheet 3", "sheet 4", "THis is STILL SHEET 5")) + + renameWorksheet(wb, sheet = 5, "Sheet 5") + expect_equal(names(wb), c("sheet 1", "Sheet 2", "sheet 3", "sheet 4", "Sheet 5")) + + + ## re-ordering + worksheetOrder(wb) <- c(4, 3, 2, 5, 1) + saveWorkbook(wb, tempFile, overwrite = TRUE) + + wb <- loadWorkbook(file = tempFile) + renameWorksheet(wb, sheet = 2, "THIS is SHEET 3") + + wb <- loadWorkbook(tempFile) + renameWorksheet(wb, sheet = "Sheet 5", "THIS is NOW SHEET 5") + + expect_equal(names(wb), c("sheet 4", "sheet 3", "Sheet 2", "THIS is NOW SHEET 5", "sheet 1")) + + names(wb)[[1]] <- "THIS IS NOW SHEET 4" + expect_equal(names(wb), c("THIS IS NOW SHEET 4", "sheet 3", "Sheet 2", "THIS is NOW SHEET 5", "sheet 1")) + + + unlink(tempFile, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-wrappers.R r-cran-openxlsx-4.2.5/tests/testthat/test-wrappers.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-wrappers.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-wrappers.R 2021-12-13 08:14:44.000000000 +0000 @@ -0,0 +1,14 @@ + +context("Test wrappers") + +test_that("int2col and col2int", { + + nums <- 2:27 + + chrs <- c("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", + "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA") + + expect_equal(chrs, int2col(nums)) + expect_equal(nums, col2int(chrs)) + +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-writeData.R r-cran-openxlsx-4.2.5/tests/testthat/test-writeData.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-writeData.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-writeData.R 2021-12-13 08:14:44.000000000 +0000 @@ -0,0 +1,37 @@ +test_that("writeData() forces evaluation of x (#264)", { + wbfile <- temp_xlsx() + op <- options(stringsAsFactors = FALSE) + + x <- format(123.4) + df <- data.frame(d = format(123.4)) + df2 <- data.frame(e = x) + + wb <- createWorkbook() + addWorksheet(wb, "sheet") + writeData(wb, "sheet", startCol = 1, data.frame(a = format(123.4))) + writeData(wb, "sheet", startCol = 2, data.frame(b = as.character(123.4))) + writeData(wb, "sheet", startCol = 3, data.frame(c = "123.4")) + writeData(wb, "sheet", startCol = 4, df) + writeData(wb, "sheet", startCol = 5, df2) + + saveWorkbook(wb, wbfile) + out <- read.xlsx(wbfile) + + # Possibly overkill + + with(out, { + expect_identical(a, b) + expect_identical(a, c) + expect_identical(a, d) + expect_identical(a, e) + expect_identical(b, c) + expect_identical(b, d) + expect_identical(b, e) + expect_identical(c, d) + expect_identical(c, e) + expect_identical(d, e) + }) + + options(op) + file.remove(wbfile) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-write_data_to_sheetData_NAs.R r-cran-openxlsx-4.2.5/tests/testthat/test-write_data_to_sheetData_NAs.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-write_data_to_sheetData_NAs.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-write_data_to_sheetData_NAs.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,139 +1,139 @@ - - - - -context("Writing NA to sheet_data") - - - -test_that("Writing to sheet_data with keepNA = FALSE", { - a <- head(iris) - a[2, 2] <- NA - a[3, 5] <- NA - a[5, 1] <- NA - a[5, 5] <- NA - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - writeData(wb, 1, a, keepNA = FALSE) - - sheet_data <- wb$worksheets[[1]]$sheet_data - - sheet_v <- sheet_data$v - sheet_t <- sheet_data$t - sheet_f <- sheet_data$f - sheet_row <- sheet_data$rows - sheet_col <- sheet_data$cols - - sheet_v <- as.numeric(sheet_v) - - sheet_v <- sheet_v[!is.na(sheet_v)] - sheet_t <- sheet_t[!is.na(sheet_t)] - sheet_f <- sheet_f[!is.na(sheet_f)] - sheet_row <- sheet_row[!is.na(sheet_row)] - sheet_col <- sheet_col[!is.na(sheet_col)] - - n_values <- prod(dim(a)) + ncol(a) - - expect_length(sheet_row, n_values) - expect_length(sheet_col, n_values) - expect_length(sheet_t, n_values - 4) - expect_length(sheet_v, n_values - 4) - expect_length(sheet_f, 0) - - ## rows/cols - expect_equal(sheet_row, rep(1:7, each = 5)) - expect_equal(sheet_col, rep(1:5, times = 7)) - - ## header types - expect_equal(sheet_t[1:5], rep(1, ncol(a))) - - ## data.frame t & v - expected_t <- c( - "n", "n", "n", "n", "s", "n", "n", "n", "s", "n", "n", "n", - "n", "n", "n", "n", "n", "s", "n", "n", "n", "n", "n", "n", "n", - "s", NA, NA, NA, NA - ) - - expected_t <- map_cell_types_to_integer(t = expected_t) - expect_equal(sheet_t[6:n_values], expected_t) - - expect_equal(sheet_v[1:5], 0:4) - - expected_v <- c( - 5.1, 3.5, 1.4, 0.2, 5, 4.9, 1.4, 0.2, 5, 4.7, 3.2, 1.3, 0.2, - 4.6, 3.1, 1.5, 0.2, 5, 3.6, 1.4, 0.2, 5.4, 3.9, 1.7, 0.4, 5, - NA, NA, NA, NA - ) - - expect_equal(sheet_v[6:n_values], expected_v) -}) - -test_that("Writing to sheet_data with keepNA = TRUE and na.string = '*'", { - a <- head(iris) - a[2, 2] <- NA - a[3, 5] <- NA - a[5, 1] <- NA - a[5, 5] <- NA - - wb <- createWorkbook() - addWorksheet(wb, "Sheet 1") - writeData(wb, 1, a, keepNA = TRUE, na.string = "*") - - sheet_data <- wb$worksheets[[1]]$sheet_data - - sheet_v <- sheet_data$v - sheet_t <- sheet_data$t - sheet_f <- sheet_data$f - sheet_row <- sheet_data$rows - sheet_col <- sheet_data$cols - - sheet_v <- as.numeric(sheet_v) - - sheet_v <- sheet_v[!is.na(sheet_v)] - sheet_t <- sheet_t[!is.na(sheet_t)] - sheet_f <- sheet_f[!is.na(sheet_f)] - sheet_row <- sheet_row[!is.na(sheet_row)] - sheet_col <- sheet_col[!is.na(sheet_col)] - - n_values <- prod(dim(a)) + ncol(a) - - expect_length(sheet_row, n_values) - expect_length(sheet_col, n_values) - expect_length(sheet_t, n_values) - expect_length(sheet_v, n_values) - expect_length(sheet_f, 0) - - ## rows/cols - expect_equal(sheet_row, rep(1:7, each = 5)) - expect_equal(sheet_col, rep(1:5, times = 7)) - - ## header types - expect_equal(sheet_t[1:5], rep(1, ncol(a))) - - ## data.frame t & v - expected_t <- c( - "n", "n", "n", "n", "s", - "n", "s", "n", "n", "s", - "n", "n", "n", "n", "s", - "n", "n", "n", "n", "s", - "s", "n", "n", "n", "s", - "n", "n", "n", "n", "s" - ) - - expected_t <- map_cell_types_to_integer(t = expected_t) - expect_equal(sheet_t[6:n_values], expected_t) - - expect_equal(sheet_v[1:5], 0:4) - - expected_v <- c( - 5.1, 3.5, 1.4, 0.2, 5, - 4.9, 6, 1.4, 0.2, 5, - 4.7, 3.2, 1.3, 0.2, 6, - 4.6, 3.1, 1.5, 0.2, 5, - 6, 3.6, 1.4, 0.2, 6, - 5.4, 3.9, 1.7, 0.4, 5 - ) - - expect_equal(sheet_v[6:n_values], expected_v) -}) + + + + +context("Writing NA to sheet_data") + + + +test_that("Writing to sheet_data with keepNA = FALSE", { + a <- head(iris) + a[2, 2] <- NA + a[3, 5] <- NA + a[5, 1] <- NA + a[5, 5] <- NA + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + writeData(wb, 1, a, keepNA = FALSE) + + sheet_data <- wb$worksheets[[1]]$sheet_data + + sheet_v <- sheet_data$v + sheet_t <- sheet_data$t + sheet_f <- sheet_data$f + sheet_row <- sheet_data$rows + sheet_col <- sheet_data$cols + + sheet_v <- as.numeric(sheet_v) + + sheet_v <- sheet_v[!is.na(sheet_v)] + sheet_t <- sheet_t[!is.na(sheet_t)] + sheet_f <- sheet_f[!is.na(sheet_f)] + sheet_row <- sheet_row[!is.na(sheet_row)] + sheet_col <- sheet_col[!is.na(sheet_col)] + + n_values <- prod(dim(a)) + ncol(a) + + expect_length(sheet_row, n_values) + expect_length(sheet_col, n_values) + expect_length(sheet_t, n_values - 4) + expect_length(sheet_v, n_values - 4) + expect_length(sheet_f, 0) + + ## rows/cols + expect_equal(sheet_row, rep(1:7, each = 5)) + expect_equal(sheet_col, rep(1:5, times = 7)) + + ## header types + expect_equal(sheet_t[1:5], rep(1, ncol(a))) + + ## data.frame t & v + expected_t <- c( + "n", "n", "n", "n", "s", "n", "n", "n", "s", "n", "n", "n", + "n", "n", "n", "n", "n", "s", "n", "n", "n", "n", "n", "n", "n", + "s", NA, NA, NA, NA + ) + + expected_t <- map_cell_types_to_integer(t = expected_t) + expect_equal(sheet_t[6:n_values], expected_t) + + expect_equal(sheet_v[1:5], 0:4) + + expected_v <- c( + 5.1, 3.5, 1.4, 0.2, 5, 4.9, 1.4, 0.2, 5, 4.7, 3.2, 1.3, 0.2, + 4.6, 3.1, 1.5, 0.2, 5, 3.6, 1.4, 0.2, 5.4, 3.9, 1.7, 0.4, 5, + NA, NA, NA, NA + ) + + expect_equal(sheet_v[6:n_values], expected_v) +}) + +test_that("Writing to sheet_data with keepNA = TRUE and na.string = '*'", { + a <- head(iris) + a[2, 2] <- NA + a[3, 5] <- NA + a[5, 1] <- NA + a[5, 5] <- NA + + wb <- createWorkbook() + addWorksheet(wb, "Sheet 1") + writeData(wb, 1, a, keepNA = TRUE, na.string = "*") + + sheet_data <- wb$worksheets[[1]]$sheet_data + + sheet_v <- sheet_data$v + sheet_t <- sheet_data$t + sheet_f <- sheet_data$f + sheet_row <- sheet_data$rows + sheet_col <- sheet_data$cols + + sheet_v <- as.numeric(sheet_v) + + sheet_v <- sheet_v[!is.na(sheet_v)] + sheet_t <- sheet_t[!is.na(sheet_t)] + sheet_f <- sheet_f[!is.na(sheet_f)] + sheet_row <- sheet_row[!is.na(sheet_row)] + sheet_col <- sheet_col[!is.na(sheet_col)] + + n_values <- prod(dim(a)) + ncol(a) + + expect_length(sheet_row, n_values) + expect_length(sheet_col, n_values) + expect_length(sheet_t, n_values) + expect_length(sheet_v, n_values) + expect_length(sheet_f, 0) + + ## rows/cols + expect_equal(sheet_row, rep(1:7, each = 5)) + expect_equal(sheet_col, rep(1:5, times = 7)) + + ## header types + expect_equal(sheet_t[1:5], rep(1, ncol(a))) + + ## data.frame t & v + expected_t <- c( + "n", "n", "n", "n", "s", + "n", "s", "n", "n", "s", + "n", "n", "n", "n", "s", + "n", "n", "n", "n", "s", + "s", "n", "n", "n", "s", + "n", "n", "n", "n", "s" + ) + + expected_t <- map_cell_types_to_integer(t = expected_t) + expect_equal(sheet_t[6:n_values], expected_t) + + expect_equal(sheet_v[1:5], 0:4) + + expected_v <- c( + 5.1, 3.5, 1.4, 0.2, 5, + 4.9, 6, 1.4, 0.2, 5, + 4.7, 3.2, 1.3, 0.2, 6, + 4.6, 3.1, 1.5, 0.2, 5, + 6, 3.6, 1.4, 0.2, 6, + 5.4, 3.9, 1.7, 0.4, 5 + ) + + expect_equal(sheet_v[6:n_values], expected_v) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-write_data_to_sheetData.R r-cran-openxlsx-4.2.5/tests/testthat/test-write_data_to_sheetData.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-write_data_to_sheetData.R 2021-06-09 10:46:55.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-write_data_to_sheetData.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,248 +1,311 @@ - - - -context("Converting R types to Excel types") - - - -test_that("Converting R types to Excel types", { - wb <- createWorkbook() - addWorksheet(wb, "S1") - addWorksheet(wb, "S2") - addWorksheet(wb, "S3") - - writeDataTable(wb, "S1", x = iris) - - n_values <- prod(dim(iris)) + ncol(iris) - - sheet_data <- wb$worksheets[[1]]$sheet_data - - sheet_v <- sheet_data$v - sheet_t <- sheet_data$t - sheet_f <- sheet_data$f - sheet_row <- sheet_data$rows - sheet_col <- sheet_data$cols - - sheet_v <- as.numeric(sheet_v) - - expect_length(sheet_row, n_values) - expect_length(sheet_col, n_values) - expect_length(sheet_t, n_values) - expect_length(sheet_v, n_values) - expect_length(sheet_f, n_values) - - - ## rows/cols - expect_equal(sheet_row, rep(1:151, each = 5)) - expect_equal(sheet_col, rep(1:5, times = 151)) - - ## header types - expect_equal(sheet_t[1:5], rep(1, 5)) - - ## data.frame t & v - expect_equal(sheet_t[6:n_values], rep(c(0, 0, 0, 0, 1), 150)) - expect_equal(sheet_v[1:5], 0:4) - - expected_v <- c( - 5.1, 3.5, 1.4, 0.2, 5, 4.9, 3, 1.4, 0.2, 5, 4.7, 3.2, 1.3, - 0.2, 5, 4.6, 3.1, 1.5, 0.2, 5, 5, 3.6, 1.4, 0.2, 5, 5.4, 3.9, - 1.7, 0.4, 5, 4.6, 3.4, 1.4, 0.3, 5, 5, 3.4, 1.5, 0.2, 5, 4.4, - 2.9, 1.4, 0.2, 5, 4.9, 3.1, 1.5, 0.1, 5, 5.4, 3.7, 1.5, 0.2, - 5, 4.8, 3.4, 1.6, 0.2, 5, 4.8, 3, 1.4, 0.1, 5, 4.3, 3, 1.1, 0.1, - 5, 5.8, 4, 1.2, 0.2, 5, 5.7, 4.4, 1.5, 0.4, 5, 5.4, 3.9, 1.3, - 0.4, 5, 5.1, 3.5, 1.4, 0.3, 5, 5.7, 3.8, 1.7, 0.3, 5, 5.1, 3.8, - 1.5, 0.3, 5, 5.4, 3.4, 1.7, 0.2, 5, 5.1, 3.7, 1.5, 0.4, 5, 4.6, - 3.6, 1, 0.2, 5, 5.1, 3.3, 1.7, 0.5, 5, 4.8, 3.4, 1.9, 0.2, 5, - 5, 3, 1.6, 0.2, 5, 5, 3.4, 1.6, 0.4, 5, 5.2, 3.5, 1.5, 0.2, 5, - 5.2, 3.4, 1.4, 0.2, 5, 4.7, 3.2, 1.6, 0.2, 5, 4.8, 3.1, 1.6, - 0.2, 5, 5.4, 3.4, 1.5, 0.4, 5, 5.2, 4.1, 1.5, 0.1, 5, 5.5, 4.2, - 1.4, 0.2, 5, 4.9, 3.1, 1.5, 0.2, 5, 5, 3.2, 1.2, 0.2, 5, 5.5, - 3.5, 1.3, 0.2, 5, 4.9, 3.6, 1.4, 0.1, 5, 4.4, 3, 1.3, 0.2, 5, - 5.1, 3.4, 1.5, 0.2, 5, 5, 3.5, 1.3, 0.3, 5, 4.5, 2.3, 1.3, 0.3, - 5, 4.4, 3.2, 1.3, 0.2, 5, 5, 3.5, 1.6, 0.6, 5, 5.1, 3.8, 1.9, - 0.4, 5, 4.8, 3, 1.4, 0.3, 5, 5.1, 3.8, 1.6, 0.2, 5, 4.6, 3.2, - 1.4, 0.2, 5, 5.3, 3.7, 1.5, 0.2, 5, 5, 3.3, 1.4, 0.2, 5, 7, 3.2, - 4.7, 1.4, 6, 6.4, 3.2, 4.5, 1.5, 6, 6.9, 3.1, 4.9, 1.5, 6, 5.5, - 2.3, 4, 1.3, 6, 6.5, 2.8, 4.6, 1.5, 6, 5.7, 2.8, 4.5, 1.3, 6, - 6.3, 3.3, 4.7, 1.6, 6, 4.9, 2.4, 3.3, 1, 6, 6.6, 2.9, 4.6, 1.3, - 6, 5.2, 2.7, 3.9, 1.4, 6, 5, 2, 3.5, 1, 6, 5.9, 3, 4.2, 1.5, - 6, 6, 2.2, 4, 1, 6, 6.1, 2.9, 4.7, 1.4, 6, 5.6, 2.9, 3.6, 1.3, - 6, 6.7, 3.1, 4.4, 1.4, 6, 5.6, 3, 4.5, 1.5, 6, 5.8, 2.7, 4.1, - 1, 6, 6.2, 2.2, 4.5, 1.5, 6, 5.6, 2.5, 3.9, 1.1, 6, 5.9, 3.2, - 4.8, 1.8, 6, 6.1, 2.8, 4, 1.3, 6, 6.3, 2.5, 4.9, 1.5, 6, 6.1, - 2.8, 4.7, 1.2, 6, 6.4, 2.9, 4.3, 1.3, 6, 6.6, 3, 4.4, 1.4, 6, - 6.8, 2.8, 4.8, 1.4, 6, 6.7, 3, 5, 1.7, 6, 6, 2.9, 4.5, 1.5, 6, - 5.7, 2.6, 3.5, 1, 6, 5.5, 2.4, 3.8, 1.1, 6, 5.5, 2.4, 3.7, 1, - 6, 5.8, 2.7, 3.9, 1.2, 6, 6, 2.7, 5.1, 1.6, 6, 5.4, 3, 4.5, 1.5, - 6, 6, 3.4, 4.5, 1.6, 6, 6.7, 3.1, 4.7, 1.5, 6, 6.3, 2.3, 4.4, - 1.3, 6, 5.6, 3, 4.1, 1.3, 6, 5.5, 2.5, 4, 1.3, 6, 5.5, 2.6, 4.4, - 1.2, 6, 6.1, 3, 4.6, 1.4, 6, 5.8, 2.6, 4, 1.2, 6, 5, 2.3, 3.3, - 1, 6, 5.6, 2.7, 4.2, 1.3, 6, 5.7, 3, 4.2, 1.2, 6, 5.7, 2.9, 4.2, - 1.3, 6, 6.2, 2.9, 4.3, 1.3, 6, 5.1, 2.5, 3, 1.1, 6, 5.7, 2.8, - 4.1, 1.3, 6, 6.3, 3.3, 6, 2.5, 7, 5.8, 2.7, 5.1, 1.9, 7, 7.1, - 3, 5.9, 2.1, 7, 6.3, 2.9, 5.6, 1.8, 7, 6.5, 3, 5.8, 2.2, 7, 7.6, - 3, 6.6, 2.1, 7, 4.9, 2.5, 4.5, 1.7, 7, 7.3, 2.9, 6.3, 1.8, 7, - 6.7, 2.5, 5.8, 1.8, 7, 7.2, 3.6, 6.1, 2.5, 7, 6.5, 3.2, 5.1, - 2, 7, 6.4, 2.7, 5.3, 1.9, 7, 6.8, 3, 5.5, 2.1, 7, 5.7, 2.5, 5, - 2, 7, 5.8, 2.8, 5.1, 2.4, 7, 6.4, 3.2, 5.3, 2.3, 7, 6.5, 3, 5.5, - 1.8, 7, 7.7, 3.8, 6.7, 2.2, 7, 7.7, 2.6, 6.9, 2.3, 7, 6, 2.2, - 5, 1.5, 7, 6.9, 3.2, 5.7, 2.3, 7, 5.6, 2.8, 4.9, 2, 7, 7.7, 2.8, - 6.7, 2, 7, 6.3, 2.7, 4.9, 1.8, 7, 6.7, 3.3, 5.7, 2.1, 7, 7.2, - 3.2, 6, 1.8, 7, 6.2, 2.8, 4.8, 1.8, 7, 6.1, 3, 4.9, 1.8, 7, 6.4, - 2.8, 5.6, 2.1, 7, 7.2, 3, 5.8, 1.6, 7, 7.4, 2.8, 6.1, 1.9, 7, - 7.9, 3.8, 6.4, 2, 7, 6.4, 2.8, 5.6, 2.2, 7, 6.3, 2.8, 5.1, 1.5, - 7, 6.1, 2.6, 5.6, 1.4, 7, 7.7, 3, 6.1, 2.3, 7, 6.3, 3.4, 5.6, - 2.4, 7, 6.4, 3.1, 5.5, 1.8, 7, 6, 3, 4.8, 1.8, 7, 6.9, 3.1, 5.4, - 2.1, 7, 6.7, 3.1, 5.6, 2.4, 7, 6.9, 3.1, 5.1, 2.3, 7, 5.8, 2.7, - 5.1, 1.9, 7, 6.8, 3.2, 5.9, 2.3, 7, 6.7, 3.3, 5.7, 2.5, 7, 6.7, - 3, 5.2, 2.3, 7, 6.3, 2.5, 5, 1.9, 7, 6.5, 3, 5.2, 2, 7, 6.2, - 3.4, 5.4, 2.3, 7, 5.9, 3, 5.1, 1.8, 7 - ) - - expect_equal(sheet_v[6:n_values], expected_v) - - - - ############################ SPECIAL DATA TYPES - - df <- data.frame( - "Date" = as.Date("2016-12-5") - 0:19, - "T" = TRUE, - "F" = FALSE, - "Time" = as.POSIXct("2016-12-05 20:31:12 AEDT") - 0:19 * 60 * 60, - "Cash" = paste("$", 1:20), - "Cash2" = 31:50, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(0, 1, length.out = 20), - "TinyNumbers" = 1:20 / 1E9, stringsAsFactors = FALSE - ) - - ## openxlsx will apply default Excel styling for these classes - class(df$Cash) <- "currency" - class(df$Cash2) <- "accounting" - class(df$hLink) <- "hyperlink" - class(df$Percentage) <- "percentage" - class(df$TinyNumbers) <- "scientific" - - writeDataTable(wb, "S3", x = df, startRow = 4, rowNames = TRUE, tableStyle = "TableStyleMedium9") - - - - - ## Get all data - sheet_data <- wb$worksheets[[3]]$sheet_data - n_values <- (nrow(df) + 1) * (ncol(df) + 1) - sheet_v <- sheet_data$v - sheet_t <- sheet_data$t - sheet_f <- sheet_data$f - sheet_row <- sheet_data$rows - sheet_col <- sheet_data$cols - - sheet_v <- as.numeric(sheet_v) - - - expect_length(sheet_row, n_values) - expect_length(sheet_t, n_values) - - ## rows/cols - expect_equal(sheet_row, rep(4:24, each = ncol(df) + 1L)) - expect_equal(sheet_col, rep(1:10, times = nrow(df) + 1L)) - - ## header types - expect_equal(sheet_t[1:(ncol(df) + 1)], rep(1, ncol(df) + 1)) - - ## data.frame t & v - expect_equal(sheet_t[(ncol(df) + 2):n_values], rep(c(1, 0, 2, 2, 0, 0, 0, 1, 0, 0), 20)) - expect_equal(sheet_v[1:(ncol(df) + 1)], 8:17) - - - expected_v <- c( - 18, 42709, 1, 0, 42709.86, 1, 31, 19, 0, 0.000000001, 20, 42708, - 1, 0, 42709.81, 2, 32, 19, 0.05263158, 0.000000002, 21, 42707, - 1, 0, 42709.77, 3, 33, 19, 0.10526316, 0.000000003, 22, 42706, - 1, 0, 42709.73, 4, 34, 19, 0.15789474, 0.000000004, 23, 42705, - 1, 0, 42709.69, 5, 35, 19, 0.21052632, 0.000000005, 24, 42704, - 1, 0, 42709.65, 6, 36, 19, 0.26315789, 0.000000006, 25, 42703, - 1, 0, 42709.61, 7, 37, 19, 0.31578947, 0.000000007, 26, 42702, - 1, 0, 42709.56, 8, 38, 19, 0.36842105, 0.000000008, 27, 42701, - 1, 0, 42709.52, 9, 39, 19, 0.42105263, 0.000000009, 28, 42700, - 1, 0, 42709.48, 10, 40, 19, 0.47368421, 0.00000001, 29, 42699, - 1, 0, 42709.44, 11, 41, 19, 0.52631579, 0.000000011, 30, 42698, - 1, 0, 42709.4, 12, 42, 19, 0.57894737, 0.000000012, 31, 42697, - 1, 0, 42709.36, 13, 43, 19, 0.63157895, 0.000000013, 32, 42696, - 1, 0, 42709.31, 14, 44, 19, 0.68421053, 0.000000014, 33, 42695, - 1, 0, 42709.27, 15, 45, 19, 0.73684211, 0.000000015, 34, 42694, - 1, 0, 42709.23, 16, 46, 19, 0.78947368, 0.000000016, 35, 42693, - 1, 0, 42709.19, 17, 47, 19, 0.84210526, 0.000000017, 36, 42692, - 1, 0, 42709.15, 18, 48, 19, 0.89473684, 0.000000018, 37, 42691, - 1, 0, 42709.11, 19, 49, 19, 0.94736842, 0.000000019, 38, 42690, - 1, 0, 42709.06, 20, 50, 19, 1, 0.00000002 - ) - - - # expect_equal(sheet_v[(ncol(df)+2):n_values], expected_v) -}) - - - - -test_that("Write zero rows & columns", { - tempFile <- temp_xlsx() - wb <- createWorkbook() - addWorksheet(wb, "s1") - addWorksheet(wb, "s2") - - ## ZERO ROWS - - ## headers only - writeData(wb, sheet = 1, x = mtcars[0, ], colNames = TRUE, rowNames = FALSE) - - ## no headers - writeData(wb, sheet = 1, x = mtcars[0, ], colNames = FALSE, rowNames = FALSE, startRow = 5) - - ## row names - writeData(wb, sheet = 1, x = mtcars[0, ], colNames = TRUE, rowNames = TRUE, startRow = 10) - - ## row names only - writeData(wb, sheet = 1, x = mtcars[0, ], colNames = FALSE, rowNames = TRUE, startRow = 15) - - - ## ZERO COLS - ## headers only - writeData(wb, sheet = 2, x = mtcars[, 0], colNames = TRUE, rowNames = FALSE) - - ## no headers - writeData(wb, sheet = 2, x = mtcars[, 0], colNames = FALSE, rowNames = FALSE, startRow = 5) - - ## row names - writeData(wb, sheet = 2, x = mtcars[, 0], colNames = TRUE, rowNames = TRUE, startRow = 10) - - ## row names only - writeData(wb, sheet = 2, x = mtcars[, 0], colNames = FALSE, rowNames = TRUE, startRow = 15) - - saveWorkbook(wb, tempFile, overwrite = TRUE) - unlink(tempFile) -}) - - - - -test_that("too much data", { - wb <- createWorkbook() - addWorksheet(wb, "test1") - addWorksheet(wb, "test2") - df1 <- - data.frame(Col1 = paste(rep(1, 32768 + 100), collapse = "")) - df2 <- - data.frame(Col1 = paste(rep(1, 32768), collapse = "")) - expect_warning( - writeData(wb, 1, df1), - "1 is truncated. -Number of characters exeed the limit of 32767." - ) - expect_warning( - writeData(wb, 2, df2), - "1 is truncated. -Number of characters exeed the limit of 32767." - ) - }) + + + +context("Converting R types to Excel types") + + + +test_that("Converting R types to Excel types", { + wb <- createWorkbook() + addWorksheet(wb, "S1") + addWorksheet(wb, "S2") + addWorksheet(wb, "S3") + + writeDataTable(wb, "S1", x = iris) + + n_values <- prod(dim(iris)) + ncol(iris) + + sheet_data <- wb$worksheets[[1]]$sheet_data + + sheet_v <- sheet_data$v + sheet_t <- sheet_data$t + sheet_f <- sheet_data$f + sheet_row <- sheet_data$rows + sheet_col <- sheet_data$cols + + sheet_v <- as.numeric(sheet_v) + + expect_length(sheet_row, n_values) + expect_length(sheet_col, n_values) + expect_length(sheet_t, n_values) + expect_length(sheet_v, n_values) + expect_length(sheet_f, n_values) + + + ## rows/cols + expect_equal(sheet_row, rep(1:151, each = 5)) + expect_equal(sheet_col, rep(1:5, times = 151)) + + ## header types + expect_equal(sheet_t[1:5], rep(1, 5)) + + ## data.frame t & v + expect_equal(sheet_t[6:n_values], rep(c(0, 0, 0, 0, 1), 150)) + expect_equal(sheet_v[1:5], 0:4) + + expected_v <- c( + 5.1, 3.5, 1.4, 0.2, 5, 4.9, 3, 1.4, 0.2, 5, 4.7, 3.2, 1.3, + 0.2, 5, 4.6, 3.1, 1.5, 0.2, 5, 5, 3.6, 1.4, 0.2, 5, 5.4, 3.9, + 1.7, 0.4, 5, 4.6, 3.4, 1.4, 0.3, 5, 5, 3.4, 1.5, 0.2, 5, 4.4, + 2.9, 1.4, 0.2, 5, 4.9, 3.1, 1.5, 0.1, 5, 5.4, 3.7, 1.5, 0.2, + 5, 4.8, 3.4, 1.6, 0.2, 5, 4.8, 3, 1.4, 0.1, 5, 4.3, 3, 1.1, 0.1, + 5, 5.8, 4, 1.2, 0.2, 5, 5.7, 4.4, 1.5, 0.4, 5, 5.4, 3.9, 1.3, + 0.4, 5, 5.1, 3.5, 1.4, 0.3, 5, 5.7, 3.8, 1.7, 0.3, 5, 5.1, 3.8, + 1.5, 0.3, 5, 5.4, 3.4, 1.7, 0.2, 5, 5.1, 3.7, 1.5, 0.4, 5, 4.6, + 3.6, 1, 0.2, 5, 5.1, 3.3, 1.7, 0.5, 5, 4.8, 3.4, 1.9, 0.2, 5, + 5, 3, 1.6, 0.2, 5, 5, 3.4, 1.6, 0.4, 5, 5.2, 3.5, 1.5, 0.2, 5, + 5.2, 3.4, 1.4, 0.2, 5, 4.7, 3.2, 1.6, 0.2, 5, 4.8, 3.1, 1.6, + 0.2, 5, 5.4, 3.4, 1.5, 0.4, 5, 5.2, 4.1, 1.5, 0.1, 5, 5.5, 4.2, + 1.4, 0.2, 5, 4.9, 3.1, 1.5, 0.2, 5, 5, 3.2, 1.2, 0.2, 5, 5.5, + 3.5, 1.3, 0.2, 5, 4.9, 3.6, 1.4, 0.1, 5, 4.4, 3, 1.3, 0.2, 5, + 5.1, 3.4, 1.5, 0.2, 5, 5, 3.5, 1.3, 0.3, 5, 4.5, 2.3, 1.3, 0.3, + 5, 4.4, 3.2, 1.3, 0.2, 5, 5, 3.5, 1.6, 0.6, 5, 5.1, 3.8, 1.9, + 0.4, 5, 4.8, 3, 1.4, 0.3, 5, 5.1, 3.8, 1.6, 0.2, 5, 4.6, 3.2, + 1.4, 0.2, 5, 5.3, 3.7, 1.5, 0.2, 5, 5, 3.3, 1.4, 0.2, 5, 7, 3.2, + 4.7, 1.4, 6, 6.4, 3.2, 4.5, 1.5, 6, 6.9, 3.1, 4.9, 1.5, 6, 5.5, + 2.3, 4, 1.3, 6, 6.5, 2.8, 4.6, 1.5, 6, 5.7, 2.8, 4.5, 1.3, 6, + 6.3, 3.3, 4.7, 1.6, 6, 4.9, 2.4, 3.3, 1, 6, 6.6, 2.9, 4.6, 1.3, + 6, 5.2, 2.7, 3.9, 1.4, 6, 5, 2, 3.5, 1, 6, 5.9, 3, 4.2, 1.5, + 6, 6, 2.2, 4, 1, 6, 6.1, 2.9, 4.7, 1.4, 6, 5.6, 2.9, 3.6, 1.3, + 6, 6.7, 3.1, 4.4, 1.4, 6, 5.6, 3, 4.5, 1.5, 6, 5.8, 2.7, 4.1, + 1, 6, 6.2, 2.2, 4.5, 1.5, 6, 5.6, 2.5, 3.9, 1.1, 6, 5.9, 3.2, + 4.8, 1.8, 6, 6.1, 2.8, 4, 1.3, 6, 6.3, 2.5, 4.9, 1.5, 6, 6.1, + 2.8, 4.7, 1.2, 6, 6.4, 2.9, 4.3, 1.3, 6, 6.6, 3, 4.4, 1.4, 6, + 6.8, 2.8, 4.8, 1.4, 6, 6.7, 3, 5, 1.7, 6, 6, 2.9, 4.5, 1.5, 6, + 5.7, 2.6, 3.5, 1, 6, 5.5, 2.4, 3.8, 1.1, 6, 5.5, 2.4, 3.7, 1, + 6, 5.8, 2.7, 3.9, 1.2, 6, 6, 2.7, 5.1, 1.6, 6, 5.4, 3, 4.5, 1.5, + 6, 6, 3.4, 4.5, 1.6, 6, 6.7, 3.1, 4.7, 1.5, 6, 6.3, 2.3, 4.4, + 1.3, 6, 5.6, 3, 4.1, 1.3, 6, 5.5, 2.5, 4, 1.3, 6, 5.5, 2.6, 4.4, + 1.2, 6, 6.1, 3, 4.6, 1.4, 6, 5.8, 2.6, 4, 1.2, 6, 5, 2.3, 3.3, + 1, 6, 5.6, 2.7, 4.2, 1.3, 6, 5.7, 3, 4.2, 1.2, 6, 5.7, 2.9, 4.2, + 1.3, 6, 6.2, 2.9, 4.3, 1.3, 6, 5.1, 2.5, 3, 1.1, 6, 5.7, 2.8, + 4.1, 1.3, 6, 6.3, 3.3, 6, 2.5, 7, 5.8, 2.7, 5.1, 1.9, 7, 7.1, + 3, 5.9, 2.1, 7, 6.3, 2.9, 5.6, 1.8, 7, 6.5, 3, 5.8, 2.2, 7, 7.6, + 3, 6.6, 2.1, 7, 4.9, 2.5, 4.5, 1.7, 7, 7.3, 2.9, 6.3, 1.8, 7, + 6.7, 2.5, 5.8, 1.8, 7, 7.2, 3.6, 6.1, 2.5, 7, 6.5, 3.2, 5.1, + 2, 7, 6.4, 2.7, 5.3, 1.9, 7, 6.8, 3, 5.5, 2.1, 7, 5.7, 2.5, 5, + 2, 7, 5.8, 2.8, 5.1, 2.4, 7, 6.4, 3.2, 5.3, 2.3, 7, 6.5, 3, 5.5, + 1.8, 7, 7.7, 3.8, 6.7, 2.2, 7, 7.7, 2.6, 6.9, 2.3, 7, 6, 2.2, + 5, 1.5, 7, 6.9, 3.2, 5.7, 2.3, 7, 5.6, 2.8, 4.9, 2, 7, 7.7, 2.8, + 6.7, 2, 7, 6.3, 2.7, 4.9, 1.8, 7, 6.7, 3.3, 5.7, 2.1, 7, 7.2, + 3.2, 6, 1.8, 7, 6.2, 2.8, 4.8, 1.8, 7, 6.1, 3, 4.9, 1.8, 7, 6.4, + 2.8, 5.6, 2.1, 7, 7.2, 3, 5.8, 1.6, 7, 7.4, 2.8, 6.1, 1.9, 7, + 7.9, 3.8, 6.4, 2, 7, 6.4, 2.8, 5.6, 2.2, 7, 6.3, 2.8, 5.1, 1.5, + 7, 6.1, 2.6, 5.6, 1.4, 7, 7.7, 3, 6.1, 2.3, 7, 6.3, 3.4, 5.6, + 2.4, 7, 6.4, 3.1, 5.5, 1.8, 7, 6, 3, 4.8, 1.8, 7, 6.9, 3.1, 5.4, + 2.1, 7, 6.7, 3.1, 5.6, 2.4, 7, 6.9, 3.1, 5.1, 2.3, 7, 5.8, 2.7, + 5.1, 1.9, 7, 6.8, 3.2, 5.9, 2.3, 7, 6.7, 3.3, 5.7, 2.5, 7, 6.7, + 3, 5.2, 2.3, 7, 6.3, 2.5, 5, 1.9, 7, 6.5, 3, 5.2, 2, 7, 6.2, + 3.4, 5.4, 2.3, 7, 5.9, 3, 5.1, 1.8, 7 + ) + + expect_equal(sheet_v[6:n_values], expected_v) + + + + ############################ SPECIAL DATA TYPES + + df <- data.frame( + "Date" = as.Date("2016-12-5") - 0:19, + "T" = TRUE, + "F" = FALSE, + "Time" = as.POSIXct("2016-12-05 20:31:12 AEDT") - 0:19 * 60 * 60, + "Cash" = paste("$", 1:20), + "Cash2" = 31:50, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(0, 1, length.out = 20), + "TinyNumbers" = 1:20 / 1E9, stringsAsFactors = FALSE + ) + + ## openxlsx will apply default Excel styling for these classes + class(df$Cash) <- "currency" + class(df$Cash2) <- "accounting" + class(df$hLink) <- "hyperlink" + class(df$Percentage) <- "percentage" + class(df$TinyNumbers) <- "scientific" + + writeDataTable(wb, "S3", x = df, startRow = 4, rowNames = TRUE, tableStyle = "TableStyleMedium9") + + + + + ## Get all data + sheet_data <- wb$worksheets[[3]]$sheet_data + n_values <- (nrow(df) + 1) * (ncol(df) + 1) + sheet_v <- sheet_data$v + sheet_t <- sheet_data$t + sheet_f <- sheet_data$f + sheet_row <- sheet_data$rows + sheet_col <- sheet_data$cols + + sheet_v <- as.numeric(sheet_v) + + + expect_length(sheet_row, n_values) + expect_length(sheet_t, n_values) + + ## rows/cols + expect_equal(sheet_row, rep(4:24, each = ncol(df) + 1L)) + expect_equal(sheet_col, rep(1:10, times = nrow(df) + 1L)) + + ## header types + expect_equal(sheet_t[1:(ncol(df) + 1)], rep(1, ncol(df) + 1)) + + ## data.frame t & v + expect_equal(sheet_t[(ncol(df) + 2):n_values], rep(c(1, 0, 2, 2, 0, 0, 0, 1, 0, 0), 20)) + expect_equal(sheet_v[1:(ncol(df) + 1)], 8:17) + + + expected_v <- c( + 18, 42709, 1, 0, 42709.86, 1, 31, 19, 0, 0.000000001, 20, 42708, + 1, 0, 42709.81, 2, 32, 19, 0.05263158, 0.000000002, 21, 42707, + 1, 0, 42709.77, 3, 33, 19, 0.10526316, 0.000000003, 22, 42706, + 1, 0, 42709.73, 4, 34, 19, 0.15789474, 0.000000004, 23, 42705, + 1, 0, 42709.69, 5, 35, 19, 0.21052632, 0.000000005, 24, 42704, + 1, 0, 42709.65, 6, 36, 19, 0.26315789, 0.000000006, 25, 42703, + 1, 0, 42709.61, 7, 37, 19, 0.31578947, 0.000000007, 26, 42702, + 1, 0, 42709.56, 8, 38, 19, 0.36842105, 0.000000008, 27, 42701, + 1, 0, 42709.52, 9, 39, 19, 0.42105263, 0.000000009, 28, 42700, + 1, 0, 42709.48, 10, 40, 19, 0.47368421, 0.00000001, 29, 42699, + 1, 0, 42709.44, 11, 41, 19, 0.52631579, 0.000000011, 30, 42698, + 1, 0, 42709.4, 12, 42, 19, 0.57894737, 0.000000012, 31, 42697, + 1, 0, 42709.36, 13, 43, 19, 0.63157895, 0.000000013, 32, 42696, + 1, 0, 42709.31, 14, 44, 19, 0.68421053, 0.000000014, 33, 42695, + 1, 0, 42709.27, 15, 45, 19, 0.73684211, 0.000000015, 34, 42694, + 1, 0, 42709.23, 16, 46, 19, 0.78947368, 0.000000016, 35, 42693, + 1, 0, 42709.19, 17, 47, 19, 0.84210526, 0.000000017, 36, 42692, + 1, 0, 42709.15, 18, 48, 19, 0.89473684, 0.000000018, 37, 42691, + 1, 0, 42709.11, 19, 49, 19, 0.94736842, 0.000000019, 38, 42690, + 1, 0, 42709.06, 20, 50, 19, 1, 0.00000002 + ) + + + # expect_equal(sheet_v[(ncol(df)+2):n_values], expected_v) +}) + + + + +test_that("Write zero rows & columns", { + tempFile <- temp_xlsx() + wb <- createWorkbook() + addWorksheet(wb, "s1") + addWorksheet(wb, "s2") + + ## ZERO ROWS + + ## headers only + writeData(wb, sheet = 1, x = mtcars[0, ], colNames = TRUE, rowNames = FALSE) + + ## no headers + writeData(wb, sheet = 1, x = mtcars[0, ], colNames = FALSE, rowNames = FALSE, startRow = 5) + + ## row names + writeData(wb, sheet = 1, x = mtcars[0, ], colNames = TRUE, rowNames = TRUE, startRow = 10) + + ## row names only + writeData(wb, sheet = 1, x = mtcars[0, ], colNames = FALSE, rowNames = TRUE, startRow = 15) + + + ## ZERO COLS + ## headers only + writeData(wb, sheet = 2, x = mtcars[, 0], colNames = TRUE, rowNames = FALSE) + + ## no headers + writeData(wb, sheet = 2, x = mtcars[, 0], colNames = FALSE, rowNames = FALSE, startRow = 5) + + ## row names + writeData(wb, sheet = 2, x = mtcars[, 0], colNames = TRUE, rowNames = TRUE, startRow = 10) + + ## row names only + writeData(wb, sheet = 2, x = mtcars[, 0], colNames = FALSE, rowNames = TRUE, startRow = 15) + + saveWorkbook(wb, tempFile, overwrite = TRUE) + unlink(tempFile) +}) + + + + +test_that("too much data", { + wb <- createWorkbook() + addWorksheet(wb, "test1") + addWorksheet(wb, "test2") + df1 <- + data.frame(Col1 = paste(rep(1, 32768 + 100), collapse = "")) + df2 <- + data.frame(Col1 = paste(rep(1, 32768), collapse = "")) + expect_warning( + writeData(wb, 1, df1), + "1 is truncated. +Number of characters exeed the limit of 32767." + ) + expect_warning( + writeData(wb, 2, df2), + "1 is truncated. +Number of characters exeed the limit of 32767." + ) + }) + +# example from gh issue #200 +test_that("write hyperlinks", { + + tmp <- openxlsx:::temp_xlsx() + tmp_dir <- tempdir() + + + # create data + channels <- data.frame( + channel = c("ABC", "BBC", "CBC"), + homepage = c("https://www.abc.net.au/", + "https://www.bbc.com/", + "https://www.cbc.ca/"), + stringsAsFactors = FALSE + ) + + channels$formula <- paste0('=HYPERLINK("', + channels$homepage, + '","', + channels$channel, + '")') + + + # create xlsx + wb <- createWorkbook() + addWorksheet(wb, "channels") + writeDataTable(wb, "channels", channels, tableName = "channels") + writeFormula(wb, "channels", channels$formula, startRow = 2, startCol = 1) + freezePane(wb, "channels", firstRow = TRUE) + setColWidths(wb, "channels", cols = seq_along(channels), widths = "auto") + saveWorkbook(wb, file = tmp, overwrite = TRUE) + + # check the xls file for the correct string + unzip(tmp, exdir = tmp_dir) + sheet1 <- readLines(paste0(tmp_dir, "/xl/worksheets/sheet1.xml"), warn = FALSE) + res <- sapply(replaceIllegalCharacters(channels$formula), + FUN = function(str)grepl(str, x = sheet1, fixed = TRUE)) + + + expect_true(all(res)) +}) + + +test_that("write list containing NA",{ + + data <- data.frame(i=1:3) + data$x <- list(1, c(2, 3), c(4, NA, 5)) + + xlsx_file <- temp_xlsx() + wb <- createWorkbook() + addWorksheet(wb, "Sheet1") + writeData(wb, sheet = 1, data, sep = ";", na.string = "") + saveWorkbook(wb, file = xlsx_file, overwrite=TRUE) + + res <- read.xlsx(xlsx_file) + exp <- data.frame(i = 1:3, + x = c("1", "2;3", "4;;5"), + stringsAsFactors = FALSE) + + expect_equal(exp, res) + +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-write-permissions.R r-cran-openxlsx-4.2.5/tests/testthat/test-write-permissions.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-write-permissions.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-write-permissions.R 2021-12-13 08:14:44.000000000 +0000 @@ -0,0 +1,19 @@ + +context("error without write permissions") + +test_that("test failed write errors for saveWorkbook", { + temp_file <- tempfile() + file.create(temp_file) + Sys.chmod(path = temp_file, mode = "444") + + wb <- createWorkbook() + addWorksheet(wb, "name") + + expect_warning(write.xlsx( + x = cars, file = temp_file, overwrite = TRUE + ), + regexp = "Permission denied" + ) + + unlink(temp_file, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-write_read_equality.R r-cran-openxlsx-4.2.5/tests/testthat/test-write_read_equality.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-write_read_equality.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-write_read_equality.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,292 +1,294 @@ - - -context("Writing and reading returns similar objects") - -test_that("Writing then reading returns identical data.frame 1", { - curr_wd <- getwd() - - ## data - genDf <- function() { - set.seed(1) - data.frame( - "Date" = Sys.Date() - 0:4, - "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), - "Currency" = -2:2, - "Accounting" = -2:2, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(-1, 1, length.out = 5), - "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE - ) - } - - df <- genDf() - df - - class(df$Currency) <- "currency" - class(df$Accounting) <- "accounting" - class(df$hLink) <- "hyperlink" - class(df$Percentage) <- "percentage" - class(df$TinyNumber) <- "scientific" - - options("openxlsx.dateFormat" = "yyyy-mm-dd") - - fileName <- file.path(tempdir(), "allClasses.xlsx") - write.xlsx(df, file = fileName, overwrite = TRUE) - - x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE) - expect_equal(object = x, expected = genDf(), check.attributes = FALSE) - - unlink(fileName, recursive = TRUE, force = TRUE) - - expect_equal(object = getwd(), curr_wd) -}) - -test_that("Writing then reading returns identical data.frame 2", { - curr_wd <- getwd() - - ## data.frame of dates - dates <- data.frame("d1" = Sys.Date() - 0:500) - dates[nrow(dates)+1,] = as.Date("1900-01-02") - for (i in 1:3) dates <- cbind(dates, dates) - names(dates) <- paste0("d", 1:8) - - ## Date Formatting - wb <- createWorkbook() - addWorksheet(wb, "Date Formatting", gridLines = FALSE) - writeData(wb, 1, dates) ## write without styling - - ## set default date format - options("openxlsx.dateFormat" = "yyyy/mm/dd") - - ## numFmt == "DATE" will use the date format specified by the above - addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) - - ## some custom date format examples - sty <- createStyle(numFmt = "yyyy/mm/dd") - addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) - - sty <- createStyle(numFmt = "yyyy/mmm/dd") - addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) - - sty <- createStyle(numFmt = "yy / mmmm / dd") - addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) - - sty <- createStyle(numFmt = "ddddd") - addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) - - sty <- createStyle(numFmt = "yyyy-mmm-dd") - addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) - - sty <- createStyle(numFmt = "mm/ dd yyyy") - addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) - - sty <- createStyle(numFmt = "mm/dd/yy") - addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) - - setColWidths(wb, 1, cols = 1:10, widths = 23) - - - fileName <- file.path(tempdir(), "DateFormatting.xlsx") - write.xlsx(dates, file = fileName, overwrite = TRUE) - - x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE) - expect_equal(object = x, expected = dates, check.attributes = FALSE) - - - xNoDateDetection <- read.xlsx(xlsxFile = fileName, detectDates = FALSE) - dateOrigin <- getDateOrigin(fileName) - - - expect_equal(object = dateOrigin, expected = "1900-01-01", check.attributes = FALSE) - - for (i in seq_len(ncol(x))) { - xNoDateDetection[[i]] <- convertToDate(xNoDateDetection[[i]], origin = dateOrigin) - } - - expect_equal(object = xNoDateDetection, expected = dates, check.attributes = FALSE) - - expect_equal(object = getwd(), curr_wd) - unlink(fileName, recursive = TRUE, force = TRUE) -}) - -test_that("Writing then reading rowNames, colNames combinations", { - op <- options() - options(stringsAsFactors = FALSE) - on.exit(options(op), add = TRUE) - - - fileName <- temp_xlsx() - curr_wd <- getwd() - mt <- utils::head(mtcars) # don't need the whole thing - - # write the row and column names for testing - write.xlsx(mt, file = fileName, overwrite = TRUE, rowNames = TRUE, colNames = TRUE) - - # rowNames = colNames = TRUE - # Row names = first column - # Col names = first row - x <- read.xlsx(fileName, sheet = 1, rowNames = TRUE) - expect_equal(x, mt) - - - # rowNames = TRUE, colNames = FALSE - # Row names = first column - # Col names = X1, X2, etc - - # need to create an expected output - y <- as.data.frame(rbind(colnames(mt), as.matrix(mt))) - colnames(y) <- c(make.names(seq_along(mt))) - x <- read.xlsx(fileName, sheet = 1, rowNames = TRUE, colNames = FALSE) - expect_equal(x, y) - - - # rowNames = FALSE, colNames = TRUE - # Row names = "" - # Cl names = first row - y2 <- cbind(row.names(mt), mt) - colnames(y2)[1] <- "" - row.names(y2) <- NULL - x <- read.xlsx(fileName, sheet = 1, rowNames = FALSE, colNames = TRUE) - expect_equal(x, y2) - - # rowNames = FALSE, colNames = FALSE - # Row names = "" - # Col names = X1, X2, etc - y3 <- cbind(row.names(y), y) - colnames(y3) <- make.names(seq_along(y3)) - row.names(y3) <- NULL - x <- read.xlsx(fileName, sheet = 1, rowNames = FALSE, colNames = FALSE) - expect_equal(x, y3) - - - # Check wd - expect_equal(getwd(), curr_wd) - - unlink(fileName, recursive = TRUE, force = TRUE) -}) - - -test_that("Writing then reading returns identical data.frame 3", { - op <- options() - options(openxlsx.dateFormat = "yyyy-mm-dd") - on.exit(options(op), add = TRUE) - - ## data - df <- data.frame( - Date = as.Date("2021-05-21") - 0:4, - Logical = c(TRUE, FALSE, TRUE, TRUE, FALSE), - Currency = -2:2, - Accounting = -2:2, - hLink = "https://CRAN.R-project.org/", - Percentage = seq.int(-1, 1, length.out = 5), - TinyNumber = runif(5) / 1E9, - stringsAsFactors = FALSE - ) - - class(df$Currency) <- "currency" - class(df$Accounting) <- "accounting" - class(df$hLink) <- "hyperlink" - class(df$Percentage) <- "percentage" - class(df$TinyNumber) <- "scientific" - - fileName <- tempfile("allClasses", fileext = ".xlsx") - write.xlsx(df, file = fileName, overwrite = TRUE) - - ## rows, cols combinations - rows <- 1:4 - cols <- c(1, 3, 5) - x <- read.xlsx(fileName, detectDates = TRUE, rows = rows, cols = cols) - exp <- df[sort((rows - 1)[(rows - 1) <= nrow(df)]), sort(cols[cols <= ncol(df)])] - expect_equal(x, exp) - - rows <- 1:4 - cols <- 1:9 - x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE, rows = rows, cols = cols) - exp <- df[sort((rows - 1)[(rows - 1) <= nrow(df)]), sort(cols[cols <= ncol(df)])] - expect_equal(x, exp) - - rows <- 1:200 - cols <- c(5, 99, 2) - x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE, rows = rows, cols = cols) - exp <- df[sort((rows - 1)[(rows - 1) <= nrow(df)]), sort(cols[cols <= ncol(df)])] - expect_equal(x, exp) - - - rows <- 1000:900 - cols <- c(5, 99, 2) - suppressWarnings(x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE, rows = rows, cols = cols)) - expect_identical(x, NULL) - - unlink(fileName, recursive = TRUE, force = TRUE) -}) - - -test_that("Writing then reading returns identical data.frame 4", { - - ## data - df <- head(iris[, 1:4]) - df[1, 2] <- NA - df[3, 1] <- NA - df[6, 4] <- NA - - - tf <- temp_xlsx() - write.xlsx(x = df, file = tf, keepNA = TRUE) - x <- read.xlsx(tf) - - expect_equal(object = x, expected = df, check.attributes = TRUE) - unlink(tf, recursive = TRUE, force = TRUE) - - - tf <- temp_xlsx() - write.xlsx(x = df, file = tf, keepNA = FALSE) - x <- read.xlsx(tf) - - expect_equal(object = x, expected = df, check.attributes = TRUE) - unlink(tf, recursive = TRUE, force = TRUE) -}) - -test_that("Writing then reading returns identical data.frame 5", { - - ## data - df <- head(iris[, 1:4]) - df[1, 2] <- NA - df[3, 1] <- NA - df[6, 4] <- NA - - na.string <- "*" - df_expected <- df - df_expected[1, 2] <- na.string - df_expected[3, 1] <- na.string - df_expected[6, 4] <- na.string - - - tf <- temp_xlsx() - write.xlsx(x = df, file = tf, keepNA = TRUE, na.string = na.string) - x <- read.xlsx(tf) - - expect_equal(object = x, expected = df_expected, check.attributes = TRUE) - unlink(tf, recursive = TRUE, force = TRUE) -}) - - - -test_that("Special characters in sheet names", { - tf <- temp_xlsx() - - ## data - sheet_name <- "A & B < D > D" - - wb <- createWorkbook() - addWorksheet(wb, sheetName = sheet_name) - addWorksheet(wb, sheetName = "test") - writeData(wb, sheet = 1, x = 1:10) - saveWorkbook(wb = wb, file = tf, overwrite = TRUE) - - expect_equal(getSheetNames(tf)[1], sheet_name) - expect_equal(getSheetNames(tf)[2], "test") - - expect_equal(read.xlsx(tf, colNames = FALSE)[[1]], 1:10) - - unlink(tf, recursive = TRUE, force = TRUE) -}) + + +context("Writing and reading returns similar objects") + +test_that("Writing then reading returns identical data.frame 1", { + curr_wd <- getwd() + + ## data + genDf <- function() { + set.seed(1) + data.frame( + "Date" = Sys.Date() - 0:4, + "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), + "Currency" = -2:2, + "Accounting" = -2:2, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(-1, 1, length.out = 5), + "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE + ) + } + + df <- genDf() + df + + class(df$Currency) <- "currency" + class(df$Accounting) <- "accounting" + class(df$hLink) <- "hyperlink" + class(df$Percentage) <- "percentage" + class(df$TinyNumber) <- "scientific" + + op <- options() + options("openxlsx.dateFormat" = "yyyy-mm-dd") + + fileName <- file.path(tempdir(), "allClasses.xlsx") + write.xlsx(df, file = fileName, overwrite = TRUE) + + x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE) + expect_equal(object = x, expected = genDf(), check.attributes = FALSE) + + unlink(fileName, recursive = TRUE, force = TRUE) + + expect_equal(object = getwd(), curr_wd) + options(op) +}) + +test_that("Writing then reading returns identical data.frame 2", { + curr_wd <- getwd() + + ## data.frame of dates + dates <- data.frame("d1" = Sys.Date() - 0:500) + dates[nrow(dates)+1,] = as.Date("1900-01-02") + for (i in 1:3) dates <- cbind(dates, dates) + names(dates) <- paste0("d", 1:8) + + ## Date Formatting + wb <- createWorkbook() + addWorksheet(wb, "Date Formatting", gridLines = FALSE) + writeData(wb, 1, dates) ## write without styling + + ## set default date format + options("openxlsx.dateFormat" = "yyyy/mm/dd") + + ## numFmt == "DATE" will use the date format specified by the above + addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) + + ## some custom date format examples + sty <- createStyle(numFmt = "yyyy/mm/dd") + addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) + + sty <- createStyle(numFmt = "yyyy/mmm/dd") + addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) + + sty <- createStyle(numFmt = "yy / mmmm / dd") + addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) + + sty <- createStyle(numFmt = "ddddd") + addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) + + sty <- createStyle(numFmt = "yyyy-mmm-dd") + addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) + + sty <- createStyle(numFmt = "mm/ dd yyyy") + addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) + + sty <- createStyle(numFmt = "mm/dd/yy") + addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) + + setColWidths(wb, 1, cols = 1:10, widths = 23) + + + fileName <- file.path(tempdir(), "DateFormatting.xlsx") + write.xlsx(dates, file = fileName, overwrite = TRUE) + + x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE) + expect_equal(object = x, expected = dates, check.attributes = FALSE) + + + xNoDateDetection <- read.xlsx(xlsxFile = fileName, detectDates = FALSE) + dateOrigin <- getDateOrigin(fileName) + + + expect_equal(object = dateOrigin, expected = "1900-01-01", check.attributes = FALSE) + + for (i in seq_len(ncol(x))) { + xNoDateDetection[[i]] <- convertToDate(xNoDateDetection[[i]], origin = dateOrigin) + } + + expect_equal(object = xNoDateDetection, expected = dates, check.attributes = FALSE) + + expect_equal(object = getwd(), curr_wd) + unlink(fileName, recursive = TRUE, force = TRUE) +}) + +test_that("Writing then reading rowNames, colNames combinations", { + op <- options() + options(stringsAsFactors = FALSE) + + + fileName <- temp_xlsx() + curr_wd <- getwd() + mt <- utils::head(mtcars) # don't need the whole thing + + # write the row and column names for testing + write.xlsx(mt, file = fileName, overwrite = TRUE, rowNames = TRUE, colNames = TRUE) + + # rowNames = colNames = TRUE + # Row names = first column + # Col names = first row + x <- read.xlsx(fileName, sheet = 1, rowNames = TRUE) + expect_equal(x, mt) + + + # rowNames = TRUE, colNames = FALSE + # Row names = first column + # Col names = X1, X2, etc + + # need to create an expected output + y <- as.data.frame(rbind(colnames(mt), as.matrix(mt))) + colnames(y) <- c(make.names(seq_along(mt))) + x <- read.xlsx(fileName, sheet = 1, rowNames = TRUE, colNames = FALSE) + expect_equal(x, y) + + + # rowNames = FALSE, colNames = TRUE + # Row names = "" + # Cl names = first row + y2 <- cbind(row.names(mt), mt) + colnames(y2)[1] <- "" + row.names(y2) <- NULL + x <- read.xlsx(fileName, sheet = 1, rowNames = FALSE, colNames = TRUE) + expect_equal(x, y2) + + # rowNames = FALSE, colNames = FALSE + # Row names = "" + # Col names = X1, X2, etc + y3 <- cbind(row.names(y), y) + colnames(y3) <- make.names(seq_along(y3)) + row.names(y3) <- NULL + x <- read.xlsx(fileName, sheet = 1, rowNames = FALSE, colNames = FALSE) + expect_equal(x, y3) + + + # Check wd + expect_equal(getwd(), curr_wd) + + unlink(fileName, recursive = TRUE, force = TRUE) + options(op) +}) + + +test_that("Writing then reading returns identical data.frame 3", { + op <- options() + options(openxlsx.dateFormat = "yyyy-mm-dd") + + ## data + df <- data.frame( + Date = as.Date("2021-05-21") - 0:4, + Logical = c(TRUE, FALSE, TRUE, TRUE, FALSE), + Currency = -2:2, + Accounting = -2:2, + hLink = "https://CRAN.R-project.org/", + Percentage = seq.int(-1, 1, length.out = 5), + TinyNumber = runif(5) / 1E9, + stringsAsFactors = FALSE + ) + + class(df$Currency) <- "currency" + class(df$Accounting) <- "accounting" + class(df$hLink) <- "hyperlink" + class(df$Percentage) <- "percentage" + class(df$TinyNumber) <- "scientific" + + fileName <- tempfile("allClasses", fileext = ".xlsx") + write.xlsx(df, file = fileName, overwrite = TRUE) + + ## rows, cols combinations + rows <- 1:4 + cols <- c(1, 3, 5) + x <- read.xlsx(fileName, detectDates = TRUE, rows = rows, cols = cols) + exp <- df[sort((rows - 1)[(rows - 1) <= nrow(df)]), sort(cols[cols <= ncol(df)])] + expect_equal(x, exp) + + rows <- 1:4 + cols <- 1:9 + x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE, rows = rows, cols = cols) + exp <- df[sort((rows - 1)[(rows - 1) <= nrow(df)]), sort(cols[cols <= ncol(df)])] + expect_equal(x, exp) + + rows <- 1:200 + cols <- c(5, 99, 2) + x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE, rows = rows, cols = cols) + exp <- df[sort((rows - 1)[(rows - 1) <= nrow(df)]), sort(cols[cols <= ncol(df)])] + expect_equal(x, exp) + + + rows <- 1000:900 + cols <- c(5, 99, 2) + suppressWarnings(x <- read.xlsx(xlsxFile = fileName, detectDates = TRUE, rows = rows, cols = cols)) + expect_identical(x, NULL) + + unlink(fileName, recursive = TRUE, force = TRUE) + options(op) +}) + + +test_that("Writing then reading returns identical data.frame 4", { + + ## data + df <- head(iris[, 1:4]) + df[1, 2] <- NA + df[3, 1] <- NA + df[6, 4] <- NA + + + tf <- temp_xlsx() + write.xlsx(x = df, file = tf, keepNA = TRUE) + x <- read.xlsx(tf) + + expect_equal(object = x, expected = df, check.attributes = TRUE) + unlink(tf, recursive = TRUE, force = TRUE) + + + tf <- temp_xlsx() + write.xlsx(x = df, file = tf, keepNA = FALSE) + x <- read.xlsx(tf) + + expect_equal(object = x, expected = df, check.attributes = TRUE) + unlink(tf, recursive = TRUE, force = TRUE) +}) + +test_that("Writing then reading returns identical data.frame 5", { + + ## data + df <- head(iris[, 1:4]) + df[1, 2] <- NA + df[3, 1] <- NA + df[6, 4] <- NA + + na.string <- "*" + df_expected <- df + df_expected[1, 2] <- na.string + df_expected[3, 1] <- na.string + df_expected[6, 4] <- na.string + + + tf <- temp_xlsx() + write.xlsx(x = df, file = tf, keepNA = TRUE, na.string = na.string) + x <- read.xlsx(tf) + + expect_equal(object = x, expected = df_expected, check.attributes = TRUE) + unlink(tf, recursive = TRUE, force = TRUE) +}) + + + +test_that("Special characters in sheet names", { + tf <- temp_xlsx() + + ## data + sheet_name <- "A & B < D > D" + + wb <- createWorkbook() + addWorksheet(wb, sheetName = sheet_name) + addWorksheet(wb, sheetName = "test") + writeData(wb, sheet = 1, x = 1:10) + saveWorkbook(wb = wb, file = tf, overwrite = TRUE) + + expect_equal(getSheetNames(tf)[1], sheet_name) + expect_equal(getSheetNames(tf)[2], "test") + + expect_equal(read.xlsx(tf, colNames = FALSE)[[1]], 1:10) + + unlink(tf, recursive = TRUE, force = TRUE) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-write_xlsx_vector_args.R r-cran-openxlsx-4.2.5/tests/testthat/test-write_xlsx_vector_args.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-write_xlsx_vector_args.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-write_xlsx_vector_args.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,118 +1,118 @@ - -context("write.xlsx vector arguments") - -test_that("Writing then reading returns identical data.frame 1", { - tmp_file <- file.path(tempdir(), "xlsx_vector_args.xlsx") - - df1 <- data.frame(1:2) - df2 <- data.frame(1:3) - x <- list(df1, df2) - - write.xlsx( - file = tmp_file, - x = x, - gridLines = c(F, T), - sheetName = c("a", "b"), - zoom = c(50, 90), - tabColour = c("red", "blue") - ) - - wb <- loadWorkbook(tmp_file) - - expect_equal(getSheetNames(tmp_file), expected = c("a", "b")) - expect_equal(names(wb), expected = c("a", "b")) - - expect_true(grepl('rgb="FFFF0000"', wb$worksheets[[1]]$sheetPr)) - expect_true(grepl('rgb="FF0000FF"', wb$worksheets[[2]]$sheetPr)) - - expect_true(grepl('zoomScale="50"', wb$worksheets[[1]]$sheetViews)) - expect_true(grepl('zoomScale="90"', wb$worksheets[[2]]$sheetViews)) - - expect_true(grepl('showGridLines="0"', wb$worksheets[[1]]$sheetViews)) - expect_true(grepl('showGridLines="1"', wb$worksheets[[2]]$sheetViews)) - - expect_equal(read.xlsx(tmp_file, sheet = 1), df1) - expect_equal(read.xlsx(tmp_file, sheet = 2), df2) - - unlink(tmp_file, recursive = TRUE, force = TRUE) -}) - -test_that("write.xlsx() passes withFilter and colWidths [151]", { - df <- data.frame(x = 1, b = 2) - x <- buildWorkbook(df) - y <- buildWorkbook(df, withFilter = TRUE, colWidths = 15) - - expect_equal(x$worksheets[[1]]$autoFilter, character()) - expect_equal(y$worksheets[[1]]$autoFilter, "") - expect_equal(x$colWidths, list(list())) - - expect_equal( - y$colWidths[[1]], - structure(c(`1` = "15", `2` = "15"), hidden = c("0", "0")) - ) -}) - -test_that("write.xlsx() correctly passes default asTable and withFilters", { - df <- data.frame(x = 1, b = 2) - - # asTable = TRUE >> writeDataTable >> withFilter = TRUE - # asTable = FALSE >> writeData >> withFilter = FALSE - x <- buildWorkbook(df, asTable = FALSE) - y <- buildWorkbook(df, asTable = TRUE) - - # Save the workbook - tf <- temp_xlsx() - saveWorkbook(y, tf) - y2 <- loadWorkbook(tf) - - expect_identical(x$worksheets[[1]]$autoFilter, character()) - - # not autoFilter for tables -- not named in buildWorkbook - expect_equal( - y$worksheets[[1]]$tableParts, - structure("", tableName = "Table3") - ) - - expect_equal( - y2$worksheets[[1]]$tableParts, - structure("", tableName = c(`A1:B2` = "Table3")) - ) - - file.remove(tf) -}) - -test_that("write.xlsx() correctly handles colWidths", { - x <- data.frame(a = 1, b = 2, c = 3) - zero3 <- rep("0", 3) - - # No warning when passing "auto" - expect_warning(buildWorkbook(rep_len(list(x), 3), colWidths = "auto"), NA) - - # single value is repeated for all columns - wb <- buildWorkbook(rep_len(list(x), 3), colWidths = 13) - exp <- rep_len(list(structure(c(`1` = "13", `2` = "13", `3` = "13"), hidden = zero3)), 3) - expect_equal(wb$colWidths, exp) - - # sets are repeated - wb <- buildWorkbook(rep_len(list(x), 3), colWidths = list(c(10, 20, 30))) - exp <- rep_len(list(structure(c(`1` = "10", `2` = "20", `3` = "30"), hidden = zero3)), 3) - expect_equal(wb$colWidths, exp) - - # 3 distinct sets - wb <- buildWorkbook( - rep_len(list(x), 3), - colWidths = list( - c(10, 20, 30), - c(100, 200, 300), - c(1, 2, 3) - )) - - expect_equal( - wb$colWidths, - list( - structure(c(`1` = "10", `2` = "20", `3` = "30"), hidden = zero3), - structure(c(`1` = "100", `2` = "200", `3` = "300"), hidden = zero3), - structure(c(`1` = "1", `2` = "2", `3` = "3"), hidden = zero3) - ) - ) -}) + +context("write.xlsx vector arguments") + +test_that("Writing then reading returns identical data.frame 1", { + tmp_file <- file.path(tempdir(), "xlsx_vector_args.xlsx") + + df1 <- data.frame(1:2) + df2 <- data.frame(1:3) + x <- list(df1, df2) + + write.xlsx( + file = tmp_file, + x = x, + gridLines = c(F, T), + sheetName = c("a", "b"), + zoom = c(50, 90), + tabColour = c("red", "blue") + ) + + wb <- loadWorkbook(tmp_file) + + expect_equal(getSheetNames(tmp_file), expected = c("a", "b")) + expect_equal(names(wb), expected = c("a", "b")) + + expect_true(grepl('rgb="FFFF0000"', wb$worksheets[[1]]$sheetPr)) + expect_true(grepl('rgb="FF0000FF"', wb$worksheets[[2]]$sheetPr)) + + expect_true(grepl('zoomScale="50"', wb$worksheets[[1]]$sheetViews)) + expect_true(grepl('zoomScale="90"', wb$worksheets[[2]]$sheetViews)) + + expect_true(grepl('showGridLines="0"', wb$worksheets[[1]]$sheetViews)) + expect_true(grepl('showGridLines="1"', wb$worksheets[[2]]$sheetViews)) + + expect_equal(read.xlsx(tmp_file, sheet = 1), df1) + expect_equal(read.xlsx(tmp_file, sheet = 2), df2) + + unlink(tmp_file, recursive = TRUE, force = TRUE) +}) + +test_that("write.xlsx() passes withFilter and colWidths [151]", { + df <- data.frame(x = 1, b = 2) + x <- buildWorkbook(df) + y <- buildWorkbook(df, withFilter = TRUE, colWidths = 15) + + expect_equal(x$worksheets[[1]]$autoFilter, character()) + expect_equal(y$worksheets[[1]]$autoFilter, "") + expect_equal(x$colWidths, list(list())) + + expect_equal( + y$colWidths[[1]], + structure(c(`1` = "15", `2` = "15"), hidden = c("0", "0")) + ) +}) + +test_that("write.xlsx() correctly passes default asTable and withFilters", { + df <- data.frame(x = 1, b = 2) + + # asTable = TRUE >> writeDataTable >> withFilter = TRUE + # asTable = FALSE >> writeData >> withFilter = FALSE + x <- buildWorkbook(df, asTable = FALSE) + y <- buildWorkbook(df, asTable = TRUE) + + # Save the workbook + tf <- temp_xlsx() + saveWorkbook(y, tf) + y2 <- loadWorkbook(tf) + + expect_identical(x$worksheets[[1]]$autoFilter, character()) + + # not autoFilter for tables -- not named in buildWorkbook + expect_equal( + y$worksheets[[1]]$tableParts, + structure("", tableName = "Table3") + ) + + expect_equal( + y2$worksheets[[1]]$tableParts, + structure("", tableName = c(`A1:B2` = "Table3")) + ) + + file.remove(tf) +}) + +test_that("write.xlsx() correctly handles colWidths", { + x <- data.frame(a = 1, b = 2, c = 3) + zero3 <- rep("0", 3) + + # No warning when passing "auto" + expect_warning(buildWorkbook(rep_len(list(x), 3), colWidths = "auto"), NA) + + # single value is repeated for all columns + wb <- buildWorkbook(rep_len(list(x), 3), colWidths = 13) + exp <- rep_len(list(structure(c(`1` = "13", `2` = "13", `3` = "13"), hidden = zero3)), 3) + expect_equal(wb$colWidths, exp) + + # sets are repeated + wb <- buildWorkbook(rep_len(list(x), 3), colWidths = list(c(10, 20, 30))) + exp <- rep_len(list(structure(c(`1` = "10", `2` = "20", `3` = "30"), hidden = zero3)), 3) + expect_equal(wb$colWidths, exp) + + # 3 distinct sets + wb <- buildWorkbook( + rep_len(list(x), 3), + colWidths = list( + c(10, 20, 30), + c(100, 200, 300), + c(1, 2, 3) + )) + + expect_equal( + wb$colWidths, + list( + structure(c(`1` = "10", `2` = "20", `3` = "30"), hidden = zero3), + structure(c(`1` = "100", `2` = "200", `3` = "300"), hidden = zero3), + structure(c(`1` = "1", `2` = "2", `3` = "3"), hidden = zero3) + ) + ) +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-writing_posixct.R r-cran-openxlsx-4.2.5/tests/testthat/test-writing_posixct.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-writing_posixct.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-writing_posixct.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,99 +1,99 @@ - - - - - - - -context("Writing Posixct") - - - -test_that("Writing Posixct with writeData & writeDataTable", { - options("openxlsx.datetimeFormat" = "dd/mm/yy hh:mm") - - tstart <- strptime("30/05/2017 08:30", "%d/%m/%Y %H:%M", tz = "CET") - TimeDT <- c(0, 5, 10, 15, 30, 60, 120, 180, 240, 480, 720, 1440) * 60 + tstart - df <- data.frame(TimeDT, TimeTxt = format(TimeDT, "%Y-%m-%d %H:%M")) - - wb <- createWorkbook() - addWorksheet(wb, "writeData") - addWorksheet(wb, "writeDataTable") - - writeData(wb, "writeData", df, startCol = 2, startRow = 3, rowNames = FALSE) - writeDataTable(wb, "writeDataTable", df, startCol = 2, startRow = 3) - - wd <- as.numeric(wb$worksheets[[1]]$sheet_data$v) - wdt <- as.numeric(wb$worksheets[[2]]$sheet_data$v) - - - expected <- c( - 0, 1, 42885.3541666667, 2, 42885.3576388889, 3, 42885.3611111111, - 4, 42885.3645833333, 5, 42885.375, 6, 42885.3958333333, 7, 42885.4375, - 8, 42885.4791666667, 9, 42885.5208333333, 10, 42885.6875, 11, - 42885.8541666667, 12, 42886.3541666667, 13 - ) - - expect_equal(object = round(wd, 12), expected = expected) - expect_equal(object = round(wdt, 12), expected = expected) - expect_equal(object = wd, expected = wdt) - - options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -}) - - -test_that("Writing mixed EDT/EST Posixct with writeData & writeDataTable", { - options("openxlsx.datetimeFormat" = "dd/mm/yy hh:mm") - - tstart1 <- as.POSIXct("12/03/2018 08:30", format = "%d/%m/%Y %H:%M") - tstart2 <- as.POSIXct("10/03/2018 08:30", format = "%d/%m/%Y %H:%M") - TimeDT1 <- c(NA, 0, 10, 30, 60, 120, 240, 720, 1440) * 60 + tstart1 - TimeDT2 <- c(0, 10, 30, 60, 120, 240, 720, NA, 1440) * 60 + tstart2 - - df <- data.frame( - timeval = c(TimeDT1, TimeDT2), - timetxt = format(c(TimeDT1, TimeDT2), "%Y-%m-%d %H:%M") - ) - - wb <- createWorkbook() - addWorksheet(wb, "writeData") - addWorksheet(wb, "writeDataTable") - - writeData(wb, "writeData", df, startCol = 2, startRow = 3, rowNames = FALSE) - writeDataTable(wb, "writeDataTable", df, startCol = 2, startRow = 3) - - wd <- as.numeric(wb$worksheets[[1]]$sheet_data$v) - wdt <- as.numeric(wb$worksheets[[2]]$sheet_data$v) - wd <- wd[wb$worksheets[[1]]$sheet_data$cols == 2] - wdt <- wdt[wb$worksheets[[2]]$sheet_data$cols == 2] - - # drop any integer indexes introduced in write - wd <- wd[wd != 0 | is.na(wd)] - wdt <- wdt[wdt != 0 | is.na(wdt)] - - # sort everything - wd <- convertToDateTime(wd[order(wd)]) - wdt <- convertToDateTime(wdt[order(wdt)]) - expected <- df$timeval[order(df$timeval)] - - # compare - expect_equal( - object = wd, - expected = expected, - tolerance = 10 ^ -10, - check.tzone = FALSE - ) - expect_equal( - object = wdt, - expected = expected, - tolerance = 10 ^ -10, - check.tzone = TRUE - ) - expect_equal( - object = wd, - expected = wdt, - check.tzone = TRUE - ) - - options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -}) + + + + + + + +context("Writing Posixct") + + + +test_that("Writing Posixct with writeData & writeDataTable", { + options("openxlsx.datetimeFormat" = "dd/mm/yy hh:mm") + + tstart <- strptime("30/05/2017 08:30", "%d/%m/%Y %H:%M", tz = "CET") + TimeDT <- c(0, 5, 10, 15, 30, 60, 120, 180, 240, 480, 720, 1440) * 60 + tstart + df <- data.frame(TimeDT, TimeTxt = format(TimeDT, "%Y-%m-%d %H:%M")) + + wb <- createWorkbook() + addWorksheet(wb, "writeData") + addWorksheet(wb, "writeDataTable") + + writeData(wb, "writeData", df, startCol = 2, startRow = 3, rowNames = FALSE) + writeDataTable(wb, "writeDataTable", df, startCol = 2, startRow = 3) + + wd <- as.numeric(wb$worksheets[[1]]$sheet_data$v) + wdt <- as.numeric(wb$worksheets[[2]]$sheet_data$v) + + + expected <- c( + 0, 1, 42885.3541666667, 2, 42885.3576388889, 3, 42885.3611111111, + 4, 42885.3645833333, 5, 42885.375, 6, 42885.3958333333, 7, 42885.4375, + 8, 42885.4791666667, 9, 42885.5208333333, 10, 42885.6875, 11, + 42885.8541666667, 12, 42886.3541666667, 13 + ) + + expect_equal(object = round(wd, 12), expected = expected) + expect_equal(object = round(wdt, 12), expected = expected) + expect_equal(object = wd, expected = wdt) + + options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +}) + + +test_that("Writing mixed EDT/EST Posixct with writeData & writeDataTable", { + options("openxlsx.datetimeFormat" = "dd/mm/yy hh:mm") + + tstart1 <- as.POSIXct("12/03/2018 08:30", format = "%d/%m/%Y %H:%M") + tstart2 <- as.POSIXct("10/03/2018 08:30", format = "%d/%m/%Y %H:%M") + TimeDT1 <- c(NA, 0, 10, 30, 60, 120, 240, 720, 1440) * 60 + tstart1 + TimeDT2 <- c(0, 10, 30, 60, 120, 240, 720, NA, 1440) * 60 + tstart2 + + df <- data.frame( + timeval = c(TimeDT1, TimeDT2), + timetxt = format(c(TimeDT1, TimeDT2), "%Y-%m-%d %H:%M") + ) + + wb <- createWorkbook() + addWorksheet(wb, "writeData") + addWorksheet(wb, "writeDataTable") + + writeData(wb, "writeData", df, startCol = 2, startRow = 3, rowNames = FALSE) + writeDataTable(wb, "writeDataTable", df, startCol = 2, startRow = 3) + + wd <- as.numeric(wb$worksheets[[1]]$sheet_data$v) + wdt <- as.numeric(wb$worksheets[[2]]$sheet_data$v) + wd <- wd[wb$worksheets[[1]]$sheet_data$cols == 2] + wdt <- wdt[wb$worksheets[[2]]$sheet_data$cols == 2] + + # drop any integer indexes introduced in write + wd <- wd[wd != 0 | is.na(wd)] + wdt <- wdt[wdt != 0 | is.na(wdt)] + + # sort everything + wd <- convertToDateTime(wd[order(wd)]) + wdt <- convertToDateTime(wdt[order(wdt)]) + expected <- df$timeval[order(df$timeval)] + + # compare + expect_equal( + object = wd, + expected = expected, + tolerance = 10 ^ -10, + check.tzone = FALSE + ) + expect_equal( + object = wdt, + expected = expected, + tolerance = 10 ^ -10, + check.tzone = TRUE + ) + expect_equal( + object = wd, + expected = wdt, + check.tzone = TRUE + ) + + options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat/test-writing_sheet_data.R r-cran-openxlsx-4.2.5/tests/testthat/test-writing_sheet_data.R --- r-cran-openxlsx-4.2.4/tests/testthat/test-writing_sheet_data.R 2021-06-07 12:30:48.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat/test-writing_sheet_data.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,223 +1,223 @@ - -context("Writing Sheet Data XML") - - -test_that("Writing sheetData rows XML - iris", { - temp_file <- temp_xlsx() - openxlsx::write.xlsx(iris, temp_file) - - unzip(temp_file, exdir = tempdir()) - x <- readUTF8(file.path(tempdir(), "xl", "worksheets", "sheet1.xml")) - rows <- unlist(regmatches(x = x, gregexpr("", x))) - - expected_rows <- c( - "01234", - "5.13.51.40.25", - "4.931.40.25", - "4.73.21.30.25", - "4.63.11.50.25", - "53.61.40.25", - "5.43.91.70.45", - "4.63.41.40.35", - "53.41.50.25", - "4.42.91.40.25", - "4.93.11.50.15", - "5.43.71.50.25", - "4.83.41.60.25", - "4.831.40.15", - "4.331.10.15", - "5.841.20.25", - "5.74.41.50.45", - "5.43.91.30.45", - "5.13.51.40.35", - "5.73.81.70.35", - "5.13.81.50.35", - "5.43.41.70.25", - "5.13.71.50.45", - "4.63.610.25", - "5.13.31.70.55", - "4.83.41.90.25", - "531.60.25", - "53.41.60.45", - "5.23.51.50.25", - "5.23.41.40.25", - "4.73.21.60.25", - "4.83.11.60.25", - "5.43.41.50.45", - "5.24.11.50.15", - "5.54.21.40.25", - "4.93.11.50.25", - "53.21.20.25", - "5.53.51.30.25", - "4.93.61.40.15", - "4.431.30.25", - "5.13.41.50.25", - "53.51.30.35", - "4.52.31.30.35", - "4.43.21.30.25", - "53.51.60.65", - "5.13.81.90.45", - "4.831.40.35", - "5.13.81.60.25", - "4.63.21.40.25", - "5.33.71.50.25", - "53.31.40.25", - "73.24.71.46", - "6.43.24.51.56", - "6.93.14.91.56", - "5.52.341.36", - "6.52.84.61.56", - "5.72.84.51.36", - "6.33.34.71.66", - "4.92.43.316", - "6.62.94.61.36", - "5.22.73.91.46", - "523.516", - "5.934.21.56", - "62.2416", - "6.12.94.71.46", - "5.62.93.61.36", - "6.73.14.41.46", - "5.634.51.56", - "5.82.74.116", - "6.22.24.51.56", - "5.62.53.91.16", - "5.93.24.81.86", - "6.12.841.36", - "6.32.54.91.56", - "6.12.84.71.26", - "6.42.94.31.36", - "6.634.41.46", - "6.82.84.81.46", - "6.7351.76", - "62.94.51.56", - "5.72.63.516", - "5.52.43.81.16", - "5.52.43.716", - "5.82.73.91.26", - "62.75.11.66", - "5.434.51.56", - "63.44.51.66", - "6.73.14.71.56", - "6.32.34.41.36", - "5.634.11.36", - "5.52.541.36", - "5.52.64.41.26", - "6.134.61.46", - "5.82.641.26", - "52.33.316", - "5.62.74.21.36", - "5.734.21.26", - "5.72.94.21.36", - "6.22.94.31.36", - "5.12.531.16", - "5.72.84.11.36", - "6.33.362.57", - "5.82.75.11.97", - "7.135.92.17", - "6.32.95.61.87", - "6.535.82.27", - "7.636.62.17", - "4.92.54.51.77", - "7.32.96.31.87", - "6.72.55.81.87", - "7.23.66.12.57", - "6.53.25.127", - "6.42.75.31.97", - "6.835.52.17", - "5.72.5527", - "5.82.85.12.47", - "6.43.25.32.37", - "6.535.51.87", - "7.73.86.72.27", - "7.72.66.92.37", - "62.251.57", - "6.93.25.72.37", - "5.62.84.927", - "7.72.86.727", - "6.32.74.91.87", - "6.73.35.72.17", - "7.23.261.87", - "6.22.84.81.87", - "6.134.91.87", - "6.42.85.62.17", - "7.235.81.67", - "7.42.86.11.97", - "7.93.86.427", - "6.42.85.62.27", - "6.32.85.11.57", - "6.12.65.61.47", - "7.736.12.37", - "6.33.45.62.47", - "6.43.15.51.87", - "634.81.87", - "6.93.15.42.17", - "6.73.15.62.47", - "6.93.15.12.37", - "5.82.75.11.97", - "6.83.25.92.37", - "6.73.35.72.57", - "6.735.22.37", - "6.32.551.97", - "6.535.227", - "6.23.45.42.37", - "5.935.11.87" - ) - - for (i in seq_along(expected_rows)) { - expect_equal(rows[i], expected = expected_rows[i]) - } - - - unlink(x = temp_file) -}) - - -test_that("Writing sheetData rows XML - mtcars", { - temp_file <- temp_xlsx() - openxlsx::write.xlsx(mtcars, temp_file, rowNames = TRUE) - - unzip(temp_file, exdir = tempdir()) - x <- readUTF8(file.path(tempdir(), "xl", "worksheets", "sheet1.xml")) - rows <- unlist(regmatches(x = x, gregexpr("", x))) - - expected_rows <- c( - "01234567891011", - "122161601103.92.6216.460144", - "132161601103.92.87517.020144", - "1422.84108933.852.3218.611141", - "1521.462581103.083.21519.441031", - "1618.783601753.153.4417.020032", - "1718.162251052.763.4620.221031", - "1814.383602453.213.5715.840034", - "1924.44146.7623.693.19201042", - "2022.84140.8953.923.1522.91042", - "2119.26167.61233.923.4418.31044", - "2217.86167.61233.923.4418.91044", - "2316.48275.81803.074.0717.40033", - "2417.38275.81803.073.7317.60033", - "2515.28275.81803.073.78180033", - "2610.484722052.935.2517.980034", - "2710.4846021535.42417.820034", - "2814.784402303.235.34517.420034", - "2932.4478.7664.082.219.471141", - "3030.4475.7524.931.61518.521142", - "3133.9471.1654.221.83519.91141", - "3221.54120.1973.72.46520.011031", - "3315.583181502.763.5216.870032", - "3415.283041503.153.43517.30032", - "3513.383502453.733.8415.410034", - "3619.284001753.083.84517.050032", - "3727.3479664.081.93518.91141", - "38264120.3914.432.1416.70152", - "3930.4495.11133.771.51316.91152", - "4015.883512644.223.1714.50154", - "4119.761451753.622.7715.50156", - "421583013353.543.5714.60158", - "4321.441211094.112.7818.61142" - ) - - for (i in seq_along(expected_rows)) { - expect_equal(rows[i], expected = expected_rows[i]) - } -}) + +context("Writing Sheet Data XML") + + +test_that("Writing sheetData rows XML - iris", { + temp_file <- temp_xlsx() + openxlsx::write.xlsx(iris, temp_file) + + unzip(temp_file, exdir = tempdir()) + x <- readUTF8(file.path(tempdir(), "xl", "worksheets", "sheet1.xml")) + rows <- unlist(regmatches(x = x, gregexpr("", x))) + + expected_rows <- c( + "01234", + "5.13.51.40.25", + "4.931.40.25", + "4.73.21.30.25", + "4.63.11.50.25", + "53.61.40.25", + "5.43.91.70.45", + "4.63.41.40.35", + "53.41.50.25", + "4.42.91.40.25", + "4.93.11.50.15", + "5.43.71.50.25", + "4.83.41.60.25", + "4.831.40.15", + "4.331.10.15", + "5.841.20.25", + "5.74.41.50.45", + "5.43.91.30.45", + "5.13.51.40.35", + "5.73.81.70.35", + "5.13.81.50.35", + "5.43.41.70.25", + "5.13.71.50.45", + "4.63.610.25", + "5.13.31.70.55", + "4.83.41.90.25", + "531.60.25", + "53.41.60.45", + "5.23.51.50.25", + "5.23.41.40.25", + "4.73.21.60.25", + "4.83.11.60.25", + "5.43.41.50.45", + "5.24.11.50.15", + "5.54.21.40.25", + "4.93.11.50.25", + "53.21.20.25", + "5.53.51.30.25", + "4.93.61.40.15", + "4.431.30.25", + "5.13.41.50.25", + "53.51.30.35", + "4.52.31.30.35", + "4.43.21.30.25", + "53.51.60.65", + "5.13.81.90.45", + "4.831.40.35", + "5.13.81.60.25", + "4.63.21.40.25", + "5.33.71.50.25", + "53.31.40.25", + "73.24.71.46", + "6.43.24.51.56", + "6.93.14.91.56", + "5.52.341.36", + "6.52.84.61.56", + "5.72.84.51.36", + "6.33.34.71.66", + "4.92.43.316", + "6.62.94.61.36", + "5.22.73.91.46", + "523.516", + "5.934.21.56", + "62.2416", + "6.12.94.71.46", + "5.62.93.61.36", + "6.73.14.41.46", + "5.634.51.56", + "5.82.74.116", + "6.22.24.51.56", + "5.62.53.91.16", + "5.93.24.81.86", + "6.12.841.36", + "6.32.54.91.56", + "6.12.84.71.26", + "6.42.94.31.36", + "6.634.41.46", + "6.82.84.81.46", + "6.7351.76", + "62.94.51.56", + "5.72.63.516", + "5.52.43.81.16", + "5.52.43.716", + "5.82.73.91.26", + "62.75.11.66", + "5.434.51.56", + "63.44.51.66", + "6.73.14.71.56", + "6.32.34.41.36", + "5.634.11.36", + "5.52.541.36", + "5.52.64.41.26", + "6.134.61.46", + "5.82.641.26", + "52.33.316", + "5.62.74.21.36", + "5.734.21.26", + "5.72.94.21.36", + "6.22.94.31.36", + "5.12.531.16", + "5.72.84.11.36", + "6.33.362.57", + "5.82.75.11.97", + "7.135.92.17", + "6.32.95.61.87", + "6.535.82.27", + "7.636.62.17", + "4.92.54.51.77", + "7.32.96.31.87", + "6.72.55.81.87", + "7.23.66.12.57", + "6.53.25.127", + "6.42.75.31.97", + "6.835.52.17", + "5.72.5527", + "5.82.85.12.47", + "6.43.25.32.37", + "6.535.51.87", + "7.73.86.72.27", + "7.72.66.92.37", + "62.251.57", + "6.93.25.72.37", + "5.62.84.927", + "7.72.86.727", + "6.32.74.91.87", + "6.73.35.72.17", + "7.23.261.87", + "6.22.84.81.87", + "6.134.91.87", + "6.42.85.62.17", + "7.235.81.67", + "7.42.86.11.97", + "7.93.86.427", + "6.42.85.62.27", + "6.32.85.11.57", + "6.12.65.61.47", + "7.736.12.37", + "6.33.45.62.47", + "6.43.15.51.87", + "634.81.87", + "6.93.15.42.17", + "6.73.15.62.47", + "6.93.15.12.37", + "5.82.75.11.97", + "6.83.25.92.37", + "6.73.35.72.57", + "6.735.22.37", + "6.32.551.97", + "6.535.227", + "6.23.45.42.37", + "5.935.11.87" + ) + + for (i in seq_along(expected_rows)) { + expect_equal(rows[i], expected = expected_rows[i]) + } + + + unlink(x = temp_file) +}) + + +test_that("Writing sheetData rows XML - mtcars", { + temp_file <- temp_xlsx() + openxlsx::write.xlsx(mtcars, temp_file, rowNames = TRUE) + + unzip(temp_file, exdir = tempdir()) + x <- readUTF8(file.path(tempdir(), "xl", "worksheets", "sheet1.xml")) + rows <- unlist(regmatches(x = x, gregexpr("", x))) + + expected_rows <- c( + "01234567891011", + "122161601103.92.6216.460144", + "132161601103.92.87517.020144", + "1422.84108933.852.3218.611141", + "1521.462581103.083.21519.441031", + "1618.783601753.153.4417.020032", + "1718.162251052.763.4620.221031", + "1814.383602453.213.5715.840034", + "1924.44146.7623.693.19201042", + "2022.84140.8953.923.1522.91042", + "2119.26167.61233.923.4418.31044", + "2217.86167.61233.923.4418.91044", + "2316.48275.81803.074.0717.40033", + "2417.38275.81803.073.7317.60033", + "2515.28275.81803.073.78180033", + "2610.484722052.935.2517.980034", + "2710.4846021535.42417.820034", + "2814.784402303.235.34517.420034", + "2932.4478.7664.082.219.471141", + "3030.4475.7524.931.61518.521142", + "3133.9471.1654.221.83519.91141", + "3221.54120.1973.72.46520.011031", + "3315.583181502.763.5216.870032", + "3415.283041503.153.43517.30032", + "3513.383502453.733.8415.410034", + "3619.284001753.083.84517.050032", + "3727.3479664.081.93518.91141", + "38264120.3914.432.1416.70152", + "3930.4495.11133.771.51316.91152", + "4015.883512644.223.1714.50154", + "4119.761451753.622.7715.50156", + "421583013353.543.5714.60158", + "4321.441211094.112.7818.61142" + ) + + for (i in seq_along(expected_rows)) { + expect_equal(rows[i], expected = expected_rows[i]) + } +}) diff -Nru r-cran-openxlsx-4.2.4/tests/testthat.R r-cran-openxlsx-4.2.5/tests/testthat.R --- r-cran-openxlsx-4.2.4/tests/testthat.R 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/tests/testthat.R 2021-12-13 08:14:44.000000000 +0000 @@ -1,4 +1,4 @@ -library(testthat) -library(openxlsx) - -test_check("openxlsx") +library(testthat) +library(openxlsx) + +test_check("openxlsx") diff -Nru r-cran-openxlsx-4.2.4/vignettes/Formatting.Rmd r-cran-openxlsx-4.2.5/vignettes/Formatting.Rmd --- r-cran-openxlsx-4.2.4/vignettes/Formatting.Rmd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/vignettes/Formatting.Rmd 2021-12-13 08:14:44.000000000 +0000 @@ -1,326 +1,326 @@ ---- -title: "Formating with xlsx" -author: "Alexander Walker, Philipp Schauberger" -date: "`r Sys.Date()`" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{Formating with xlsx} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - - -## Formatting with writeData and writeDataTable - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -## data.frame to write -df <- data.frame("Date" = Sys.Date()-0:4, - "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), - "Currency" = paste("$",-2:2), - "Accounting" = -2:2, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(-1, 1, length.out=5), - "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE) - -class(df$Currency) <- "currency" -class(df$Accounting) <- "accounting" -class(df$hLink) <- "hyperlink" -class(df$Percentage) <- "percentage" -class(df$TinyNumber) <- "scientific" - -## Formatting can be applied simply through the write functions -## global options can be set to further simplify things -options("openxlsx.borderStyle" = "thin") -options("openxlsx.borderColour" = "#4F81BD") - -## create a workbook and add a worksheet -wb <- createWorkbook() -addWorksheet(wb, "writeData auto-formatting") - -writeData(wb, 1, df, startRow = 2, startCol = 2) -writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding") -writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows") -writeData(wb, 1, df, startRow = 23, startCol = 2, borders ="columns") -writeData(wb, 1, df, startRow = 30, startCol = 2, borders ="all") - -## headerStyles -hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold", - border = "Bottom", fontColour = "white") - -writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1, - borders = "rows", borderStyle = "medium") - -## to change the display text for a hyperlink column just write over those cells -writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14) - - -## writing as an Excel Table - -addWorksheet(wb, "writeDataTable") -writeDataTable(wb, 2, df, startRow = 2, startCol = 2) -writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9") -writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2") -writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21") - -openXL(wb) ## opens a temp version -``` - - -## Use of pre-defined table styles - -The 'tableStyle' argument in writeDataTable can be any of the predefined tableStyles in Excel. - -![](tableStyles.PNG) - -## Date Formatting - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -# data.frame of dates -dates <- data.frame("d1" = Sys.Date() - 0:4) -for(i in 1:3) dates <- cbind(dates, dates) -names(dates) <- paste0("d", 1:8) - -## Date Formatting -wb <- createWorkbook() -addWorksheet(wb, "Date Formatting", gridLines = FALSE) -writeData(wb, 1, dates) ## write without styling - -## openxlsx converts columns of class "Date" to Excel dates with the format given by -getOption("openxlsx.dateFormat", "mm/dd/yyyy") - -## this can be set via (for example) -options("openxlsx.dateFormat" = "yyyy/mm/dd") -## custom date formats can be made up of any combination of: -## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy - -## numFmt == "DATE" will use the date format specified by the above -addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) - -## some custom date format examples -sty <- createStyle(numFmt = "yyyy/mm/dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) - -sty <- createStyle(numFmt = "yyyy/mmm/dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) - -sty <- createStyle(numFmt = "yy / mmmm / dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) - -sty <- createStyle(numFmt = "ddddd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) - -sty <- createStyle(numFmt = "yyyy-mmm-dd") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) - -sty <- createStyle(numFmt = "mm/ dd yyyy") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) - -sty <- createStyle(numFmt = "mm/dd/yy") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) - -setColWidths(wb, 1, cols = 1:10, widths = 23) - -## The default date format used in writeData and writeDataTable can be set with: -options("openxlsx.dateFormat" = "dd/mm/yyyy") -writeData(wb, "Date Formatting", dates, startRow = 8, borders = "rows") -options("openxlsx.dateFormat" = "yyyy-mm-dd") -writeData(wb, "Date Formatting", dates, startRow = 15) - -saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE) - -``` - -## DateTime Formatting - -The conversion from POSIX to Excel datetimes is dependent on the timezone you are in. -If POSIX values are being written incorrectly, try setting the timezone with (for example) - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -Sys.setenv(TZ = "Australia/Sydney") - -dateTimes <- data.frame("d1" = Sys.time() - 0:4*10000) -for(i in 1:2) dateTimes <- cbind(dateTimes, dateTimes) -names(dateTimes) <- paste0("d", 1:4) - -## POSIX Formatting -wb <- createWorkbook() -addWorksheet(wb, "DateTime Formatting", gridLines = FALSE) -writeData(wb, 1, dateTimes) ## write without styling - -## openxlsx converts columns of class "POSIxt" to Excel datetimes with the format given by -getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss") - -## this can be set via (for example) -options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -## custom datetime formats can be made up of any combination of: -## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM - -## numFmt == "LONGDATE" will use the date format specified by the above -long_date_style <- createStyle(numFmt = "LONGDATE") -addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE) - -## some custom date format examples -sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) - -sty <- createStyle(numFmt = "hh:mm:ss AM/PM") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) - -sty <- createStyle(numFmt = "hh:mm:ss") -addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) - -setColWidths(wb, 1, cols = 1:4, widths = 30) - -## The default date format used in writeData and writeDataTable can be set with: -options("openxlsx.datetimeFormat" = "yyyy/mm/dd hh:mm:ss") -writeData(wb, "DateTime Formatting", dateTimes, startRow = 8, borders = "rows") - -options("openxlsx.datetimeFormat" = "hh:mm:ss AM/PM") -writeDataTable(wb, "DateTime Formatting", dateTimes, startRow = 15) - -saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE) -openXL("DateTime Formatting.xlsx") - -``` - -## Conditional Formatting - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -wb <- createWorkbook() -addWorksheet(wb, "cellIs") -addWorksheet(wb, "Moving Row") -addWorksheet(wb, "Moving Col") -addWorksheet(wb, "Dependent on 1") -addWorksheet(wb, "Duplicates") -addWorksheet(wb, "containsText") -addWorksheet(wb, "colourScale", zoom = 30) -addWorksheet(wb, "databar") - -negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") -posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") - -## rule applies to all each cell in range -writeData(wb, "cellIs", -5:5) -writeData(wb, "cellIs", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="!=0", style = negStyle) -conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="==0", style = posStyle) - -## highlight row dependent on first cell in row -writeData(wb, "Moving Row", -5:5) -writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1<0", style = negStyle) -conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1>0", style = posStyle) - -## highlight column dependent on first cell in column -writeData(wb, "Moving Col", -5:5) -writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1<0", style = negStyle) -conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1>0", style = posStyle) - -## highlight entire range cols X rows dependent only on cell A1 -writeData(wb, "Dependent on 1", -5:5) -writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) -conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1<0", style = negStyle) -conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1>0", style = posStyle) - -## highlight duplicates using default style -writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) -conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") - -## cells containing text -fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") -writeData(wb, "containsText", sapply(1:10, fn)) -conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") - -## colourscale colours cells based on cell value -df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4) -writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame - -## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) -## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. -conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), - style = c("black", "white"), - rule = c(0, 255), - type = "colourScale") - -setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) -setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) - -## Databars -writeData(wb, "databar", -5:5) -conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours - -saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) - -openXL(wb) - -``` - - - -## Numeric Formatting - - -numeric columns styling can be set using the numFmt parameter in createStyle or a default can be -set with, for example, options("openxlsx.numFmt" = "#,#0.00") - - -```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} - -options("openxlsx.numFmt" = NULL) -wb <- createWorkbook() -addWorksheet(wb, "Sheet 1") -df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5)) ## data.frame to write -df[ ,6:7] <- df[ ,6:7]*1E6 - -## Set column 1 class to "comma" to get comma separated thousands -class(df$X1) <- "comma" - -writeData(wb, 1, df) -s <- createStyle(numFmt = "0.0") -addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE) - -s <- createStyle(numFmt = "0.00") -addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE) - -s <- createStyle(numFmt = "0.000") -addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE) - -s <- createStyle(numFmt = "#,##0") -addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE) - -s <- createStyle(numFmt = "#,##0.00") -addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE) - -s <- createStyle(numFmt = "$ #,##0.00") -addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE) - -## set a default number format for numeric columns of data.frames -options("openxlsx.numFmt" = "$* #,#0.00") -writeData(wb, 1, x = data.frame("Using Default Options" = rep(2345.1235, 5)), startCol = 9) - -setColWidths(wb, 1, cols = 1:10, widths = 15) - -## Using default numFmt to round to 2 dp (Any numeric column will be affected) -addWorksheet(wb, "Sheet 2") -df <- iris; df[, 1:4] <- df[1:4] + runif(1) -writeDataTable(wb, sheet = 2, x = df) -writeData(wb, sheet = 2, x = df, startCol = 7) -writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows") - -## To stop auto-formatting numerics set -options("openxlsx.numFmt" = NULL) -addWorksheet(wb, "Sheet 3") -writeDataTable(wb, sheet = 3, x = df) - -openXL(wb) -``` - - +--- +title: "Formating with xlsx" +author: "Alexander Walker, Philipp Schauberger" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Formating with xlsx} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + +## Formatting with writeData and writeDataTable + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +## data.frame to write +df <- data.frame("Date" = Sys.Date()-0:4, + "Logical" = c(TRUE, FALSE, TRUE, TRUE, FALSE), + "Currency" = paste("$",-2:2), + "Accounting" = -2:2, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(-1, 1, length.out=5), + "TinyNumber" = runif(5) / 1E9, stringsAsFactors = FALSE) + +class(df$Currency) <- "currency" +class(df$Accounting) <- "accounting" +class(df$hLink) <- "hyperlink" +class(df$Percentage) <- "percentage" +class(df$TinyNumber) <- "scientific" + +## Formatting can be applied simply through the write functions +## global options can be set to further simplify things +options("openxlsx.borderStyle" = "thin") +options("openxlsx.borderColour" = "#4F81BD") + +## create a workbook and add a worksheet +wb <- createWorkbook() +addWorksheet(wb, "writeData auto-formatting") + +writeData(wb, 1, df, startRow = 2, startCol = 2) +writeData(wb, 1, df, startRow = 9, startCol = 2, borders = "surrounding") +writeData(wb, 1, df, startRow = 16, startCol = 2, borders = "rows") +writeData(wb, 1, df, startRow = 23, startCol = 2, borders ="columns") +writeData(wb, 1, df, startRow = 30, startCol = 2, borders ="all") + +## headerStyles +hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold", + border = "Bottom", fontColour = "white") + +writeData(wb, 1, df, startRow = 16, startCol = 10, headerStyle = hs1, + borders = "rows", borderStyle = "medium") + +## to change the display text for a hyperlink column just write over those cells +writeData(wb, sheet = 1, x = paste("Hyperlink", 1:5), startRow = 17, startCol = 14) + + +## writing as an Excel Table + +addWorksheet(wb, "writeDataTable") +writeDataTable(wb, 2, df, startRow = 2, startCol = 2) +writeDataTable(wb, 2, df, startRow = 9, startCol = 2, tableStyle = "TableStyleLight9") +writeDataTable(wb, 2, df, startRow = 16, startCol = 2, tableStyle = "TableStyleLight2") +writeDataTable(wb, 2, df, startRow = 23, startCol = 2, tableStyle = "TableStyleMedium21") + +openXL(wb) ## opens a temp version +``` + + +## Use of pre-defined table styles + +The 'tableStyle' argument in writeDataTable can be any of the predefined tableStyles in Excel. + +![](tableStyles.PNG) + +## Date Formatting + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +# data.frame of dates +dates <- data.frame("d1" = Sys.Date() - 0:4) +for(i in 1:3) dates <- cbind(dates, dates) +names(dates) <- paste0("d", 1:8) + +## Date Formatting +wb <- createWorkbook() +addWorksheet(wb, "Date Formatting", gridLines = FALSE) +writeData(wb, 1, dates) ## write without styling + +## openxlsx converts columns of class "Date" to Excel dates with the format given by +getOption("openxlsx.dateFormat", "mm/dd/yyyy") + +## this can be set via (for example) +options("openxlsx.dateFormat" = "yyyy/mm/dd") +## custom date formats can be made up of any combination of: +## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy + +## numFmt == "DATE" will use the date format specified by the above +addStyle(wb, 1, style = createStyle(numFmt = "DATE"), rows = 2:11, cols = 1, gridExpand = TRUE) + +## some custom date format examples +sty <- createStyle(numFmt = "yyyy/mm/dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) + +sty <- createStyle(numFmt = "yyyy/mmm/dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) + +sty <- createStyle(numFmt = "yy / mmmm / dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) + +sty <- createStyle(numFmt = "ddddd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 5, gridExpand = TRUE) + +sty <- createStyle(numFmt = "yyyy-mmm-dd") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 6, gridExpand = TRUE) + +sty <- createStyle(numFmt = "mm/ dd yyyy") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 7, gridExpand = TRUE) + +sty <- createStyle(numFmt = "mm/dd/yy") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 8, gridExpand = TRUE) + +setColWidths(wb, 1, cols = 1:10, widths = 23) + +## The default date format used in writeData and writeDataTable can be set with: +options("openxlsx.dateFormat" = "dd/mm/yyyy") +writeData(wb, "Date Formatting", dates, startRow = 8, borders = "rows") +options("openxlsx.dateFormat" = "yyyy-mm-dd") +writeData(wb, "Date Formatting", dates, startRow = 15) + +saveWorkbook(wb, "Date Formatting.xlsx", overwrite = TRUE) + +``` + +## DateTime Formatting + +The conversion from POSIX to Excel datetimes is dependent on the timezone you are in. +If POSIX values are being written incorrectly, try setting the timezone with (for example) + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +Sys.setenv(TZ = "Australia/Sydney") + +dateTimes <- data.frame("d1" = Sys.time() - 0:4*10000) +for(i in 1:2) dateTimes <- cbind(dateTimes, dateTimes) +names(dateTimes) <- paste0("d", 1:4) + +## POSIX Formatting +wb <- createWorkbook() +addWorksheet(wb, "DateTime Formatting", gridLines = FALSE) +writeData(wb, 1, dateTimes) ## write without styling + +## openxlsx converts columns of class "POSIxt" to Excel datetimes with the format given by +getOption("openxlsx.datetimeFormat", "yyyy/mm/dd hh:mm:ss") + +## this can be set via (for example) +options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +## custom datetime formats can be made up of any combination of: +## d, dd, ddd, dddd, m, mm, mmm, mmmm, mmmmm, yy, yyyy, h, hh, m, mm, s, ss, AM/PM + +## numFmt == "LONGDATE" will use the date format specified by the above +long_date_style <- createStyle(numFmt = "LONGDATE") +addStyle(wb, 1, style = long_date_style, rows = 2:11, cols = 1, gridExpand = TRUE) + +## some custom date format examples +sty <- createStyle(numFmt = "yyyy/mm/dd hh:mm:ss AM/PM") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 2, gridExpand = TRUE) + +sty <- createStyle(numFmt = "hh:mm:ss AM/PM") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 3, gridExpand = TRUE) + +sty <- createStyle(numFmt = "hh:mm:ss") +addStyle(wb, 1, style = sty, rows = 2:11, cols = 4, gridExpand = TRUE) + +setColWidths(wb, 1, cols = 1:4, widths = 30) + +## The default date format used in writeData and writeDataTable can be set with: +options("openxlsx.datetimeFormat" = "yyyy/mm/dd hh:mm:ss") +writeData(wb, "DateTime Formatting", dateTimes, startRow = 8, borders = "rows") + +options("openxlsx.datetimeFormat" = "hh:mm:ss AM/PM") +writeDataTable(wb, "DateTime Formatting", dateTimes, startRow = 15) + +saveWorkbook(wb, "DateTime Formatting.xlsx", overwrite = TRUE) +openXL("DateTime Formatting.xlsx") + +``` + +## Conditional Formatting + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +wb <- createWorkbook() +addWorksheet(wb, "cellIs") +addWorksheet(wb, "Moving Row") +addWorksheet(wb, "Moving Col") +addWorksheet(wb, "Dependent on 1") +addWorksheet(wb, "Duplicates") +addWorksheet(wb, "containsText") +addWorksheet(wb, "colourScale", zoom = 30) +addWorksheet(wb, "databar") + +negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE") +posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE") + +## rule applies to all each cell in range +writeData(wb, "cellIs", -5:5) +writeData(wb, "cellIs", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="!=0", style = negStyle) +conditionalFormatting(wb, "cellIs", cols=1, rows=1:11, rule="==0", style = posStyle) + +## highlight row dependent on first cell in row +writeData(wb, "Moving Row", -5:5) +writeData(wb, "Moving Row", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1<0", style = negStyle) +conditionalFormatting(wb, "Moving Row", cols=1:2, rows=1:11, rule="$A1>0", style = posStyle) + +## highlight column dependent on first cell in column +writeData(wb, "Moving Col", -5:5) +writeData(wb, "Moving Col", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1<0", style = negStyle) +conditionalFormatting(wb, "Moving Col", cols=1:2, rows=1:11, rule="A$1>0", style = posStyle) + +## highlight entire range cols X rows dependent only on cell A1 +writeData(wb, "Dependent on 1", -5:5) +writeData(wb, "Dependent on 1", LETTERS[1:11], startCol=2) +conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1<0", style = negStyle) +conditionalFormatting(wb, "Dependent on 1", cols=1:2, rows=1:11, rule="$A$1>0", style = posStyle) + +## highlight duplicates using default style +writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE)) +conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates") + +## cells containing text +fn <- function(x) paste(sample(LETTERS, 10), collapse = "-") +writeData(wb, "containsText", sapply(1:10, fn)) +conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A") + +## colourscale colours cells based on cell value +df <- read.xlsx(system.file("readTest.xlsx", package = "openxlsx"), sheet = 4) +writeData(wb, "colourScale", df, colNames=FALSE) ## write data.frame + +## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours()) +## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL. +conditionalFormatting(wb, "colourScale", cols=1:ncol(df), rows=1:nrow(df), + style = c("black", "white"), + rule = c(0, 255), + type = "colourScale") + +setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07) +setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5) + +## Databars +writeData(wb, "databar", -5:5) +conditionalFormatting(wb, "databar", cols = 1, rows = 1:12, type = "databar") ## Default colours + +saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE) + +openXL(wb) + +``` + + + +## Numeric Formatting + + +numeric columns styling can be set using the numFmt parameter in createStyle or a default can be +set with, for example, options("openxlsx.numFmt" = "#,#0.00") + + +```{r include=TRUE,tidy=TRUE, eval = FALSE,highlight=TRUE} + +options("openxlsx.numFmt" = NULL) +wb <- createWorkbook() +addWorksheet(wb, "Sheet 1") +df <- data.frame(matrix(12.987654321, ncol = 7, nrow = 5)) ## data.frame to write +df[ ,6:7] <- df[ ,6:7]*1E6 + +## Set column 1 class to "comma" to get comma separated thousands +class(df$X1) <- "comma" + +writeData(wb, 1, df) +s <- createStyle(numFmt = "0.0") +addStyle(wb, 1, style = s, rows = 2:6, cols = 2, gridExpand = TRUE) + +s <- createStyle(numFmt = "0.00") +addStyle(wb, 1, style = s, rows = 2:6, cols = 3, gridExpand = TRUE) + +s <- createStyle(numFmt = "0.000") +addStyle(wb, 1, style = s, rows = 2:6, cols = 4, gridExpand = TRUE) + +s <- createStyle(numFmt = "#,##0") +addStyle(wb, 1, style = s, rows = 2:6, cols = 5, gridExpand = TRUE) + +s <- createStyle(numFmt = "#,##0.00") +addStyle(wb, 1, style = s, rows = 2:6, cols = 6, gridExpand = TRUE) + +s <- createStyle(numFmt = "$ #,##0.00") +addStyle(wb, 1, style = s, rows = 2:6, cols = 7, gridExpand = TRUE) + +## set a default number format for numeric columns of data.frames +options("openxlsx.numFmt" = "$* #,#0.00") +writeData(wb, 1, x = data.frame("Using Default Options" = rep(2345.1235, 5)), startCol = 9) + +setColWidths(wb, 1, cols = 1:10, widths = 15) + +## Using default numFmt to round to 2 dp (Any numeric column will be affected) +addWorksheet(wb, "Sheet 2") +df <- iris; df[, 1:4] <- df[1:4] + runif(1) +writeDataTable(wb, sheet = 2, x = df) +writeData(wb, sheet = 2, x = df, startCol = 7) +writeData(wb, sheet = 2, x = df, startCol = 13, borders = "rows") + +## To stop auto-formatting numerics set +options("openxlsx.numFmt" = NULL) +addWorksheet(wb, "Sheet 3") +writeDataTable(wb, sheet = 3, x = df) + +openXL(wb) +``` + + diff -Nru r-cran-openxlsx-4.2.4/vignettes/Introduction.Rmd r-cran-openxlsx-4.2.5/vignettes/Introduction.Rmd --- r-cran-openxlsx-4.2.4/vignettes/Introduction.Rmd 2021-05-07 13:24:11.000000000 +0000 +++ r-cran-openxlsx-4.2.5/vignettes/Introduction.Rmd 2021-12-13 08:14:44.000000000 +0000 @@ -1,510 +1,510 @@ ---- -title: "Introduction" -author: "Alexander Walker, Philipp Schauberger" -date: "`r Sys.Date()`" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{Introduction} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -## Basic Examples - - -### write.xlsx - -The simplest way to write to a workbook is write.xlsx(). -By default, write.xlsx calls writeData. If asTable is TRUE write.xlsx will write x as -an Excel table. - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -## write to working directory -library(openxlsx) -write.xlsx(iris, file = "writeXLSX1.xlsx") -write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE) -``` - -### write list of data.frames to xlsx-file - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -## write a list of data.frames to individual worksheets using list names as worksheet names -l <- list("IRIS" = iris, "MTCARS" = mtcars) -write.xlsx(l, file = "writeXLSX2.xlsx") -write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE) -``` - - -### write.xlsx also accepts styling parameters - - -#### The simplest way is to set default options and set column class - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -options("openxlsx.borderColour" = "#4F80BD") -options("openxlsx.borderStyle" = "thin") -options("openxlsx.dateFormat" = "mm/dd/yyyy") -options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") -options("openxlsx.numFmt" = NULL) ## For default style rounding of numeric columns - -df <- data.frame("Date" = Sys.Date()-0:19, "LogicalT" = TRUE, - "Time" = Sys.time()-0:19*60*60, - "Cash" = paste("$",1:20), "Cash2" = 31:50, - "hLink" = "https://CRAN.R-project.org/", - "Percentage" = seq(0, 1, length.out=20), - "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE) - -class(df$Cash) <- "currency" -class(df$Cash2) <- "accounting" -class(df$hLink) <- "hyperlink" -class(df$Percentage) <- "percentage" -class(df$TinyNumbers) <- "scientific" - -write.xlsx(df, "writeXLSX3.xlsx") -write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE) - - -``` - - -## Workbook styles - -### define a style for column headers -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", - halign = "center", valign = "center", textDecoration = "Bold", - border = "TopBottomLeftRight", textRotation = 45) - -write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs) -write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs) - -write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, -headerStyle = createStyle(textRotation = 45)) - - -``` - -### When writing a list, the stylings will apply to all list elements -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -l <- list("IRIS" = iris, "colClasses" = df) -write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs) -write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2") - -openXL("writeXLSX6.xlsx") -openXL("writeXLSXTable5.xlsx") -``` - - -### write.xlsx returns the workbook object for further editing -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -wb <- write.xlsx(iris, "writeXLSX6.xlsx") -setColWidths(wb, sheet = 1, cols = 1:5, widths = 20) -saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE) -``` - - - -## Workbook creation walk-through - -### create workbook and set default border Colour and style - - - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -require(ggplot2) -wb <- createWorkbook() -options("openxlsx.borderColour" = "#4F80BD") -options("openxlsx.borderStyle" = "thin") -modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow") -``` - - -### Add Sheets - - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE) -addWorksheet(wb, sheetName = "Iris", gridLines = FALSE) -``` - - -### write data to sheet 1 - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE) ## freeze first row and column -writeDataTable(wb, sheet = 1, x = mtcars, -colNames = TRUE, rowNames = TRUE, -tableStyle = "TableStyleLight9") - -setColWidths(wb, sheet = 1, cols = "A", widths = 18) -``` - - -### write data to sheet 2 - -iris data.frame is added as excel table on sheet 2. - -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2) - -qplot(data=iris, x = Sepal.Length, y= Sepal.Width, colour = Species) -insertPlot(wb, 2, xy=c("B", 16)) ## insert plot at cell B16 - -means <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = mean) -vars <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = var) -``` - - -### add write group means -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -headSty <- createStyle(fgFill="#DCE6F1", halign="center", border = "TopBottomLeftRight") -writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2) -writeData(wb, 2, x = means, startCol = "B", startRow=3, borders="rows", headerStyle = headSty) -``` -### add write group variances -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9) -writeData(wb, 2, x= vars, startCol = "B", startRow=10, borders="columns", -headerStyle = headSty) - -setColWidths(wb, 2, cols=2:6, widths = 12) ## width is recycled for each col -setColWidths(wb, 2, cols=11:15, widths = 15) -``` - - -### add style mean & variance table headers -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic")) -addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2)) -``` - - -### save workbook -```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory -``` - - -## Gallery - -```{r eval=FALSE, include=TRUE} -## inspired by xtable gallery -#https://CRAN.R-project.org/package=xtable/vignettes/xtableGallery.pdf - -## Create a new workbook -wb <- createWorkbook() -data(tli, package = "xtable") - -## data.frame -test.n <- "data.frame" -my.df <- tli[1:10, ] -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.df, borders = "n") - -## matrix -test.n <- "matrix" -design.matrix <- model.matrix(~ sex * grade, data = my.df) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = design.matrix) - -## aov -test.n <- "aov" -fm1 <- aov(tlimth ~ sex + ethnicty + grade + disadvg, data = tli) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = fm1) - -## lm -test.n <- "lm" -fm2 <- lm(tlimth ~ sex*ethnicty, data = tli) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = fm2) - -## anova 1 -test.n <- "anova" -my.anova <- anova(fm2) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.anova) - -## anova 2 -test.n <- "anova2" -fm2b <- lm(tlimth ~ ethnicty, data = tli) -my.anova2 <- anova(fm2b, fm2) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.anova2) - -## glm -test.n <- "glm" -fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial()) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = fm3) - -## prcomp -test.n <- "prcomp" -pr1 <- prcomp(USArrests) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = pr1) - -## summary.prcomp -test.n <- "summary.prcomp" -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = summary(pr1)) - -## simple table -test.n <- "table" -data(airquality) -airquality$OzoneG80 <- factor(airquality$Ozone > 80, -levels = c(FALSE, TRUE), -labels = c("Oz <= 80", "Oz > 80")) -airquality$Month <- factor(airquality$Month, -levels = 5:9, -labels = month.abb[5:9]) -my.table <- with(airquality, table(OzoneG80,Month) ) -addWorksheet(wb = wb, sheetName = test.n) -writeData(wb = wb, sheet = test.n, x = my.table) - -## survdiff 1 -library(survival) -test.n <- "survdiff1" -addWorksheet(wb = wb, sheetName = test.n) -x <- survdiff(Surv(futime, fustat) ~ rx, data = ovarian) -writeData(wb = wb, sheet = test.n, x = x) - -## survdiff 2 -test.n <- "survdiff2" -addWorksheet(wb = wb, sheetName = test.n) -expect <- survexp(futime ~ ratetable(age=(accept.dt - birth.dt), - sex=1,year=accept.dt,race="white"), jasa, cohort=FALSE, - ratetable=survexp.usr) -x <- survdiff(Surv(jasa$futime, jasa$fustat) ~ offset(expect)) -writeData(wb = wb, sheet = test.n, x = x) - -## coxph 1 -test.n <- "coxph1" -addWorksheet(wb = wb, sheetName = test.n) -bladder$rx <- factor(bladder$rx, labels = c("Pla","Thi")) -x <- coxph(Surv(stop,event) ~ rx, data = bladder) -writeData(wb = wb, sheet = test.n, x = x) - -## coxph 2 -test.n <- "coxph2" -addWorksheet(wb = wb, sheetName = test.n) -x <- coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder) -writeData(wb = wb, sheet = test.n, x = x) - -## cox.zph -test.n <- "cox.zph" -addWorksheet(wb = wb, sheetName = test.n) -x <- cox.zph(coxph(Surv(futime, fustat) ~ age + ecog.ps, data=ovarian)) -writeData(wb = wb, sheet = test.n, x = x) - -## summary.coxph 1 -test.n <- "summary.coxph1" -addWorksheet(wb = wb, sheetName = test.n) -x <- summary(coxph(Surv(stop,event) ~ rx, data = bladder)) -writeData(wb = wb, sheet = test.n, x = x) - -## summary.coxph 2 -test.n <- "summary.coxph2" -addWorksheet(wb = wb, sheetName = test.n) -x <- summary(coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder)) -writeData(wb = wb, sheet = test.n, x = x) - -## view without saving -openXL(wb) - -``` - -## Further Examples - -### Stock Price - -```{r eval=FALSE, include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} -require(ggplot2) - -wb <- createWorkbook() - -## read historical prices from yahoo finance -ticker <- "CBA.AX" -csv.url <- paste("http://ichart.finance.yahoo.com/table.csv?s=", -ticker, "&a=01&b=9&c=2009&d=01&e=9&f=2014&g=d&ignore=.csv") -prices <- read.csv(url(csv.url), as.is = TRUE) -prices$Date <- as.Date(prices$Date) -close <- prices$Close -prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close)-1)])) - -## Create plot of price series and add to worksheet -ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + -geom_line(colour="royalblue2") + -labs(x = "Date", y = "Price", title = ticker) + -geom_area(fill = "royalblue1",alpha = 0.3) + -coord_cartesian(ylim=c(min(prices$Close)-1.5, max(prices$Close)+1.5)) - -## Add worksheet and write plot to sheet -addWorksheet(wb, sheetName = "CBA") -insertPlot(wb, sheet = 1, xy = c("J", 3)) - -## Histogram of log returns -ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth=0.0025) + -labs(title = "Histogram of log returns") - -## currency -class(prices$Close) <- "currency" ## styles as currency in workbook - -## write historical data and histogram of returns -writeDataTable(wb, sheet = "CBA", x = prices) -insertPlot(wb, sheet = 1, startRow=25, startCol = "J") - -## Add conditional formatting to show where logReturn > 0.01 using default style -conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices)+1), -rule = "$H2 > 0.01") - -## style log return col as a percentage -logRetStyle <- createStyle(numFmt = "percentage") - -addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), -cols = "H", gridExpand = TRUE) - -setColWidths(wb, sheet=1, cols = c("A", "F", "G", "H"), widths = 15) - -## save workbook to working directory -saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE) -openXL("stockPrice.xlsx") -``` - - -### Image Compression using PCA - - -```{r eval=FALSE, include=TRUE} -require(openxlsx) -require(jpeg) -require(ggplot2) - -plotFn <- function(x, ...){ - colvec <- grey(x) - colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2]) - image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]), - col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1, - bty ="n", frame.plot=F, ann=FALSE) -} - -## Create workbook and add a worksheet, hide gridlines -wb <- createWorkbook("Einstein") -addWorksheet(wb, "Original Image", gridLines = FALSE) - -A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg")) -height <- nrow(A); width <- ncol(A) - -## write "Original Image" to cell B2 -writeData(wb, 1, "Original Image", xy = c(2,2)) - -## write Object size to cell B3 -writeData(wb, 1, sprintf("Image object size: %s bytes", - format(object.size(A+0)[[1]], big.mark=',')), - xy = c(2,3)) ## equivalent to startCol = 2, startRow = 3 - -## Plot image -par(mar=rep(0, 4), xpd = NA); plotFn(A) - -## insert plot currently showing in plot window -insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2) - -## SVD of covariance matrix -rMeans <- rowMeans(A) -rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans)) -A <- A - rowMeans -E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A -pve <- data.frame("Eigenvalues" = E$d, - "PVE" = E$d/sum(E$d), - "Cumulative PVE" = cumsum(E$d/sum(E$d))) - -## write eigenvalues to worksheet -addWorksheet(wb, "Principal Component Analysis") -hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", - halign = "CENTER", textDecoration = "Bold", - border = "TopBottomLeftRight", borderColour = "#4F81BD") - -writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2) -mergeCells(wb, sheet=2, cols=1:4, rows=2) - -setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15)) -writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs) - -## Plots -pve <- cbind(pve, "Ind" = 1:nrow(pve)) -ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) + - geom_bar(stat="identity", position = "dodge") + - xlab("Principal Component Index") + ylab("Proportion of Variance Explained") + - geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue") - -## Write plot to worksheet 2 -insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) - -## Plot of cumulative explained variance -ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) + - geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") + - ylab("Cumulative Proportion of Variance Explained") -insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) - - -## Reconstruct image using increasing number of PCs -nPCs <- c(5, 7, 12, 20, 50, 200) -startRow <- rep(c(2, 24), each = 3) -startCol <- rep(c("B", "H", "N"), 2) - -## create a worksheet to save reconstructed images to -addWorksheet(wb, "Reconstructed Images", zoom = 90) - -for(i in 1:length(nPCs)){ - - V <- E$v[, 1:nPCs[i]] - imgHat <- t(V) %*% A ## project img data on to PCs - imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans) - - imgHat <- V %*% imgHat + rowMeans ## reconstruct from PCs and add back row means - imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale - plotFn(imgHat/255) - - ## write strings to worksheet 3 - writeData(wb, "Reconstructed Images", - sprintf("Number of principal components used: %s", - nPCs[[i]]), startCol[i], startRow[i]) - - writeData(wb, "Reconstructed Images", - sprintf("Sum of component object sizes: %s bytes", - format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1) - - ## write reconstruced image - insertPlot(wb, "Reconstructed Images", width, height, units="px", - xy = c(startCol[i], startRow[i]+3)) - -} - -# hide grid lines -showGridLines(wb, sheet = 3, showGridLines = FALSE) - -## Make text above images BOLD -boldStyle <- createStyle(textDecoration="BOLD") - -## only want to apply style to specified cells (not all combinations of rows & cols) -addStyle(wb, "Reconstructed Images", style=boldStyle, - rows = c(startRow, startRow+1), cols = rep(startCol, 2), - gridExpand = FALSE) - -## save workbook to working directory -saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) - - - - -## remove example files for cran test -if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) { -file_list<-list.files(pattern="\\.xlsx",recursive = T) -file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)] - -if(length(file_list)>0){ -rm(file_list) -} - -``` - +--- +title: "Introduction" +author: "Alexander Walker, Philipp Schauberger" +date: "`r Sys.Date()`" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Introduction} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +## Basic Examples + + +### write.xlsx + +The simplest way to write to a workbook is write.xlsx(). +By default, write.xlsx calls writeData. If asTable is TRUE write.xlsx will write x as +an Excel table. + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +## write to working directory +library(openxlsx) +write.xlsx(iris, file = "writeXLSX1.xlsx") +write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = TRUE) +``` + +### write list of data.frames to xlsx-file + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +## write a list of data.frames to individual worksheets using list names as worksheet names +l <- list("IRIS" = iris, "MTCARS" = mtcars) +write.xlsx(l, file = "writeXLSX2.xlsx") +write.xlsx(l, file = "writeXLSXTable2.xlsx", asTable = TRUE) +``` + + +### write.xlsx also accepts styling parameters + + +#### The simplest way is to set default options and set column class + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +options("openxlsx.borderColour" = "#4F80BD") +options("openxlsx.borderStyle" = "thin") +options("openxlsx.dateFormat" = "mm/dd/yyyy") +options("openxlsx.datetimeFormat" = "yyyy-mm-dd hh:mm:ss") +options("openxlsx.numFmt" = NULL) ## For default style rounding of numeric columns + +df <- data.frame("Date" = Sys.Date()-0:19, "LogicalT" = TRUE, + "Time" = Sys.time()-0:19*60*60, + "Cash" = paste("$",1:20), "Cash2" = 31:50, + "hLink" = "https://CRAN.R-project.org/", + "Percentage" = seq(0, 1, length.out=20), + "TinyNumbers" = runif(20) / 1E9, stringsAsFactors = FALSE) + +class(df$Cash) <- "currency" +class(df$Cash2) <- "accounting" +class(df$hLink) <- "hyperlink" +class(df$Percentage) <- "percentage" +class(df$TinyNumbers) <- "scientific" + +write.xlsx(df, "writeXLSX3.xlsx") +write.xlsx(df, file = "writeXLSXTable3.xlsx", asTable = TRUE) + + +``` + + +## Workbook styles + +### define a style for column headers +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", + halign = "center", valign = "center", textDecoration = "Bold", + border = "TopBottomLeftRight", textRotation = 45) + +write.xlsx(iris, file = "writeXLSX4.xlsx", borders = "rows", headerStyle = hs) +write.xlsx(iris, file = "writeXLSX5.xlsx", borders = "columns", headerStyle = hs) + +write.xlsx(iris, "writeXLSXTable4.xlsx", asTable = TRUE, +headerStyle = createStyle(textRotation = 45)) + + +``` + +### When writing a list, the stylings will apply to all list elements +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +l <- list("IRIS" = iris, "colClasses" = df) +write.xlsx(l, file = "writeXLSX6.xlsx", borders = "columns", headerStyle = hs) +write.xlsx(l, file = "writeXLSXTable5.xlsx", asTable = TRUE, tableStyle = "TableStyleLight2") + +openXL("writeXLSX6.xlsx") +openXL("writeXLSXTable5.xlsx") +``` + + +### write.xlsx returns the workbook object for further editing +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +wb <- write.xlsx(iris, "writeXLSX6.xlsx") +setColWidths(wb, sheet = 1, cols = 1:5, widths = 20) +saveWorkbook(wb, "writeXLSX6.xlsx", overwrite = TRUE) +``` + + + +## Workbook creation walk-through + +### create workbook and set default border Colour and style + + + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +require(ggplot2) +wb <- createWorkbook() +options("openxlsx.borderColour" = "#4F80BD") +options("openxlsx.borderStyle" = "thin") +modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow") +``` + + +### Add Sheets + + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE) +addWorksheet(wb, sheetName = "Iris", gridLines = FALSE) +``` + + +### write data to sheet 1 + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +freezePane(wb, sheet = 1, firstRow = TRUE, firstCol = TRUE) ## freeze first row and column +writeDataTable(wb, sheet = 1, x = mtcars, +colNames = TRUE, rowNames = TRUE, +tableStyle = "TableStyleLight9") + +setColWidths(wb, sheet = 1, cols = "A", widths = 18) +``` + + +### write data to sheet 2 + +iris data.frame is added as excel table on sheet 2. + +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +writeDataTable(wb, sheet = 2, iris, startCol = "K", startRow = 2) + +qplot(data=iris, x = Sepal.Length, y= Sepal.Width, colour = Species) +insertPlot(wb, 2, xy=c("B", 16)) ## insert plot at cell B16 + +means <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = mean) +vars <- aggregate(x = iris[,-5], by = list(iris$Species), FUN = var) +``` + + +### add write group means +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +headSty <- createStyle(fgFill="#DCE6F1", halign="center", border = "TopBottomLeftRight") +writeData(wb, 2, x = "Iris dataset group means", startCol = 2, startRow = 2) +writeData(wb, 2, x = means, startCol = "B", startRow=3, borders="rows", headerStyle = headSty) +``` +### add write group variances +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +writeData(wb, 2, x = "Iris dataset group variances", startCol = 2, startRow = 9) +writeData(wb, 2, x= vars, startCol = "B", startRow=10, borders="columns", +headerStyle = headSty) + +setColWidths(wb, 2, cols=2:6, widths = 12) ## width is recycled for each col +setColWidths(wb, 2, cols=11:15, widths = 15) +``` + + +### add style mean & variance table headers +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +s1 <- createStyle(fontSize=14, textDecoration=c("bold", "italic")) +addStyle(wb, 2, style = s1, rows=c(2,9), cols=c(2,2)) +``` + + +### save workbook +```{r include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory +``` + + +## Gallery + +```{r eval=FALSE, include=TRUE} +## inspired by xtable gallery +#https://CRAN.R-project.org/package=xtable/vignettes/xtableGallery.pdf + +## Create a new workbook +wb <- createWorkbook() +data(tli, package = "xtable") + +## data.frame +test.n <- "data.frame" +my.df <- tli[1:10, ] +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.df, borders = "n") + +## matrix +test.n <- "matrix" +design.matrix <- model.matrix(~ sex * grade, data = my.df) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = design.matrix) + +## aov +test.n <- "aov" +fm1 <- aov(tlimth ~ sex + ethnicty + grade + disadvg, data = tli) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = fm1) + +## lm +test.n <- "lm" +fm2 <- lm(tlimth ~ sex*ethnicty, data = tli) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = fm2) + +## anova 1 +test.n <- "anova" +my.anova <- anova(fm2) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.anova) + +## anova 2 +test.n <- "anova2" +fm2b <- lm(tlimth ~ ethnicty, data = tli) +my.anova2 <- anova(fm2b, fm2) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.anova2) + +## glm +test.n <- "glm" +fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial()) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = fm3) + +## prcomp +test.n <- "prcomp" +pr1 <- prcomp(USArrests) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = pr1) + +## summary.prcomp +test.n <- "summary.prcomp" +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = summary(pr1)) + +## simple table +test.n <- "table" +data(airquality) +airquality$OzoneG80 <- factor(airquality$Ozone > 80, +levels = c(FALSE, TRUE), +labels = c("Oz <= 80", "Oz > 80")) +airquality$Month <- factor(airquality$Month, +levels = 5:9, +labels = month.abb[5:9]) +my.table <- with(airquality, table(OzoneG80,Month) ) +addWorksheet(wb = wb, sheetName = test.n) +writeData(wb = wb, sheet = test.n, x = my.table) + +## survdiff 1 +library(survival) +test.n <- "survdiff1" +addWorksheet(wb = wb, sheetName = test.n) +x <- survdiff(Surv(futime, fustat) ~ rx, data = ovarian) +writeData(wb = wb, sheet = test.n, x = x) + +## survdiff 2 +test.n <- "survdiff2" +addWorksheet(wb = wb, sheetName = test.n) +expect <- survexp(futime ~ ratetable(age=(accept.dt - birth.dt), + sex=1,year=accept.dt,race="white"), jasa, cohort=FALSE, + ratetable=survexp.usr) +x <- survdiff(Surv(jasa$futime, jasa$fustat) ~ offset(expect)) +writeData(wb = wb, sheet = test.n, x = x) + +## coxph 1 +test.n <- "coxph1" +addWorksheet(wb = wb, sheetName = test.n) +bladder$rx <- factor(bladder$rx, labels = c("Pla","Thi")) +x <- coxph(Surv(stop,event) ~ rx, data = bladder) +writeData(wb = wb, sheet = test.n, x = x) + +## coxph 2 +test.n <- "coxph2" +addWorksheet(wb = wb, sheetName = test.n) +x <- coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder) +writeData(wb = wb, sheet = test.n, x = x) + +## cox.zph +test.n <- "cox.zph" +addWorksheet(wb = wb, sheetName = test.n) +x <- cox.zph(coxph(Surv(futime, fustat) ~ age + ecog.ps, data=ovarian)) +writeData(wb = wb, sheet = test.n, x = x) + +## summary.coxph 1 +test.n <- "summary.coxph1" +addWorksheet(wb = wb, sheetName = test.n) +x <- summary(coxph(Surv(stop,event) ~ rx, data = bladder)) +writeData(wb = wb, sheet = test.n, x = x) + +## summary.coxph 2 +test.n <- "summary.coxph2" +addWorksheet(wb = wb, sheetName = test.n) +x <- summary(coxph(Surv(stop,event) ~ rx + cluster(id), data = bladder)) +writeData(wb = wb, sheet = test.n, x = x) + +## view without saving +openXL(wb) + +``` + +## Further Examples + +### Stock Price + +```{r eval=FALSE, include=TRUE,tidy=TRUE, eval = FALSE ,highlight=TRUE} +require(ggplot2) + +wb <- createWorkbook() + +## read historical prices from yahoo finance +ticker <- "CBA.AX" +csv.url <- paste0("https://query1.finance.yahoo.com/v7/finance/download/", +ticker, "?period1=1597597610&period2=1629133610&interval=1d&events=history&includeAdjustedClose=true") +prices <- read.csv(url(csv.url), as.is = TRUE) +prices$Date <- as.Date(prices$Date) +close <- prices$Close +prices$logReturns = c(0, log(close[2:length(close)]/close[1:(length(close)-1)])) + +## Create plot of price series and add to worksheet +ggplot(data = prices, aes(as.Date(Date), as.numeric(Close))) + +geom_line(colour="royalblue2") + +labs(x = "Date", y = "Price", title = ticker) + +geom_area(fill = "royalblue1",alpha = 0.3) + +coord_cartesian(ylim=c(min(prices$Close)-1.5, max(prices$Close)+1.5)) + +## Add worksheet and write plot to sheet +addWorksheet(wb, sheetName = "CBA") +insertPlot(wb, sheet = 1, xy = c("J", 3)) + +## Histogram of log returns +ggplot(data = prices, aes(x = logReturns)) + geom_bar(binwidth=0.0025) + +labs(title = "Histogram of log returns") + +## currency +class(prices$Close) <- "currency" ## styles as currency in workbook + +## write historical data and histogram of returns +writeDataTable(wb, sheet = "CBA", x = prices) +insertPlot(wb, sheet = 1, startRow=25, startCol = "J") + +## Add conditional formatting to show where logReturn > 0.01 using default style +conditionalFormat(wb, sheet = 1, cols = 1:ncol(prices), rows = 2:(nrow(prices)+1), +rule = "$H2 > 0.01") + +## style log return col as a percentage +logRetStyle <- createStyle(numFmt = "percentage") + +addStyle(wb, 1, style = logRetStyle, rows = 2:(nrow(prices) + 1), +cols = "H", gridExpand = TRUE) + +setColWidths(wb, sheet=1, cols = c("A", "F", "G", "H"), widths = 15) + +## save workbook to working directory +saveWorkbook(wb, "stockPrice.xlsx", overwrite = TRUE) +openXL("stockPrice.xlsx") +``` + + +### Image Compression using PCA + + +```{r eval=FALSE, include=TRUE} +require(openxlsx) +require(jpeg) +require(ggplot2) + +plotFn <- function(x, ...){ + colvec <- grey(x) + colmat <- array(match(colvec, unique(colvec)), dim = dim(x)[1:2]) + image(x = 0:(dim(colmat)[2]), y = 0:(dim(colmat)[1]), z = t(colmat[nrow(colmat):1, ]), + col = unique(colvec), xlab = "", ylab = "", axes = FALSE, asp = 1, + bty ="n", frame.plot=F, ann=FALSE) +} + +## Create workbook and add a worksheet, hide gridlines +wb <- createWorkbook("Einstein") +addWorksheet(wb, "Original Image", gridLines = FALSE) + +A <- readJPEG(file.path(path.package("openxlsx"), "einstein.jpg")) +height <- nrow(A); width <- ncol(A) + +## write "Original Image" to cell B2 +writeData(wb, 1, "Original Image", xy = c(2,2)) + +## write Object size to cell B3 +writeData(wb, 1, sprintf("Image object size: %s bytes", + format(object.size(A+0)[[1]], big.mark=',')), + xy = c(2,3)) ## equivalent to startCol = 2, startRow = 3 + +## Plot image +par(mar=rep(0, 4), xpd = NA); plotFn(A) + +## insert plot currently showing in plot window +insertPlot(wb, 1, width, height, units="px", startRow= 5, startCol = 2) + +## SVD of covariance matrix +rMeans <- rowMeans(A) +rowMeans <- do.call("cbind", lapply(1:ncol(A), function(X) rMeans)) +A <- A - rowMeans +E <- svd(A %*% t(A) / (ncol(A) - 1)) # SVD on covariance matrix of A +pve <- data.frame("Eigenvalues" = E$d, + "PVE" = E$d/sum(E$d), + "Cumulative PVE" = cumsum(E$d/sum(E$d))) + +## write eigenvalues to worksheet +addWorksheet(wb, "Principal Component Analysis") +hs <- createStyle(fontColour = "#ffffff", fgFill = "#4F80BD", + halign = "CENTER", textDecoration = "Bold", + border = "TopBottomLeftRight", borderColour = "#4F81BD") + +writeData(wb, 2, x="Proportions of variance explained by Eigenvector" ,startRow = 2) +mergeCells(wb, sheet=2, cols=1:4, rows=2) + +setColWidths(wb, 2, cols = 1:3, widths = c(14, 12, 15)) +writeData(wb, 2, x=pve, startRow = 3, startCol = 1, borders="rows", headerStyle=hs) + +## Plots +pve <- cbind(pve, "Ind" = 1:nrow(pve)) +ggplot(data = pve[1:20,], aes(x = Ind, y = 100*PVE)) + + geom_bar(stat="identity", position = "dodge") + + xlab("Principal Component Index") + ylab("Proportion of Variance Explained") + + geom_line(size = 1, col = "blue") + geom_point(size = 3, col = "blue") + +## Write plot to worksheet 2 +insertPlot(wb, 2, width = 5, height = 4, startCol = "E", startRow = 2) + +## Plot of cumulative explained variance +ggplot(data = pve[1:50,], aes(x = Ind, y = 100*Cumulative.PVE)) + + geom_point(size=2.5) + geom_line(size=1) + xlab("Number of PCs") + + ylab("Cumulative Proportion of Variance Explained") +insertPlot(wb, 2, width = 5, height = 4, xy= c("M", 2)) + + +## Reconstruct image using increasing number of PCs +nPCs <- c(5, 7, 12, 20, 50, 200) +startRow <- rep(c(2, 24), each = 3) +startCol <- rep(c("B", "H", "N"), 2) + +## create a worksheet to save reconstructed images to +addWorksheet(wb, "Reconstructed Images", zoom = 90) + +for(i in 1:length(nPCs)){ + + V <- E$v[, 1:nPCs[i]] + imgHat <- t(V) %*% A ## project img data on to PCs + imgSize <- object.size(V) + object.size(imgHat) + object.size(rMeans) + + imgHat <- V %*% imgHat + rowMeans ## reconstruct from PCs and add back row means + imgHat <- round((imgHat - min(imgHat)) / (max(imgHat) - min(imgHat))*255) # scale + plotFn(imgHat/255) + + ## write strings to worksheet 3 + writeData(wb, "Reconstructed Images", + sprintf("Number of principal components used: %s", + nPCs[[i]]), startCol[i], startRow[i]) + + writeData(wb, "Reconstructed Images", + sprintf("Sum of component object sizes: %s bytes", + format(as.numeric(imgSize), big.mark=',')), startCol[i], startRow[i]+1) + + ## write reconstruced image + insertPlot(wb, "Reconstructed Images", width, height, units="px", + xy = c(startCol[i], startRow[i]+3)) + +} + +# hide grid lines +showGridLines(wb, sheet = 3, showGridLines = FALSE) + +## Make text above images BOLD +boldStyle <- createStyle(textDecoration="BOLD") + +## only want to apply style to specified cells (not all combinations of rows & cols) +addStyle(wb, "Reconstructed Images", style=boldStyle, + rows = c(startRow, startRow+1), cols = rep(startCol, 2), + gridExpand = FALSE) + +## save workbook to working directory +saveWorkbook(wb, "Image dimensionality reduction.xlsx", overwrite = TRUE) + + + + +## remove example files for cran test +if (identical(Sys.getenv("NOT_CRAN", unset = "true"), "false")) { +file_list<-list.files(pattern="\\.xlsx",recursive = T) +file_list<-fl[!grepl("inst/extdata",file_list)&!grepl("man/",file_list)] + +if(length(file_list)>0){ +rm(file_list) +} + +``` +