Binary files /tmp/tmpBAVnUV/hO5kFk39mb/r-cran-openxlsx-4.1.5/build/vignette.rds and /tmp/tmpBAVnUV/yp96quI6yd/r-cran-openxlsx-4.2.3/build/vignette.rds differ diff -Nru r-cran-openxlsx-4.1.5/debian/changelog r-cran-openxlsx-4.2.3/debian/changelog --- r-cran-openxlsx-4.1.5/debian/changelog 2020-05-30 16:41:06.000000000 +0000 +++ r-cran-openxlsx-4.2.3/debian/changelog 2020-10-30 13:03:28.000000000 +0000 @@ -1,8 +1,20 @@ -r-cran-openxlsx (4.1.5-1build1) groovy; urgency=medium +r-cran-openxlsx (4.2.3-1) unstable; urgency=medium - * No-change rebuild against r-api-4.0 + * New upstream release - -- Graham Inggs Sat, 30 May 2020 16:41:06 +0000 + * debian/control: Set Build-Depends: to current R version + + -- Dirk Eddelbuettel Fri, 30 Oct 2020 08:03:28 -0500 + +r-cran-openxlsx (4.2.2-1) unstable; urgency=medium + + * New upstream release + + * debian/control: Set Build-Depends: to current R version + * debian/control: Switch to virtual debhelper-compat (= 11) + * debian/compat: Removed + + -- Dirk Eddelbuettel Mon, 21 Sep 2020 18:05:45 -0500 r-cran-openxlsx (4.1.5-1) unstable; urgency=medium diff -Nru r-cran-openxlsx-4.1.5/debian/compat r-cran-openxlsx-4.2.3/debian/compat --- r-cran-openxlsx-4.1.5/debian/compat 2018-04-16 21:31:33.000000000 +0000 +++ r-cran-openxlsx-4.2.3/debian/compat 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -9 diff -Nru r-cran-openxlsx-4.1.5/debian/control r-cran-openxlsx-4.2.3/debian/control --- r-cran-openxlsx-4.1.5/debian/control 2020-05-11 02:33:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/debian/control 2020-10-30 13:03:13.000000000 +0000 @@ -2,7 +2,7 @@ Section: gnu-r Priority: optional Maintainer: Dirk Eddelbuettel -Build-Depends: debhelper (>= 10), r-base-dev (>= 3.6.3), dh-r, r-cran-rcpp, r-cran-zip, r-cran-stringi, r-cran-rlang +Build-Depends: debhelper-compat (= 11), r-base-dev (>= 4.0.3), dh-r, r-cran-rcpp, r-cran-zip, r-cran-stringi, r-cran-rlang Standards-Version: 4.5.0 Vcs-Browser: https://salsa.debian.org/edd/r-cran-openxlsx Vcs-Git: https://salsa.debian.org/edd/r-cran-openxlsx.git diff -Nru r-cran-openxlsx-4.1.5/DESCRIPTION r-cran-openxlsx-4.2.3/DESCRIPTION --- r-cran-openxlsx-4.1.5/DESCRIPTION 2020-05-06 17:50:03.000000000 +0000 +++ r-cran-openxlsx-4.2.3/DESCRIPTION 2020-10-27 14:20:02.000000000 +0000 @@ -1,8 +1,8 @@ Type: Package Package: openxlsx Title: Read, Write and Edit xlsx Files -Version: 4.1.5 -Date: 2020-05-06 +Version: 4.2.3 +Date: 2020-10-26 Language: en-US Authors@R: c(person(given = "Philipp", @@ -15,6 +15,9 @@ email = "Alexander.Walker1989@gmail.com"), person(given = "Luca", family = "Braglia", + role = "ctb"), + person(given = "Joshua", + family = "Sturm", role = "ctb")) Description: Simplifies the creation of Excel .xlsx files by providing a high level interface to writing, styling and editing @@ -27,11 +30,11 @@ BugReports: https://github.com/ycphs/openxlsx/issues Depends: R (>= 3.3.0) Imports: grDevices, methods, Rcpp, stats, utils, zip, stringi -Suggests: knitr, testthat, roxygen2 +Suggests: knitr, testthat, roxygen2, rmarkdown LinkingTo: Rcpp VignetteBuilder: knitr Encoding: UTF-8 -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 Collate: 'CommentClass.R' 'HyperlinkClass.R' 'RcppExports.R' 'class_definitions.R' 'StyleClass.R' 'WorkbookClass.R' 'baseXML.R' 'borderFunctions.R' 'chartsheet_class.R' @@ -42,10 +45,11 @@ 'workbook_write_data.R' 'worksheet_class.R' 'wrappers.R' 'writeData.R' 'writeDataTable.R' 'writexlsx.R' NeedsCompilation: yes -Packaged: 2020-05-06 15:47:38 UTC; ceadm +Packaged: 2020-10-27 09:11:13 UTC; philipp Author: Philipp Schauberger [aut, cre], Alexander Walker [aut], - Luca Braglia [ctb] + Luca Braglia [ctb], + Joshua Sturm [ctb] Maintainer: Philipp Schauberger Repository: CRAN -Date/Publication: 2020-05-06 17:50:03 UTC +Date/Publication: 2020-10-27 14:20:02 UTC diff -Nru r-cran-openxlsx-4.1.5/inst/doc/Formatting.html r-cran-openxlsx-4.2.3/inst/doc/Formatting.html --- r-cran-openxlsx-4.1.5/inst/doc/Formatting.html 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/Formatting.html 2020-10-27 09:11:10.000000000 +0000 @@ -0,0 +1,708 @@ + + + + + + + + + + + + + + + + +Formating with xlsx + + + + + + + + + + + + + + + + + + + + + + + + + +

Formating with xlsx

+

Alexander Walker, Philipp Schauberger

+

2020-10-27

+ + + +
+

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)
+
+ + + + + + + + + + + Binary files /tmp/tmpBAVnUV/hO5kFk39mb/r-cran-openxlsx-4.1.5/inst/doc/formatting.pdf and /tmp/tmpBAVnUV/yp96quI6yd/r-cran-openxlsx-4.2.3/inst/doc/formatting.pdf differ diff -Nru r-cran-openxlsx-4.1.5/inst/doc/Formatting.R r-cran-openxlsx-4.2.3/inst/doc/Formatting.R --- r-cran-openxlsx-4.1.5/inst/doc/Formatting.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/Formatting.R 2020-10-27 09:11:08.000000000 +0000 @@ -0,0 +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) + diff -Nru r-cran-openxlsx-4.1.5/inst/doc/Formatting.Rmd r-cran-openxlsx-4.2.3/inst/doc/Formatting.Rmd --- r-cran-openxlsx-4.1.5/inst/doc/Formatting.Rmd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/Formatting.Rmd 2020-09-13 06:43:40.000000000 +0000 @@ -0,0 +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) +``` + + diff -Nru r-cran-openxlsx-4.1.5/inst/doc/formatting.Rnw r-cran-openxlsx-4.2.3/inst/doc/formatting.Rnw --- r-cran-openxlsx-4.1.5/inst/doc/formatting.Rnw 2020-05-06 08:47:22.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/formatting.Rnw 1970-01-01 00:00:00.000000000 +0000 @@ -1,355 +0,0 @@ - -\documentclass[11pt]{article} -\usepackage{graphicx, verbatim} - -% \VignetteEngine{knitr::knitr} -% \VignetteIndexEntry{Formatting Examples} -% \VignetteDepends{openxlsx} -% \VignetteKeyword{excel} -% \VignetteKeyword{xlsx} -% \VignetteKeyword{spreadsheet} - -\usepackage{geometry} - \geometry{ - a4paper, - total={210mm,297mm}, - left=15mm, - right=15mm, - top=20mm, - bottom=20mm, - } -\begin{document} - -\title{Examples} -\author{Alexander Walker\\ -\texttt{Alexander.Walker1989@gmail.com}} -\maketitle - - -\section{Formatting with writeData and writeDataTable} -\begin{verbatim} - -## 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 - -\end{verbatim} - -\noindent -The 'tableStyle' argument in writeDataTable can be any ofthe predefined tableStyles in Excel. - -\begin{center} -\includegraphics[width=14cm]{tableStyles} -\end{center} - -\newpage -\section{Date Formatting} -\begin{verbatim} - -# 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) -\end{verbatim} - - - - - -\newpage -\section{DateTime Formatting} -\begin{verbatim} - -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") - -\end{verbatim} - - - -\newpage -\section{Conditional Formatting} -\begin{verbatim} - -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) - - -\end{verbatim} - - -\newpage -\section{Numeric Formatting} -\begin{verbatim} - -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) - - -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) -} - -} - -\end{verbatim} - - - -\end{document} diff -Nru r-cran-openxlsx-4.1.5/inst/doc/Introduction.html r-cran-openxlsx-4.2.3/inst/doc/Introduction.html --- r-cran-openxlsx-4.1.5/inst/doc/Introduction.html 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/Introduction.html 2020-10-27 09:11:11.000000000 +0000 @@ -0,0 +1,875 @@ + + + + + + + + + + + + + + + + +Introduction + + + + + + + + + + + + + + + + + + + + + + + + + +

Introduction

+

Alexander Walker, Philipp Schauberger

+

2020-10-27

+ + + +
+

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)
+}
+
+
+ + + + + + + + + + + Binary files /tmp/tmpBAVnUV/hO5kFk39mb/r-cran-openxlsx-4.1.5/inst/doc/Introduction.pdf and /tmp/tmpBAVnUV/yp96quI6yd/r-cran-openxlsx-4.2.3/inst/doc/Introduction.pdf differ diff -Nru r-cran-openxlsx-4.1.5/inst/doc/Introduction.R r-cran-openxlsx-4.2.3/inst/doc/Introduction.R --- r-cran-openxlsx-4.1.5/inst/doc/Introduction.R 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/Introduction.R 2020-10-27 09:11:10.000000000 +0000 @@ -0,0 +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) +# } +# + diff -Nru r-cran-openxlsx-4.1.5/inst/doc/Introduction.Rmd r-cran-openxlsx-4.2.3/inst/doc/Introduction.Rmd --- r-cran-openxlsx-4.1.5/inst/doc/Introduction.Rmd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/Introduction.Rmd 2020-09-13 06:43:40.000000000 +0000 @@ -0,0 +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) +} + +``` + diff -Nru r-cran-openxlsx-4.1.5/inst/doc/Introduction.Rnw r-cran-openxlsx-4.2.3/inst/doc/Introduction.Rnw --- r-cran-openxlsx-4.1.5/inst/doc/Introduction.Rnw 2020-05-06 15:00:36.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/doc/Introduction.Rnw 1970-01-01 00:00:00.000000000 +0000 @@ -1,487 +0,0 @@ - -\documentclass[11pt]{article} -\usepackage{graphicx, verbatim} - -% \VignetteEngine{knitr::knitr} -% \VignetteIndexEntry{Examples} -% \VignetteDepends{openxlsx} -% \VignetteKeyword{excel} -% \VignetteKeyword{xlsx} -% \VignetteKeyword{spreadsheet} - -\usepackage{geometry} -\geometry{ -a4paper, -total={210mm,297mm}, -left=15mm, -right=15mm, -top=20mm, -bottom=20mm, -} - -\begin{document} -\title{Introduction} -\author{Alexander Walker\\ -\texttt{Alexander.Walker1989@gmail.com}} -\maketitle - - -\newpage -\section{Basic Examples} -\subsection{write.xlsx} -\begin{verbatim} -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 -write.xlsx(iris, file = "writeXLSX1.xlsx") -write.xlsx(iris, file = "writeXLSXTable1.xlsx", asTable = 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 -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) - - - - - -## Additional styling -## 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) - -\end{verbatim} - - -\newpage -\subsection{Basic Workbook} -\begin{verbatim} -require(ggplot2) - -## set default border Colour and style -wb <- createWorkbook() -options("openxlsx.borderColour" = "#4F80BD") -options("openxlsx.borderStyle" = "thin") -modifyBaseFont(wb, fontSize = 10, fontName = "Arial Narrow") - -addWorksheet(wb, sheetName = "Motor Trend Car Road Tests", gridLines = FALSE) -addWorksheet(wb, sheetName = "Iris", gridLines = FALSE) - -## 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 iris data.frame as excel table -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) - -## 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) - -## 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) - -# 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)) - -saveWorkbook(wb, "basics.xlsx", overwrite = TRUE) ## save to working directory -\end{verbatim} - -\newpage -\subsection{Gallery} -\begin{verbatim} - -## 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) - - - -\end{verbatim} - - - - - -\newpage -\section{Further Examples} - -\subsection{Stock Price} - -\begin{verbatim} -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") -\end{verbatim} - -\newpage - -\subsection{Image Compression using PCA} - -\begin{verbatim} -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) -} - -} -\end{verbatim} - -\end{document} Binary files /tmp/tmpBAVnUV/hO5kFk39mb/r-cran-openxlsx-4.1.5/inst/extdata/groupTest.xlsx and /tmp/tmpBAVnUV/yp96quI6yd/r-cran-openxlsx-4.2.3/inst/extdata/groupTest.xlsx differ diff -Nru r-cran-openxlsx-4.1.5/inst/WORDLIST r-cran-openxlsx-4.2.3/inst/WORDLIST --- r-cran-openxlsx-4.1.5/inst/WORDLIST 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/inst/WORDLIST 2020-09-13 06:43:40.000000000 +0000 @@ -0,0 +1,38 @@ +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 diff -Nru r-cran-openxlsx-4.1.5/man/conditionalFormatting.Rd r-cran-openxlsx-4.2.3/man/conditionalFormatting.Rd --- r-cran-openxlsx-4.1.5/man/conditionalFormatting.Rd 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/conditionalFormatting.Rd 2020-09-13 06:43:40.000000000 +0000 @@ -29,7 +29,8 @@ \item{style}{A style to apply to those cells that satisfy the rule. Default is createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")} -\item{type}{Either 'expression', 'colorscale', 'databar', 'duplicates' or "contains' (case insensitive).} +\item{type}{Either 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', +'endsWith', 'contains' or 'notContains' (case insensitive).} \item{...}{See below} } @@ -90,6 +91,9 @@ 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") @@ -167,6 +171,24 @@ 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 @@ -243,5 +265,5 @@ \code{\link{createStyle}} } \author{ -Alexander Walker +Alexander Walker, Philipp Schauberger } diff -Nru r-cran-openxlsx-4.1.5/man/groupColumns.Rd r-cran-openxlsx-4.2.3/man/groupColumns.Rd --- r-cran-openxlsx-4.1.5/man/groupColumns.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/groupColumns.Rd 2020-09-13 06:43:40.000000000 +0000 @@ -0,0 +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 +} diff -Nru r-cran-openxlsx-4.1.5/man/groupRows.Rd r-cran-openxlsx-4.2.3/man/groupRows.Rd --- r-cran-openxlsx-4.1.5/man/groupRows.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/groupRows.Rd 2020-09-13 06:43:40.000000000 +0000 @@ -0,0 +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 +} diff -Nru r-cran-openxlsx-4.1.5/man/saveWorkbook.Rd r-cran-openxlsx-4.2.3/man/saveWorkbook.Rd --- r-cran-openxlsx-4.1.5/man/saveWorkbook.Rd 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/saveWorkbook.Rd 2020-09-14 06:50:59.000000000 +0000 @@ -4,7 +4,7 @@ \alias{saveWorkbook} \title{save Workbook to file} \usage{ -saveWorkbook(wb, file, overwrite = FALSE) +saveWorkbook(wb, file, overwrite = FALSE, returnValue = FALSE) } \arguments{ \item{wb}{A Workbook object to write to file} @@ -12,6 +12,9 @@ \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 @@ -38,5 +41,5 @@ \code{\link{writeDataTable}} } \author{ -Alexander Walker +Alexander Walker, Philipp Schauberger } diff -Nru r-cran-openxlsx-4.1.5/man/setColWidths.Rd r-cran-openxlsx-4.2.3/man/setColWidths.Rd --- r-cran-openxlsx-4.1.5/man/setColWidths.Rd 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/setColWidths.Rd 2020-09-13 06:43:40.000000000 +0000 @@ -38,6 +38,8 @@ } 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 diff -Nru r-cran-openxlsx-4.1.5/man/showGridLines.Rd r-cran-openxlsx-4.2.3/man/showGridLines.Rd --- r-cran-openxlsx-4.1.5/man/showGridLines.Rd 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/showGridLines.Rd 2020-10-26 21:07:30.000000000 +0000 @@ -11,7 +11,7 @@ \item{sheet}{A name or index of a worksheet} -\item{showGridLines}{A logical. If \code{TRUE}, grid lines are hidden.} +\item{showGridLines}{A logical. If \code{FALSE}, grid lines are hidden.} } \description{ Set worksheet gridlines to show or hide. diff -Nru r-cran-openxlsx-4.1.5/man/ungroupColumns.Rd r-cran-openxlsx-4.2.3/man/ungroupColumns.Rd --- r-cran-openxlsx-4.1.5/man/ungroupColumns.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/ungroupColumns.Rd 2020-09-13 06:43:40.000000000 +0000 @@ -0,0 +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 +} diff -Nru r-cran-openxlsx-4.1.5/man/ungroupRows.Rd r-cran-openxlsx-4.2.3/man/ungroupRows.Rd --- r-cran-openxlsx-4.1.5/man/ungroupRows.Rd 1970-01-01 00:00:00.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/ungroupRows.Rd 2020-09-13 06:43:40.000000000 +0000 @@ -0,0 +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 +} diff -Nru r-cran-openxlsx-4.1.5/man/writeData.Rd r-cran-openxlsx-4.2.3/man/writeData.Rd --- r-cran-openxlsx-4.1.5/man/writeData.Rd 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/man/writeData.Rd 2020-09-13 06:43:40.000000000 +0000 @@ -52,7 +52,7 @@ "\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{http://www.colorpicker.com}{here}).} +\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{ diff -Nru r-cran-openxlsx-4.1.5/MD5 r-cran-openxlsx-4.2.3/MD5 --- r-cran-openxlsx-4.1.5/MD5 2020-05-06 17:50:03.000000000 +0000 +++ r-cran-openxlsx-4.2.3/MD5 2020-10-27 14:20:02.000000000 +0000 @@ -1,45 +1,49 @@ -784446c4e54666ed6ee43ff69adef76e *DESCRIPTION +1b6c90bcf25104a928641ec52f5bc314 *DESCRIPTION 7b9a5ad7d625435b6cf87d0c7c15898d *LICENSE -ca95a71ff49a31c07dcb4ef0fb6dc489 *NAMESPACE -d14e216bd3a0fc5451ad82bcae0de18b *NEWS.md +d8f5372fdf772197e4cd067b6c02ec5f *NAMESPACE +068dddbc208fe2260d13dbb97d753ee6 *NEWS.md 07dd6cdcd3ea63b571847763de0087cc *R/CommentClass.R 413fb84827d086fff6e75cd31e204b4b *R/HyperlinkClass.R -ae5a9f998854f6bbb2b38ae5ab67642d *R/RcppExports.R +0a8111d81cc8e1c9bc7778c3d402efb4 *R/RcppExports.R c7da3c75dc0ed45e6c97e0da745b8193 *R/StyleClass.R -1d873c0cae40e3e3d765564a07447176 *R/WorkbookClass.R -9590cdae7387c2e36eb18081500bb3d9 *R/baseXML.R +37e876ce2c211878c2ee7226df9485ce *R/WorkbookClass.R +8975f88e08e2f79f78914543f6c4875f *R/baseXML.R a871a689e2a2a5b1fe0c042b50eb7309 *R/borderFunctions.R 3bad4cf7533cb8c28ace7b6f13624ad1 *R/chartsheet_class.R -2317c9246fb7d8a1f5cfdc0028aa233a *R/class_definitions.R -6d9d5f57efa2ac5f7c837bf5369a1923 *R/conditional_formatting.R -1f4d2cb811e21afda9e36ff59a809bfa *R/helperFunctions.R +e061750003ca2b2934b7d829314bfbfe *R/class_definitions.R +d105da93e68eb797d12a774c5e68a13b *R/conditional_formatting.R +80428a47a6b6a5ca54624321b5097fb4 *R/helperFunctions.R 8ea314936c58420f8dbd5c5a157a5d09 *R/loadWorkbook.R 17914458bc705cfa48e8f3d25e0b6b4d *R/onUnload.R 625f3eec628e7711020fd3fcd51433e4 *R/openXL.R 609be913ba8f81a81c72165d4ffd41cf *R/openxlsx-package.R -ce1d30a224668c820503aadb6495d123 *R/openxlsx.R -bc26d8e236979dbd81a85d4417bcfebf *R/openxlsxCoerce.R +de61777c8722772ad4c0bde3503d8685 *R/openxlsx.R +1931b5ea72be495d5308c9a917732e7a *R/openxlsxCoerce.R fc8f7f9ca0c7d7f9f82cdbb51268de32 *R/readWorkbook.R c6d78e1e5c77cec8b51e048e7372949a *R/sheet_data_class.R -d5e5fadddc90005ebfd75fc7c7cef0e6 *R/workbook_column_widths.R +4980bdd59b0446cb941934f4c4c85d67 *R/workbook_column_widths.R b4b2779e533170ab0333254f93ded678 *R/workbook_read_workbook.R 2b77bb64db2e9d088d7144f8d2e98e01 *R/workbook_write_data.R -86a18016c7824d30aac3f1c4a35f24ee *R/worksheet_class.R -6068adcea90de8bf853f4f6f89f742ed *R/wrappers.R -40b5c32febc397874af5dee41dd5e62e *R/writeData.R -20093d932969769f9e21bea93a7b42cc *R/writeDataTable.R +eeee604ca778dd9325b0c691204bc874 *R/worksheet_class.R +211f63854de22e7944dc3103a68e70ae *R/wrappers.R +e93cb4ac96d59e36bd67f1973ab9c03a *R/writeData.R +eacb99f2c5288763fd7bff4bf882dad9 *R/writeDataTable.R fe57ce5dc94123f04d0a0fa5067773e1 *R/writexlsx.R -7659aefbe6a1504a11b5abb12f117108 *README.md -b4c4bb6a182d42f50d64b649b4efced5 *build/vignette.rds -3a1a595d34508175908c44a61c9999b1 *inst/doc/Introduction.Rnw -618f9a8afe8e5a877141fa8ac7cf0806 *inst/doc/Introduction.pdf -65616841c4b21b952b637c73ca724153 *inst/doc/formatting.Rnw -f6a6c3a4e217d39477784568eeeb73ba *inst/doc/formatting.pdf +ae3ed4f8e2412e7ccaee485d62bd20d3 *README.md +c76b72d4438bf868dae0d73f8220f7d5 *build/vignette.rds +fe4d2ebb2a0fd92ec6211c9bf5efdc9c *inst/WORDLIST +e7841053567353ee7b1ba58318ee7f14 *inst/doc/Formatting.R +cff1495404efb362e482e0e417b6c8be *inst/doc/Formatting.Rmd +df58c56316cf2ab8b87ed29b74c2bea2 *inst/doc/Formatting.html +0d68e393f77c4b432b6e1afe5ab06b76 *inst/doc/Introduction.R +7bd2b0ca10f205f9524eb1cd88690c7d *inst/doc/Introduction.Rmd +4db917438caa08aeed2e61ae2eb1ce94 *inst/doc/Introduction.html a661a77cb80f4259f448e3ce20c65259 *inst/extdata/build_font_size_lookup.R 13cccf9835335301211ac8d8a4785659 *inst/extdata/cloneEmptyWorksheetExample.xlsx c2f3a10132c34da8e7c70a72f52d06c5 *inst/extdata/cloneWorksheetExample.xlsx b04e6c38e085e7cda15632119b0f9826 *inst/extdata/conditional_formatting_testing.R 36a7feeb6214d7e79ac8b89df3c45df0 *inst/extdata/einstein.jpg +0c1574a0171de89f03b8cfc5dcd0d0e5 *inst/extdata/groupTest.xlsx fb9a2de7bc2ec82fe52394335d80050d *inst/extdata/loadExample.xlsx 492caea5ba46c694316447508e17fd6a *inst/extdata/load_xlsx_testing.R b880cccb0e6a0573c9107453505ee04a *inst/extdata/namedRegions.xlsx @@ -54,7 +58,7 @@ 9a966e34696cf5c4ff264921000eb6f7 *man/all.equal.Rd 99fb306f47779db2fb1299b3220f690b *man/cloneWorksheet.Rd 21580969126e86ab026bfd4cb5f4f7f4 *man/conditionalFormat.Rd -12fa144db717390ca919a632643204d5 *man/conditionalFormatting.Rd +ee569bcf7d18fb974802031cb4850686 *man/conditionalFormatting.Rd be2f5a877330a76c56886030b21f71fa *man/convertFromExcelRef.Rd dd06de8b697dcc3a0412d3d0919b51f4 *man/convertToDate.Rd 83e8f273dd40ff8ef9ee45cc35d47dba *man/convertToDateTime.Rd @@ -85,6 +89,8 @@ 51c06a3e6a3b48f803f31cfc5da77718 *man/getSheetNames.Rd 1fa8277f1849f01b8e7468e27bdc3578 *man/getStyles.Rd 93b0fefa86c1831dcc15d319dc96b3b6 *man/getTables.Rd +5b4713b680166e63b88a3c479c120894 *man/groupColumns.Rd +a32d45ecdc48e3b2236478b5a9698f33 *man/groupRows.Rd 0fe511a3aa9138a0dae85718cbc544f3 *man/insertImage.Rd baf57bc122cd6137a6c720956ecd905b *man/insertPlot.Rd 8ff8b8e6032d06730162721cb9a73551 *man/int2col.Rd @@ -110,8 +116,8 @@ 0501e2933272896dc38181f252821d9e *man/removeWorksheet.Rd f7ff2d424e210c57b8c81f38710a8587 *man/renameWorksheet.Rd df469472fee5e498f4367ff341f6ec78 *man/replaceStyle.Rd -ae966e53d20a7e910f889933b8704b51 *man/saveWorkbook.Rd -833862ad5b715bc96f6a40abb530be68 *man/setColWidths.Rd +a273b32a0bdf8d0e9f9d176566814cbf *man/saveWorkbook.Rd +27612b55f416fc166305d6f51b11fb77 *man/setColWidths.Rd 5272e5d31ce61886e297552fe804db83 *man/setFooter.Rd 4ed2e0674e259bc5762024a399058d3a *man/setHeader.Rd bc281b409a8c9e8d276b3be9154e440c *man/setHeaderFooter.Rd @@ -120,24 +126,27 @@ b58e3015272c2e9f26a6403d8571c336 *man/sheetVisibility.Rd 38a4899f27620d73520a573591471556 *man/sheetVisible.Rd ab267b129229824690d9104a6c776423 *man/sheets.Rd -f8d2ec445bdf44f378437569356fe71a *man/showGridLines.Rd +c298e8123d3dbe3109affcd97ecc4ba3 *man/showGridLines.Rd +120eed54ae35268208304aab852e9c94 *man/ungroupColumns.Rd +0881baf38f663c9ff59527f91320e086 *man/ungroupRows.Rd 661899c8e1ee9da19b220b762d609926 *man/worksheetOrder.Rd 005b3fd23101bfb644811982219bf979 *man/write.xlsx.Rd e2da0e1a31e2728a4d0a713442ed1e32 *man/writeComment.Rd -434d1bc7037112cab1e89d09678f38d2 *man/writeData.Rd +e0d0398fe85fd930013d1c530ba79e2e *man/writeData.Rd d449802153e0193cce3204d9f2f6d067 *man/writeDataTable.Rd 440990b0f6dc7e3e0b977f1cc7b07b2c *man/writeFormula.Rd -b0b3787de65788103c58ec233be0d8c6 *src/RcppExports.cpp -475b9faa7a758feb1aa995d9c07de2cc *src/helper_functions.cpp -4353eb631e7930ab73ad25ba44f6654b *src/load_workbook.cpp +a064a39e3a3031202ff2aa8d03d0af5d *src/RcppExports.cpp +117e229fb28340f0859ea25b72b05bc4 *src/helper_functions.cpp +602b77ef3f93ec6182a6abb1b30d4c6b *src/load_workbook.cpp a73ff29f9d5f14a3edcba7be91bcf094 *src/openxlsx.h -2155a804f21601eabd5f8c4fcdbf0105 *src/openxlsx_init.c -d0e55e0bf868a2eb67a0a5c3bdcbd512 *src/read_workbook.cpp +42c39091477db1a4d5c254351a2c292c *src/openxlsx_init.c +93f30b6e64d5c9d9ab927207a2d7cd33 *src/read_workbook.cpp c0c6145239614a8169a12e1e27e5673b *src/write_data.cpp 611ded4261c97754f9559f1ca0ee2926 *src/write_file.cpp -4d6151cde1d83615f447730f2ed5f436 *src/write_file_2.cpp +ab121498ed743ee7f74c898d27f4a491 *src/write_file_2.cpp 0f4ef4791fd7c7c057019a8ea9be4189 *tests/testthat.R 185afb805f2368bcfe9d106942578060 *tests/testthat/test-Workbook_properties.R +1ed36081c99bfd937a702e543f3b437b *tests/testthat/test-Worksheet_naming.R 513547f7f067dbd76fd1d00b90881e13 *tests/testthat/test-border_parsing.R aef5cc8a6e9dfd355eb5181fa1ff7762 *tests/testthat/test-cloneWorksheet.R d77f2a52a3dcfb364f41222e1f3718d0 *tests/testthat/test-date_time_conversion.R @@ -151,15 +160,17 @@ 638c53b84f39ead1ed3a74830574a302 *tests/testthat/test-loading_workbook_tables.R 1dfb48fd6cb85655b177382a089253c7 *tests/testthat/test-loading_workbook_unzipped.R 6eabc9989756c200ff95d01d300aca34 *tests/testthat/test-named_regions.R +e9fef7d7df36bd8b8a11bb9e394bcc50 *tests/testthat/test-outlines.R cb045f7a910cfcaeeebcbbd9386c6c90 *tests/testthat/test-page_setup.R -3d2a144754ba7914aa8d681136e48269 *tests/testthat/test-protect-workbook.R +3bd5a06152c7b417853bce65d95d1a23 *tests/testthat/test-protect-workbook.R afa7a2b159c05bc03bf9464964c723e3 *tests/testthat/test-protect-worksheet.R 7d213ef54dd02574bc04d551e4da1f10 *tests/testthat/test-read_from_created_wb.R d694023e037c359b7739f32de6419801 *tests/testthat/test-read_from_loaded_workbook.R -8b60e24b918f6b7355aaabaf19e3ecb5 *tests/testthat/test-read_sources.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 5af8cc6a0deec36838ee4c47abaa4b87 *tests/testthat/test-remove_worksheets.R +ab7443a4df941475cb068e861c929c5d *tests/testthat/test-saveWorkbook.R 0fe3268ae71a00075720960e073f08dd *tests/testthat/test-skip_empty_cols.R 58066d3b93dd879346143c651159d16f *tests/testthat/test-skip_empty_rows.R 03e2e9ca52193186f740c047bcf23023 *tests/testthat/test-style_replacing.R @@ -173,9 +184,8 @@ fa9e13ce4b7350b26acd70f3f4372425 *tests/testthat/test-write_data_to_sheetData_NAs.R e3c38e969ee3def1edeacf04f9063aa7 *tests/testthat/test-write_read_equality.R c7dc27faa472118ece57fe6afe4fb07f *tests/testthat/test-write_xlsx_vector_args.R -177ba909520240d00bcc539fbecd0aba *tests/testthat/test-writing_posixct.R +5b7ee465d9df599c9c3d5b3f659a8df1 *tests/testthat/test-writing_posixct.R 2594c06e725838b42d60e5da6c6e6df3 *tests/testthat/test-writing_sheet_data.R -8a207caac8868dc81d23f30d3600eba9 *vignettes/Introduction-concordance.tex -3a1a595d34508175908c44a61c9999b1 *vignettes/Introduction.Rnw -65616841c4b21b952b637c73ca724153 *vignettes/formatting.Rnw +cff1495404efb362e482e0e417b6c8be *vignettes/Formatting.Rmd +7bd2b0ca10f205f9524eb1cd88690c7d *vignettes/Introduction.Rmd e37f875bb932ea389ed1a8abe3405ccf *vignettes/tableStyles.PNG diff -Nru r-cran-openxlsx-4.1.5/NAMESPACE r-cran-openxlsx-4.2.3/NAMESPACE --- r-cran-openxlsx-4.1.5/NAMESPACE 2020-05-06 15:35:24.000000000 +0000 +++ r-cran-openxlsx-4.2.3/NAMESPACE 2020-10-26 21:19:05.000000000 +0000 @@ -35,6 +35,8 @@ export(getSheetNames) export(getStyles) export(getTables) +export(groupColumns) +export(groupRows) export(insertImage) export(insertPlot) export(int2col) @@ -69,17 +71,29 @@ export(sheetVisible) export(sheets) export(showGridLines) +export(ungroupColumns) +export(ungroupRows) export(worksheetOrder) export(write.xlsx) export(writeComment) export(writeData) export(writeDataTable) export(writeFormula) -import(grDevices) import(methods) -import(stats) import(stringi) importFrom(Rcpp,sourceCpp) +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) diff -Nru r-cran-openxlsx-4.1.5/NEWS.md r-cran-openxlsx-4.2.3/NEWS.md --- r-cran-openxlsx-4.1.5/NEWS.md 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/NEWS.md 2020-10-26 21:09:28.000000000 +0000 @@ -1,37 +1,99 @@ +# openxlsx 4.2.3 + +## 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 -* include tests for cloneWorksheet +## 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 +* Added description for `writeFormula()` to use only english function names * Fixed validateSheet for special characters -* 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 +## Internal * applied the tidyverse-style to the package `styler::style_pkg()` +* include tests for `cloneWorksheet` + # openxlsx 4.1.4 -* Use `zip::zipr()` instead of `zip::zip()`. +## New Features -* Keep correct visibility option for loadWorkbook. [#12](https://github.com/ycphs/openxlsx/issues/12]) +* Added `getCellRefs()` as function. [#7](https://github.com/ycphs/openxlsx/issues/7) -* Added getCellRefs as function. [#7](https://github.com/ycphs/openxlsx/issues/7) +* Added parameter for customizing na.strings -* update to rogygen2 7.0.0 +## Bug Fixes -* Added parameter for customizing na.strings +* 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 @@ -371,4 +433,4 @@ * errors in vignette examples. -* numbers with > 8 digits were rounded in `writeData` \ No newline at end of file +* numbers with > 8 digits were rounded in `writeData` diff -Nru r-cran-openxlsx-4.1.5/R/baseXML.R r-cran-openxlsx-4.2.3/R/baseXML.R --- r-cran-openxlsx-4.1.5/R/baseXML.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/baseXML.R 2020-09-13 06:43:40.000000000 +0000 @@ -184,6 +184,7 @@ genBaseWorkbook <- function() { list( workbookPr = '', + workbookProtection = NULL, bookViews = '', sheets = NULL, externalReferences = NULL, diff -Nru r-cran-openxlsx-4.1.5/R/class_definitions.R r-cran-openxlsx-4.2.3/R/class_definitions.R --- r-cran-openxlsx-4.1.5/R/class_definitions.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/class_definitions.R 2020-09-13 06:43:40.000000000 +0000 @@ -1,15 +1,11 @@ - - - - Workbook <- setRefClass("Workbook", fields = c( "sheet_names" = "character", - "workbookProtection" = "ANY", "charts" = "ANY", "isChartSheet" = "logical", + "colOutlineLevels" = "ANY", "colWidths" = "ANY", "connections" = "ANY", "Content_Types" = "character", @@ -22,6 +18,7 @@ "headFoot" = "ANY", "media" = "ANY", + "outlineLevels" = "ANY", "pivotTables" = "ANY", "pivotTables.xml.rels" = "ANY", diff -Nru r-cran-openxlsx-4.1.5/R/conditional_formatting.R r-cran-openxlsx-4.2.3/R/conditional_formatting.R --- r-cran-openxlsx-4.1.5/R/conditional_formatting.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/conditional_formatting.R 2020-09-13 06:43:40.000000000 +0000 @@ -7,14 +7,15 @@ #' @aliases databar #' @title Add conditional formatting to cells #' @description Add conditional formatting to cells -#' @author Alexander Walker +#' @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', 'colorscale', 'databar', 'duplicates' or "contains' (case insensitive). +#' @param type Either 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', +#' 'endsWith', 'contains' or 'notContains' (case insensitive). #' @param ... See below #' @details See Examples. #' @@ -71,6 +72,9 @@ #' 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") @@ -147,6 +151,24 @@ #' 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) @@ -243,11 +265,17 @@ 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 != "expression") { stop( - "Invalid type argument. Type must be one of 'expression', 'colourScale', 'databar', 'duplicates' or 'contains'" + "Invalid type argument. Type must be one of 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', 'endsWith', 'contains' or 'notContains'" ) } @@ -389,20 +417,87 @@ # 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 diff -Nru r-cran-openxlsx-4.1.5/R/helperFunctions.R r-cran-openxlsx-4.2.3/R/helperFunctions.R --- r-cran-openxlsx-4.1.5/R/helperFunctions.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/helperFunctions.R 2020-10-06 21:13:25.000000000 +0000 @@ -285,9 +285,14 @@ - - - +#' @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 @@ -310,7 +315,13 @@ return(colour) } -## color helper function: eg col2hex(colors()) +#' @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) } diff -Nru r-cran-openxlsx-4.1.5/R/openxlsxCoerce.R r-cran-openxlsx-4.2.3/R/openxlsxCoerce.R --- r-cran-openxlsx-4.1.5/R/openxlsxCoerce.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/openxlsxCoerce.R 2020-10-06 20:57:42.000000000 +0000 @@ -121,6 +121,13 @@ +#' @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) { diff -Nru r-cran-openxlsx-4.1.5/R/openxlsx.R r-cran-openxlsx-4.2.3/R/openxlsx.R --- r-cran-openxlsx-4.1.5/R/openxlsx.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/openxlsx.R 2020-10-06 11:30:38.000000000 +0000 @@ -6,8 +6,6 @@ #' @name openxlsx #' @docType package #' @useDynLib openxlsx, .registration=TRUE -#' @import grDevices -#' @import stats #' @importFrom Rcpp sourceCpp #' @importFrom zip zipr #' @importFrom utils download.file head menu unzip diff -Nru r-cran-openxlsx-4.1.5/R/RcppExports.R r-cran-openxlsx-4.2.3/R/RcppExports.R --- r-cran-openxlsx-4.1.5/R/RcppExports.R 2020-05-06 15:35:02.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/RcppExports.R 2020-10-27 09:06:36.000000000 +0000 @@ -133,7 +133,7 @@ .Call(`_openxlsx_build_table_xml`, table, tableStyleXML, ref, colNames, showColNames, withFilter) } -write_worksheet_xml_2 <- function(prior, post, sheet_data, row_heights, R_fileName) { - .Call(`_openxlsx_write_worksheet_xml_2`, prior, post, sheet_data, row_heights, R_fileName) +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.1.5/R/WorkbookClass.R r-cran-openxlsx-4.2.3/R/WorkbookClass.R --- r-cran-openxlsx-4.1.5/R/WorkbookClass.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/WorkbookClass.R 2020-10-26 21:07:30.000000000 +0000 @@ -12,6 +12,8 @@ isChartSheet <<- logical(0) colWidths <<- list() + colOutlineLevels <<- list() + attr(colOutlineLevels, "hidden") <<- NULL connections <<- NULL Content_Types <<- genBaseContent_Type() core <<- @@ -43,6 +45,8 @@ queryTables <<- NULL rowHeights <<- list() + outlineLevels <<- list() + attr(outlineLevels, "hidden") <<- NULL slicers <<- NULL slicerCaches <<- NULL @@ -70,7 +74,6 @@ workbook <<- genBaseWorkbook() workbook.xml.rels <<- genBaseWorkbook.xml.rels() - workbookProtection <<- NULL worksheets <<- list() worksheets_rels <<- list() @@ -207,6 +210,8 @@ rowHeights[[newSheetIndex]] <<- list() colWidths[[newSheetIndex]] <<- list() + colOutlineLevels[[newSheetIndex]] <<- list() + outlineLevels[[newSheetIndex]] <<- list() sheetOrder <<- c(sheetOrder, as.integer(newSheetIndex)) sheet_names <<- c(sheet_names, sheetName) @@ -350,6 +355,9 @@ 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) @@ -542,6 +550,9 @@ rowHeights[[newSheetIndex]] <<- list() colWidths[[newSheetIndex]] <<- list() + colOutlineLevels[[newSheetIndex]] <<- list() + outlineLevels[[newSheetIndex]] <<- list() + vml_rels[[newSheetIndex]] <<- list() vml[[newSheetIndex]] <<- list() @@ -1014,20 +1025,6 @@ ) } - - - if (length(workbookProtection) > 0) { - # Worksheet protection needs to be right after fileVersion, fileSharing and workbookPr, otherwise Excel will complain - workbookXML <- - append(workbookXML, - list(workbookProtection = workbookProtection), - after = max(which( - names(workbookXML) %in% c("fileVersion", "fileSharing", "workbookPr") - )) - ) - } - - write_file( head = '', body = pxml(workbookXML), @@ -1090,8 +1087,6 @@ Workbook$methods( validateSheet = function(sheetName) { if (!is.numeric(sheetName)) { - # sheetName <- replaceIllegalCharacters(sheetName) - if (is.null(sheet_names)) { stop("Workbook does not contain any worksheets.", call. = FALSE) } @@ -1106,11 +1101,11 @@ } return(sheetName) - } else if (!sheetName %in% sheet_names) { - stop(sprintf("Sheet '%s' does not exist.", sheetName), call. = FALSE) + } else if (!sheetName %in% replaceXMLEntities(sheet_names)) { + stop(sprintf("Sheet '%s' does not exist.", replaceXMLEntities(sheetName)), call. = FALSE) } - return(which(sheet_names == sheetName)) + return(which(replaceXMLEntities(sheet_names) == sheetName)) } ) @@ -1984,7 +1979,10 @@ ) } - + # 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") @@ -2016,27 +2014,45 @@ ## 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) { + 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]]), + row_heights_ = unlist(rowHeights[[i]]), + outline_levels_ = unlist(outlineLevels[[i]]), R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i)) ) } @@ -2123,6 +2139,76 @@ } ) +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) { @@ -2171,6 +2257,8 @@ vml_rels[[sheet]] <<- NULL rowHeights[[sheet]] <<- NULL + colOutlineLevels[[sheet]] <<- NULL + outlineLevels[[sheet]] <<- NULL comments[[sheet]] <<- NULL isChartSheet <<- isChartSheet[-sheet] @@ -2669,6 +2757,43 @@ 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( @@ -3250,10 +3375,14 @@ } } - ## write colwidth XML + ## write colwidth and coloutline XML if (length(colWidths[[i]]) > 0) { invisible(.self$setColWidths(i)) } + + if (length(colOutlineLevels[[i]]) > 0) { + invisible(.self$groupColumns(i)) + } } } ) @@ -3536,6 +3665,35 @@ ) } + 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]]) @@ -17971,8 +18129,9 @@ if (!missing(lockWindows) && !is.null(lockWindows)) { attr["lockWindows"] <- toString(as.numeric(lockWindows)) } + # TODO: Shall we parse the existing protection settings and preserve all unchanged attributes? if (protect) { - workbookProtection <<- + workbook$workbookProtection <<- sprintf( "", stri_join( @@ -17985,7 +18144,7 @@ ) ) } else { - workbookProtection <<- "" + workbook$workbookProtection <<- "" } } ) diff -Nru r-cran-openxlsx-4.1.5/R/workbook_column_widths.R r-cran-openxlsx-4.2.3/R/workbook_column_widths.R --- r-cran-openxlsx-4.1.5/R/workbook_column_widths.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/workbook_column_widths.R 2020-10-26 21:07:30.000000000 +0000 @@ -136,11 +136,33 @@ widths[missingAuto] <- 9.15 } - ## Calculate width of auto - colNodes <- sprintf('', cols, cols, widths, hidden) + # Check if any conflicting existing levels + if (any(cols %in% names(worksheets[[sheet]]$cols))) { - ## Append new col widths XML to worksheets[[sheet]]$cols - worksheets[[sheet]]$cols <<- append(worksheets[[sheet]]$cols, colNodes) + 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) + } + }) diff -Nru r-cran-openxlsx-4.1.5/R/worksheet_class.R r-cran-openxlsx-4.2.3/R/worksheet_class.R --- r-cran-openxlsx-4.1.5/R/worksheet_class.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/worksheet_class.R 2020-09-13 06:43:40.000000000 +0000 @@ -56,7 +56,7 @@ sheetPr <<- tabColour dimension <<- '' sheetViews <<- sprintf('', as.integer(zoom), as.integer(showGridLines), as.integer(tabSelected)) - sheetFormatPr <<- '' + sheetFormatPr <<- '' cols <<- character(0) autoFilter <<- character(0) @@ -204,14 +204,6 @@ ) } - - - - - - - - if (length(drawing) > 0) { xml <- paste0(xml, drawing, collapse = "") } diff -Nru r-cran-openxlsx-4.1.5/R/wrappers.R r-cran-openxlsx-4.2.3/R/wrappers.R --- r-cran-openxlsx-4.1.5/R/wrappers.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/wrappers.R 2020-10-26 21:07:30.000000000 +0000 @@ -35,34 +35,34 @@ 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)) } @@ -70,10 +70,12 @@ #' @name saveWorkbook #' @title save Workbook to file #' @description save a Workbook object to file -#' @author Alexander Walker +#' @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}} @@ -89,35 +91,48 @@ #' \dontrun{ #' saveWorkbook(wb, file = "saveWorkbookExample.xlsx", overwrite = TRUE) #' } -saveWorkbook <- function(wb, file, overwrite = FALSE) { +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() - file.copy(from = xlsx_file, to = file, overwrite = overwrite) - + + 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) - - invisible(1) + if(returnValue == FALSE){ + invisible(1) + }else{ + return(result) + } + } @@ -164,15 +179,15 @@ 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)) } @@ -189,11 +204,11 @@ 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) } @@ -213,14 +228,14 @@ 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)) } @@ -255,14 +270,14 @@ 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) } @@ -365,84 +380,84 @@ 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 (tolower(sheetName) %in% tolower(wb$sheet_names)) { - stop("A worksheet by that name already exists! Sheet names must be unique case-insensitive.") + 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("sheetName too long! Max length is 31 characters.") + 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, @@ -487,22 +502,22 @@ 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)) } @@ -543,11 +558,11 @@ 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)) } @@ -564,16 +579,16 @@ #' ## 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)) { @@ -581,9 +596,9 @@ d <- lapply(strsplit(col[charFlag], split = ""), function(x) match(rev(x), LETTERS)) col[charFlag] <- unlist(lapply(1:length(d), function(i) sum(d[[i]] * (26^(0:(length(d[[i]]) - 1L)))))) } - + col[!charFlag] <- as.integer(col[!charFlag]) - + return(as.integer(col)) } @@ -731,17 +746,17 @@ 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 <- getOption("openxlsx.dateFormat", getOption("openxlsx.dateformat", "date")) } else if (numFmt == "longdate") { @@ -749,10 +764,10 @@ } else if (!numFmt %in% validNumFmt) { numFmt <- replaceIllegalCharacters(numFmt_original) } - - - - + + + + numFmtMapping <- list( list("numFmtId" = 0), # GENERAL list("numFmtId" = 2), # NUMBER @@ -764,88 +779,88 @@ 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 @@ -853,7 +868,7 @@ bgFill <- validateColour(bgFill, "Invalid bgFill colour") style$fill <- append(style$fill, list(fillBg = list("rgb" = bgFill))) } - + ## foreground fill if (is.null(fgFill)) { fgFillList <- NULL @@ -861,98 +876,98 @@ 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" = 9999, formatCode = numFmt) ## Custom numFmt + 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) } @@ -1004,28 +1019,41 @@ 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) @@ -1038,8 +1066,8 @@ } 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) } @@ -1060,26 +1088,26 @@ 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)) - + "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]) } @@ -1129,22 +1157,22 @@ 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) { @@ -1152,20 +1180,20 @@ } 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)) } } @@ -1175,11 +1203,11 @@ if (grepl("in", units)) { d <- d * 2.54 } - + if (grepl("mm|milli", units)) { d <- d / 10 } - + return(d * 360000) } @@ -1199,6 +1227,7 @@ #' @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 @@ -1224,24 +1253,24 @@ 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 @@ -1250,11 +1279,11 @@ 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) } @@ -1262,10 +1291,10 @@ 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 } @@ -1299,27 +1328,27 @@ #' } 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) } @@ -1342,6 +1371,8 @@ #' #' 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 @@ -1369,45 +1400,45 @@ 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" } - + 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)) { @@ -1415,17 +1446,17 @@ 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 @@ -1434,14 +1465,33 @@ 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 @@ -1460,15 +1510,15 @@ #' } 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) { @@ -1507,9 +1557,9 @@ 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) { @@ -1535,6 +1585,7 @@ #' @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 @@ -1569,38 +1620,38 @@ 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") { @@ -1610,10 +1661,10 @@ } 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) } @@ -1648,19 +1699,19 @@ #' } 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 } @@ -1677,13 +1728,13 @@ #' 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) } @@ -1712,13 +1763,13 @@ 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) } @@ -1750,15 +1801,15 @@ #' } 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) } @@ -1790,14 +1841,14 @@ 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) } @@ -1822,7 +1873,7 @@ if (!"Workbook" %in% class(wb)) { stop("First argument must be a Workbook.") } - + wb$getBaseFont() } @@ -1906,44 +1957,44 @@ 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)) { @@ -1952,7 +2003,7 @@ x }) } - + hf <- list( oddHeader = naToNULLList(oddHeader), oddFooter = naToNULLList(oddFooter), @@ -1961,12 +2012,12 @@ firstHeader = naToNULLList(firstHeader), firstFooter = naToNULLList(firstFooter) ) - + if (all(sapply(hf, length) == 0)) { hf <- NULL } - - + + wb$worksheets[[sheet]]$headerFooter <- hf } @@ -2097,25 +2148,25 @@ 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] @@ -2126,34 +2177,34 @@ } 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) - + ## 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)), @@ -2165,7 +2216,7 @@ 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]), @@ -2178,20 +2229,20 @@ 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) @@ -2250,16 +2301,16 @@ if (!"Workbook" %in% class(wb)) { stop("First argument must be a Workbook.") } - + sheet <- wb$validateSheet(sheet) xml <- wb$worksheets[[sheet]]$sheetProtection - + props <- c() - + if (!missing(password) && !is.null(password)) { props["password"] <- hashPassword(password) } - + if (!missing(lockSelectingLockedCells) && !is.null(lockSelectingLockedCells)) { props["selectLockedCells"] <- toString(as.numeric(lockSelectingLockedCells)) } @@ -2305,7 +2356,7 @@ 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 = "")) @@ -2342,7 +2393,7 @@ if (!"Workbook" %in% class(wb)) { stop("First argument must be a Workbook.") } - + invisible(wb$protectWorkbook(protect = protect, password = password, lockStructure = lockStructure, lockWindows = lockWindows)) } @@ -2356,7 +2407,7 @@ #' @author Alexander Walker #' @param wb A workbook object #' @param sheet A name or index of a worksheet -#' @param showGridLines A logical. If \code{TRUE}, grid lines are hidden. +#' @param showGridLines A logical. If \code{FALSE}, grid lines are hidden. #' @export #' @examples #' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx")) @@ -2370,16 +2421,16 @@ 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 @@ -2388,7 +2439,7 @@ } else { sv <- gsub(" length(wb$worksheets))) { stop("Elements of order are greater than the number of worksheets") } - + wb$sheetOrder <- value - + invisible(wb) } @@ -2486,7 +2537,7 @@ if (origin == "1900-01-01") { x[notNa] <- x[notNa] - 2 } - + return(as.Date(x, origin = origin, ...)) } @@ -2508,25 +2559,25 @@ 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) } @@ -2562,31 +2613,31 @@ 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) } @@ -2642,27 +2693,27 @@ 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-Z0-9_\\.]", name[1], ignore.case = TRUE)) { @@ -2670,20 +2721,20 @@ } 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]) ) @@ -2744,22 +2795,22 @@ 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 <- xmlFiles[grepl("workbook.xml$", xmlFiles, perl = TRUE)] workbook <- unlist(readLines(workbook, warn = FALSE, encoding = "UTF-8")) - + dn <- getChildlessNode(xml = removeHeadTag(workbook), tag = "', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":")) - + invisible(wb) } @@ -2867,12 +2918,12 @@ 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) } @@ -2914,20 +2965,20 @@ #' } 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) wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "head"] <- as.character(text) } @@ -2961,20 +3012,20 @@ #' } 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) wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "foot"] <- as.character(text) } @@ -3061,18 +3112,18 @@ 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", @@ -3081,12 +3132,12 @@ "textLength", "list" ) - + if (!tolower(type) %in% tolower(valid_types)) { stop("Invalid 'type' argument!") } - - + + ## operator == 'between' we leave out valid_operators <- c( "between", @@ -3098,48 +3149,48 @@ "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, @@ -3167,9 +3218,9 @@ showErrorMsg = showErrorMsg )) } - - - + + + invisible(0) } @@ -3206,26 +3257,26 @@ 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 <- xmlFiles[grepl("workbook.xml$", xmlFiles, perl = TRUE)] workbook <- paste(unlist(readLines(workbook, warn = FALSE)), collapse = "") - + if (grepl('date1904="1"|date1904="true"', workbook, ignore.case = TRUE)) { origin <- "1904-01-01" } else { origin <- "1900-01-01" } - + return(origin) } @@ -3249,32 +3300,32 @@ 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 <- xmlFiles[grepl("workbook.xml$", xmlFiles, perl = TRUE)] workbook <- readLines(workbook, warn = FALSE, encoding = "UTF-8") 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) } @@ -3304,12 +3355,12 @@ 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) } @@ -3320,37 +3371,37 @@ 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 1:length(wb$worksheets)) { wb$workbook$sheets[i] <- gsub(exState0[i], value[i], wb$workbook$sheets[i], fixed = TRUE) } - + invisible(wb) } @@ -3383,23 +3434,23 @@ 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, @@ -3411,10 +3462,10 @@ sprintf('', i) ) } - - + + # wb$worksheets[[sheet]]$autoFilter <- sprintf('', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":")) - + invisible(wb) } @@ -3457,7 +3508,7 @@ 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" @@ -3466,62 +3517,62 @@ } 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 + startRow = min(rows), + endRow = max(rows), + startCol = min(cols), + endCol = max(cols), + dxfId, + formula = rule, + type = type )) - + invisible(0) } @@ -3537,8 +3588,8 @@ #' @param current A \code{Workbook} object #' @param ... ignored all.equal.Workbook <- function(target, current, ...) { - - + + # print("Comparing workbooks...") # ".rels", # "app", @@ -3558,92 +3609,92 @@ # "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)){ # @@ -3687,170 +3738,170 @@ # 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)) @@ -3858,37 +3909,37 @@ } } } - - + + 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", @@ -3896,7 +3947,7 @@ "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) { @@ -3905,51 +3956,51 @@ } } } - - + + 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", @@ -3963,8 +4014,8 @@ # "slicers", # "slicerCaches", # "vbaProject", - - + + return(TRUE) } @@ -3990,14 +4041,14 @@ #' @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) } @@ -4006,35 +4057,35 @@ #' @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) } @@ -4061,7 +4112,7 @@ if (!inherits(wb, "Workbook")) { stop("argument must be a Workbook.") } - + return(wb$copy()) } @@ -4088,28 +4139,28 @@ 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) } @@ -4155,56 +4206,297 @@ 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) + } +} @@ -4224,7 +4516,7 @@ if (!inherits(wb, "Workbook")) { stop("argument must be a Workbook.") } - + invisible(wb$addCreator(Creator)) } @@ -4243,7 +4535,7 @@ if (!inherits(wb, "Workbook")) { stop("argument must be a Workbook.") } - + invisible(wb$changeLastModifiedBy(LastModifiedBy)) } @@ -4265,6 +4557,6 @@ if (!inherits(wb, "Workbook")) { stop("argument must be a Workbook.") } - + return(wb$getCreators()) } diff -Nru r-cran-openxlsx-4.1.5/R/writeData.R r-cran-openxlsx-4.2.3/R/writeData.R --- r-cran-openxlsx-4.1.5/R/writeData.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/writeData.R 2020-09-13 06:43:40.000000000 +0000 @@ -20,7 +20,7 @@ #' 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{http://www.colorpicker.com}{here}). +#' @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} @@ -271,14 +271,20 @@ colClasss2 <- colClasses colClasss2[sapply(colClasses, function(x) "formula" %in% x) & sapply(colClasses, function(x) "hyperlink" %in% x)] <- "formula" + if (is.numeric(sheet)) { + sheetX <- wb$validateSheet(sheet) + } else { + sheetX <- wb$validateSheet(replaceXMLEntities(sheet)) + sheet <- replaceXMLEntities(sheet) + } - sheetX <- wb$validateSheet(sheet) if (wb$isChartSheet[[sheetX]]) { stop("Cannot write to chart sheet.") return(NULL) } + ## Check not overwriting existing table headers wb$check_overwrite_tables( sheet = sheet, diff -Nru r-cran-openxlsx-4.1.5/R/writeDataTable.R r-cran-openxlsx-4.2.3/R/writeDataTable.R --- r-cran-openxlsx-4.1.5/R/writeDataTable.R 2020-05-06 12:00:09.000000000 +0000 +++ r-cran-openxlsx-4.2.3/R/writeDataTable.R 2020-10-06 20:48:34.000000000 +0000 @@ -38,6 +38,7 @@ #' @seealso \code{\link{writeData}} #' @seealso \code{\link{removeTable}} #' @seealso \code{\link{getTables}} +#' @importFrom stats na.omit #' @export #' @examples #' ## see package vignettes for further examples. diff -Nru r-cran-openxlsx-4.1.5/README.md r-cran-openxlsx-4.2.3/README.md --- r-cran-openxlsx-4.1.5/README.md 2020-05-06 08:58:53.000000000 +0000 +++ r-cran-openxlsx-4.2.3/README.md 2020-09-13 06:43:40.000000000 +0000 @@ -4,7 +4,7 @@ [![Build Status](https://travis-ci.com/ycphs/openxlsx.svg?branch=master)](https://travis-ci.com/ycphs/openxlsx) [![AppVeyor build status](https://ci.appveyor.com/api/projects/status/github/ycphs/openxlsx?branch=master&svg=true)](https://ci.appveyor.com/project/ycphs/openxlsx) -[![Coverage Status](https://codecov.io/github/ycphs/openxlsx/coverage.svg?branch=master)](https://codecov.io/github/ycphs/openxlsx?branch=master) +[![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) diff -Nru r-cran-openxlsx-4.1.5/src/helper_functions.cpp r-cran-openxlsx-4.2.3/src/helper_functions.cpp --- r-cran-openxlsx-4.1.5/src/helper_functions.cpp 2020-05-06 08:47:22.000000000 +0000 +++ r-cran-openxlsx-4.2.3/src/helper_functions.cpp 2020-09-13 06:43:40.000000000 +0000 @@ -170,7 +170,7 @@ c++; } - r.attr("names") = names; + r.attr("names") = names; return wrap(r) ; } diff -Nru r-cran-openxlsx-4.1.5/src/load_workbook.cpp r-cran-openxlsx-4.2.3/src/load_workbook.cpp --- r-cran-openxlsx-4.1.5/src/load_workbook.cpp 2020-05-06 08:47:22.000000000 +0000 +++ r-cran-openxlsx-4.2.3/src/load_workbook.cpp 2020-10-26 21:07:30.000000000 +0000 @@ -16,6 +16,8 @@ List colWidths(n_sheets); List rowHeights(n_sheets); List wbstyleObjects(0); + List outlineLevels(n_sheets); + List colOutlineLevels(n_sheets); // loop over each worksheet file for(int i = 0; i < n_sheets; i++){ @@ -24,11 +26,15 @@ colWidths[i] = List(0); rowHeights[i] = List(0); + outlineLevels[i] = List(0); + colOutlineLevels[i] = List(0); }else{ colWidths[i] = List(0); rowHeights[i] = List(0); + outlineLevels[i] = List(0); + colOutlineLevels[i] = List(0); Reference this_worksheet(worksheets[i]); Reference sheet_data(this_worksheet.field("sheet_data")); @@ -97,17 +103,23 @@ if(cols.size() > 0){ NumericVector widths; - IntegerVector columns; - CharacterVector column_hidden; + IntegerVector columns_with_widths; + IntegerVector columns_with_groups; + CharacterVector column_hidden; + CharacterVector col_outline; + CharacterVector col_hidden; - for(size_t ci = 0; ci < cols.size(); ci++){ + for (size_t ci = 0; ci < cols.size(); ci++) { double tmp_width = 0; std::string tmp_hidden; int min_c = 0; int max_c = 0; + std::string tmp_coloutline; + buf = cols[ci]; - if(buf.find("customWidth", 0) != string::npos){ + // If either custom widths or groupings, get column index + if ((buf.find("customWidth", 0) != string::npos) | (buf.find("outlineLevel", 0) != string::npos)) { tmp_pos = buf.find("min=\"", 0); endPos = buf.find(tagEnd, tmp_pos + 5); @@ -116,43 +128,79 @@ tmp_pos = buf.find("max=\"", 0); endPos = buf.find(tagEnd, tmp_pos + 5); max_c = atoi(buf.substr(tmp_pos + 5, endPos - tmp_pos - 5).c_str()); - - tmp_pos = buf.find("width=\"", 0); - endPos = buf.find(tagEnd, tmp_pos + 7); - tmp_width = atof(buf.substr(tmp_pos + 7, endPos - tmp_pos - 7).c_str()) - 0.71; - + tmp_pos = buf.find("hidden=\"", 0); - if(tmp_pos != string::npos){ + + if (tmp_pos != string::npos) { endPos = buf.find(tagEnd, tmp_pos + 8); tmp_hidden = buf.substr(tmp_pos + 8, endPos - tmp_pos - 8); - }else{ + } else { tmp_hidden = "0"; } - - while(min_c <= max_c){ - widths.push_back(tmp_width); - columns.push_back(min_c); - column_hidden.push_back(tmp_hidden); - min_c++; - } + // If column has both a custom width and is part of a group + if ((buf.find("customWidth", 0) != string::npos) & (buf.find("outlineLevel", 0) != string::npos)) { + tmp_pos = buf.find("width=\"", 0); + endPos = buf.find(tagEnd, tmp_pos + 7); + tmp_width = atof(buf.substr(tmp_pos + 7, endPos - tmp_pos - 7).c_str()) - 0.71; + + tmp_pos = buf.find("outlineLevel=\"", 0); + endPos = buf.find(tagEnd, tmp_pos + 14); + tmp_coloutline = buf.substr(tmp_pos + 14, endPos - tmp_pos - 14); + + while (min_c <= max_c) { + widths.push_back(tmp_width); + columns_with_widths.push_back(min_c); + columns_with_groups.push_back(min_c); + column_hidden.push_back(tmp_hidden); + col_hidden.push_back(tmp_hidden); + col_outline.push_back(tmp_coloutline); + min_c++; + } + + } else if (buf.find("customWidth", 0) != string::npos) { // Column only has a custom width + + tmp_pos = buf.find("width=\"", 0); + endPos = buf.find(tagEnd, tmp_pos + 7); + tmp_width = atof(buf.substr(tmp_pos + 7, endPos - tmp_pos - 7).c_str()) - 0.71; + + while (min_c <= max_c) { + widths.push_back(tmp_width); + columns_with_widths.push_back(min_c); + column_hidden.push_back(tmp_hidden); + min_c++; + } + } else { // Column is only part of a group + + tmp_pos = buf.find("outlineLevel=\"", 0); + endPos = buf.find(tagEnd, tmp_pos + 14); + tmp_coloutline = buf.substr(tmp_pos + 14, endPos - tmp_pos - 14); + while (min_c <= max_c) { + columns_with_groups.push_back(min_c); + col_hidden.push_back(tmp_hidden); + col_outline.push_back(tmp_coloutline); + min_c++; + } + } } - } - if(widths.size() > 0){ + if (widths.size() > 0) { CharacterVector tmp_widths(widths); - tmp_widths.attr("names") = columns; + tmp_widths.attr("names") = columns_with_widths; tmp_widths.attr("hidden") = column_hidden; colWidths[i] = tmp_widths; } - + + if (col_outline.size() > 0) { + CharacterVector columns_outline(col_outline); + columns_outline.attr("names") = columns_with_groups; + columns_outline.attr("hidden") = col_hidden; + colOutlineLevels[i] = columns_outline; + } } - - - /* --- Everything after sheetData --- */ size_t pos_post = 0; if(has_data){ @@ -524,6 +572,8 @@ CharacterVector rowNumbers(row_ocs); CharacterVector heights(row_ocs); + CharacterVector outlines(row_ocs); + CharacterVector outline_hidden(row_ocs); // PULL OUT CELL AND ATTRIBUTES @@ -531,6 +581,7 @@ pos = xml.find(" 0){ - heights = heights[!is_na(heights)]; - heights.attr("names") = rowNumbers; - rowHeights[i] = heights; + CharacterVector heightsRows(rowNumbers); + CharacterVector outlineRows(rowNumbers); + + heightsRows = heightsRows[!is_na(heights)]; + if (heightsRows.size() > 0) { + heights = heights[!is_na(heights)]; + heights.attr("names") = heightsRows; + rowHeights[i] = heights; } + + outlineRows = outlineRows[!is_na(outlines)]; + if (outlineRows.size() > 0) { + outline_hidden = outline_hidden[!is_na(outline_hidden)]; + outlines = outlines[!is_na(outlines)]; + outlines.attr("names") = outlineRows; + outlines.attr("hidden") = outline_hidden; + outlineLevels[i] = outlines; + } + + // styleObjects std::string this_sheetname = as(sheetNames[i]); @@ -634,6 +730,8 @@ wb.field("rowHeights") = rowHeights; wb.field("colWidths") = colWidths; wb.field("styleObjects") = wbstyleObjects; + wb.field("outlineLevels") = outlineLevels; + wb.field("colOutlineLevels") = colOutlineLevels; return wrap(wb); diff -Nru r-cran-openxlsx-4.1.5/src/openxlsx_init.c r-cran-openxlsx-4.2.3/src/openxlsx_init.c --- r-cran-openxlsx-4.1.5/src/openxlsx_init.c 2020-05-06 08:47:22.000000000 +0000 +++ r-cran-openxlsx-4.2.3/src/openxlsx_init.c 2020-10-05 07:15:57.000000000 +0000 @@ -41,7 +41,7 @@ extern SEXP _openxlsx_read_file_newline(SEXP); extern SEXP _openxlsx_read_workbook(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _openxlsx_write_worksheet_xml(SEXP, SEXP, SEXP, SEXP); -extern SEXP _openxlsx_write_worksheet_xml_2(SEXP, SEXP, SEXP, SEXP, SEXP); +extern SEXP _openxlsx_write_worksheet_xml_2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP _openxlsx_write_file(SEXP, SEXP, SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { @@ -77,7 +77,7 @@ {"_openxlsx_read_file_newline", (DL_FUNC) &_openxlsx_read_file_newline, 1}, {"_openxlsx_read_workbook", (DL_FUNC) &_openxlsx_read_workbook, 11}, {"_openxlsx_write_worksheet_xml", (DL_FUNC) &_openxlsx_write_worksheet_xml, 4}, - {"_openxlsx_write_worksheet_xml_2", (DL_FUNC) &_openxlsx_write_worksheet_xml_2, 5}, + {"_openxlsx_write_worksheet_xml_2", (DL_FUNC) &_openxlsx_write_worksheet_xml_2, 6}, {"_openxlsx_write_file", (DL_FUNC) &_openxlsx_write_file, 4}, {NULL, NULL, 0} }; diff -Nru r-cran-openxlsx-4.1.5/src/RcppExports.cpp r-cran-openxlsx-4.2.3/src/RcppExports.cpp --- r-cran-openxlsx-4.1.5/src/RcppExports.cpp 2020-05-06 14:52:47.000000000 +0000 +++ r-cran-openxlsx-4.2.3/src/RcppExports.cpp 2020-10-26 21:11:40.000000000 +0000 @@ -430,17 +430,18 @@ END_RCPP } // write_worksheet_xml_2 -SEXP write_worksheet_xml_2(std::string prior, std::string post, Reference sheet_data, CharacterVector row_heights, std::string R_fileName); -RcppExport SEXP _openxlsx_write_worksheet_xml_2(SEXP priorSEXP, SEXP postSEXP, SEXP sheet_dataSEXP, SEXP row_heightsSEXP, SEXP R_fileNameSEXP) { +SEXP write_worksheet_xml_2(std::string prior, std::string post, Reference sheet_data, Nullable row_heights_, Nullable outline_levels_, std::string R_fileName); +RcppExport SEXP _openxlsx_write_worksheet_xml_2(SEXP priorSEXP, SEXP postSEXP, SEXP sheet_dataSEXP, SEXP row_heights_SEXP, SEXP outline_levels_SEXP, SEXP R_fileNameSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type prior(priorSEXP); Rcpp::traits::input_parameter< std::string >::type post(postSEXP); Rcpp::traits::input_parameter< Reference >::type sheet_data(sheet_dataSEXP); - Rcpp::traits::input_parameter< CharacterVector >::type row_heights(row_heightsSEXP); + Rcpp::traits::input_parameter< Nullable >::type row_heights_(row_heights_SEXP); + Rcpp::traits::input_parameter< Nullable >::type outline_levels_(outline_levels_SEXP); Rcpp::traits::input_parameter< std::string >::type R_fileName(R_fileNameSEXP); - rcpp_result_gen = Rcpp::wrap(write_worksheet_xml_2(prior, post, sheet_data, row_heights, R_fileName)); + rcpp_result_gen = Rcpp::wrap(write_worksheet_xml_2(prior, post, sheet_data, row_heights_, outline_levels_, R_fileName)); return rcpp_result_gen; END_RCPP } @@ -479,7 +480,7 @@ {"_openxlsx_buildMatrixMixed", (DL_FUNC) &_openxlsx_buildMatrixMixed, 8}, {"_openxlsx_matrixRowInds", (DL_FUNC) &_openxlsx_matrixRowInds, 1}, {"_openxlsx_build_table_xml", (DL_FUNC) &_openxlsx_build_table_xml, 6}, - {"_openxlsx_write_worksheet_xml_2", (DL_FUNC) &_openxlsx_write_worksheet_xml_2, 5}, + {"_openxlsx_write_worksheet_xml_2", (DL_FUNC) &_openxlsx_write_worksheet_xml_2, 6}, {NULL, NULL, 0} }; diff -Nru r-cran-openxlsx-4.1.5/src/read_workbook.cpp r-cran-openxlsx-4.2.3/src/read_workbook.cpp --- r-cran-openxlsx-4.1.5/src/read_workbook.cpp 2020-05-06 08:47:22.000000000 +0000 +++ r-cran-openxlsx-4.2.3/src/read_workbook.cpp 2020-10-27 09:06:30.000000000 +0000 @@ -572,7 +572,7 @@ }else{ // else col_names is FALSE char name[6]; - for(unsigned short i =0; i < nCols; i++){ + for(int i =0; i < nCols; i++){ sprintf(&(name[0]), "X%hu", i+1); // snprintf(&(name[0]), sizeof(&(name[0])), "X%d", i+1); // sprintf(&(name[0]), "X%u", i+1); diff -Nru r-cran-openxlsx-4.1.5/src/write_file_2.cpp r-cran-openxlsx-4.2.3/src/write_file_2.cpp --- r-cran-openxlsx-4.1.5/src/write_file_2.cpp 2020-05-06 08:47:22.000000000 +0000 +++ r-cran-openxlsx-4.2.3/src/write_file_2.cpp 2020-09-13 06:43:40.000000000 +0000 @@ -7,9 +7,11 @@ SEXP write_worksheet_xml_2( std::string prior , std::string post , Reference sheet_data - , CharacterVector row_heights - , std::string R_fileName){ + , Nullable row_heights_ = R_NilValue + , Nullable outline_levels_ = R_NilValue + , std::string R_fileName = "output"){ + // open file and write header XML const char * s = R_fileName.c_str(); std::ofstream xmlFile; @@ -29,7 +31,7 @@ } - // sheet_data will be in order, jsut need to check for row_heights + // sheet_data will be in order, just need to check for row_heights CharacterVector cell_col = int_2_cell_ref(sheet_data.field("cols")); CharacterVector cell_types = map_cell_types_to_char(sheet_data.field("t")); CharacterVector cell_value = sheet_data.field("v"); @@ -37,11 +39,28 @@ CharacterVector style_id = sheet_data.field("style_id"); CharacterVector unique_rows(sort_unique(cell_row)); - - - CharacterVector row_heights_rows = row_heights.attr("names"); - size_t n_row_heights = row_heights.size(); - + + CharacterVector row_heights; + CharacterVector row_heights_rows; + size_t n_row_heights = 0; + + CharacterVector outline_levels; + CharacterVector outline_levels_rows; + CharacterVector outline_levels_hidden; + size_t n_outline_levels = 0; + + if (row_heights_.isNotNull()) { + row_heights = row_heights_; + row_heights_rows = row_heights.attr("names"); + n_row_heights = row_heights.size(); + } + + if (outline_levels_.isNotNull()) { + outline_levels = outline_levels_; + outline_levels_rows = outline_levels.attr("names"); + outline_levels_hidden = outline_levels.attr("hidden"); + n_outline_levels = outline_levels.size(); + } size_t n = cell_row.size(); size_t k = unique_rows.size(); @@ -50,6 +69,7 @@ size_t j = 0; size_t h = 0; + size_t l = 0; String current_row = unique_rows[0]; bool row_has_data = true; @@ -111,32 +131,63 @@ current_row = cell_row[j]; } - - - if(h < n_row_heights){ - - if((unique_rows[i] == row_heights_rows[h]) & row_has_data){ // this row has a row height and cell_xml data - - xmlFile << "" + cell_xml + ""; - h++; - - }else if(row_has_data){ - + + if ((h < n_row_heights) && (!Rf_isNull(row_heights_))) { // If there are custom row heights + + if ((l < n_outline_levels) && (!Rf_isNull(outline_levels_))) { // If there are grouped rows + + if ((unique_rows[i] == row_heights_rows[h]) && (unique_rows[i] == outline_levels_rows[l]) && row_has_data) { + // Row is grouped and has a custom height + xmlFile << ""; + h++; + l++; + } else if ((unique_rows[i] == outline_levels_rows[l]) && row_has_data) { + xmlFile << ""; + l++; + } else if ((unique_rows[i] == row_heights_rows[h]) && row_has_data) { + // Row has custom height + xmlFile << "" + cell_xml + ""; + h++; + } else if (row_has_data) { + // Row has data + xmlFile << "" + cell_xml + ""; + } else { + xmlFile << "