# exportXLS.r ## Depends on source("~/git/misc/rscripts/utils/WriteXLS2.R") ## NOTE: Current the version using WriteXLS requires excel to be installed on the machine. Thus created alternate version using XLConnect if (FALSE) { ## This was an attempt to read the styles from a sheet, but it did not work stopifnot(lib(XLConnect)) file <- "/Users/rsaporta/git/misc/rscripts/utils/xls/cell_styles_example.xlsx" wb <- loadWorkbook(file, create=FALSE) existingSheets <- getSheets(wb) getCellStyle(wb, ) } .createFormatStylesForWB <- function(wb) { # REFERENCE: # http://www.exceltactics.com/definitive-guide-custom-number-formats-excel/#Understanding-the-Number-Format-Codes # http://amunategui.github.io/excel-data-dumps/ if (missing(wb)) stop("'wb' cannot be missing\nHINT: A loaded workbook must be passed to function .createFormatStylesForWB()", call.=FALSE) orig_args <- collectArgs() header <- createCellStyle(wb) setBorder(header, side = c("bottom"), type = XLC$BORDER.THICK, color = c(XLC$COLOR.BLACK)) setFillBackgroundColor(header, color=XLC$COLOR.CORNFLOWER_BLUE) # setFillPattern(header, fill = XLC$FILL.NO_FILL) percentage_twodec <- createCellStyle(wb) setDataFormat(percentage_twodec, format="#,##0.00 %") percentage_twodec_dontdivide <- createCellStyle(wb) setDataFormat(percentage_twodec_dontdivide, format="#,##0.00\\%") date_std <- createCellStyle(wb) setDataFormat(date_std, format="yyyy-mm-dd") datetime_std <- createCellStyle(wb) setDataFormat(datetime_std, format="yyyy-mm-dd hh:mm:ss") USD_twodec <- createCellStyle(wb) setDataFormat(USD_twodec, format="$#,##0.00") USD_nodec <- createCellStyle(wb) setDataFormat(USD_nodec, format="$#,##0.00") USD_milions <- createCellStyle(wb) setDataFormat(USD_milions, format="$#,##0.000,,\" M\"") EUR_twodec <- createCellStyle(wb) setDataFormat(EUR_twodec, format="\"€\" #,##0.00") EUR_nodec <- createCellStyle(wb) setDataFormat(EUR_twodec, format="\"€\" #,##0") EUR_millions <- createCellStyle(wb) setDataFormat(EUR_millions, format="\"€\" #,##0.000,,\" M\"") numeric_comma <- createCellStyle(wb) setDataFormat(numeric_comma, format="#,##0.000") numeric_comma <- createCellStyle(wb) setDataFormat(numeric_comma, format="#,##0.000") numeric_no_comma <- createCellStyle(wb) setDataFormat(numeric_comma, format="###0.000") integer_comma <- createCellStyle(wb) setDataFormat(integer_comma, format="#,###") integer_no_comma <- createCellStyle(wb) setDataFormat(integer_comma, format="####") id_column <- createCellStyle(wb) setDataFormat(id_column, format="#") new_args <- collectArgs() ret <- new_args %>% {.[setdiff(names(.), names(orig_args))]} return(invisible(ret)) } .get_max_rows_allowed_in_excel_sheet <- function(file_name_with_ext) { ## Returns the maxium number of rows in a sheet as allowed by Excel n.xlsx <- 1048576 # 2^20 n.xls <- 65536 # 2^16 ## shorthand function g <- function(pattern) grepl(pattern, file_name_with_ext, ignore.case=TRUE) ## check for xlsx, then xls; Otherwise, unknown, assume to be xlsx ifelse(g("\\.xlsx$"), n.xlsx, ifelse(g("\\.xls$"), n.xls, {warning("Unsure of excel file type (and hence max rows) for filename '", file_name_with_ext, "' -- assuming it is of xlsx type", call.=FALSE); n.xlsx} )) } .get_max_cols_allowed_in_excel_sheet <- function(file_name_with_ext) { ## Returns the maxium number of columns in a sheet as allowed by Excel n.xlsx <- 16384 # 2^14 ## I can't find any reference to smaller column lengths for xls files n.xls <- 16384 # 2^14 ## shorthand function g <- function(pattern) grepl(pattern, file_name_with_ext, ignore.case=TRUE) ## check for xlsx, then xls; Otherwise, unknown, assume to be xlsx ifelse(g("\\.xlsx$"), n.xlsx, ifelse(g("\\.xls$"), n.xls, {warning("Unsure of excel file type (and hence max rows) for filename '", file_name_with_ext, "' -- assuming it is of xlsx type", call.=FALSE); n.xlsx} )) } exportXLS.usingXLConnect <- function(f.out, DTs.list, clean_col_names=TRUE, percCols.thresh.for.values.gt.1=.8, templateFile="~/git/misc/rscripts/utils/xls/Notes/blank_wb_with_styles.xlsx", zArchive_existing=TRUE, verbose=TRUE) { ## percCols.thresh.for.values.gt.1 :: what percentage of a column's value must be less than 1 to (along with a name match) be considered percent col ## use percCols.thresh.for.values.gt.1 = 1 to indicate that ONLY name match is needed stopifnot(lib(XLConnect, quietly=TRUE)) cat("Performing garbage cleanup ... "); gcQuietly(verbose=FALSE); catn(" [DONE].") if (length(f.out) != 1) stop("argument 'file' should be length exactly one") zArchive_if_flagged(f.out, flag=zArchive_existing) if (file.exists(f.out)) stop("file '", f.out, "' exists already") n_max_rows <- .get_max_rows_allowed_in_excel_sheet(f.out) n_max_cols <- .get_max_cols_allowed_in_excel_sheet(f.out) ## flag, whether to use templateFile or not use_templatefile <- !is.null(templateFile) && file.exists(templateFile) if (is.data.table(DTs.list)) { DTs.list <- list(DTs.list) } if (!exists(dirname(f.out))) dir.create(dirname(f.out), showWarnings=FALSE) if (is.character(DTs.list)) { ## The whole list should be names of data.tables stopifnot(sapply(DTs.list, function(DT.nm) exists(DT.nm) && is.data.table(get(DT.nm)))) DTs.list <- setNames(nm=DTs.list, obj=gapply(DTs.list)) } sheets <- names(DTs.list) if (is.null(sheets)) sheets <- sprintf("Sheet%i", seq(DTs.list)) ## length of each individual sheetname cannot exceed 31 chars sheets %<>% substr(1, 31) browser(expr=inDebugMode(c("exportXLS", "exportXLS.usingXLConnect")), text="in exportXLS.usingXLConnect") if (use_templatefile) file.copy(templateFile, f.out) wb <- loadWorkbook(f.out, create=!file.exists(f.out)) ## Column Fromatting for numerics # setDataFormatForType(wb, type = XLC$"DATA_TYPE.NUMERIC", format = numeric.format) # setStyleAction(wb, XLC$"STYLE_ACTION.DATATYPE") # no longer used # if (FALSE) { # no longer used # # no longer used # # Create a new cell style to be used # no longer used # cs <- createCellStyle(wb, name = "mydec") # no longer used # # no longer used # # Set data format (number format) as numbers with aligned fractions # no longer used # setDataFormat(cs, format = "#,###,###,###,###.0") # no longer used # # no longer used # # Define the above created cell style as style to be used for numerics # no longer used # setCellStyleForType(wb, type = XLC$"DATA_TYPE.NUMERIC", style=cs) # no longer used # # Could also say cs <- setCellStyleForType(wb, "numeric") # no longer used # } ## -------------------- Style with White Background -------------------------- ## ## This doesn't work due to memory issues if (FALSE) { # Create a custom anonymous cell style cs.white_bg <- createCellStyle(wb) # Specify the fill background color for the cell style created above setFillBackgroundColor(cs.white_bg, color = XLC$"COLOR.WHITE") # Specify the fill foreground color setFillForegroundColor(cs.white_bg, color = XLC$"COLOR.BLACK") # # Specify the fill pattern # setFillPattern(cs.white_bg, fill = XLC$"FILL.BIG_SPOTS") } ## -------------------- Style with White Background -------------------------- ## ## -------------------- SHEETS -------------------------- ## existingSheets <- getSheets(wb) ## If there are no existing sheets already, then make sheet names propper. (Dont do this if some sheets exist, becuase might create unintended duplicate sheets: "hello_world" vs "Hello World") if (!length(setdiff(existingSheets, "DELETEME"))) sheets %<>% topropper_keywords() ## Create any missing sheets createSheet(wb, setdiff(sheets, existingSheets)) ## Set sheet styles and background color for (sheet in sheets) { setStyleAction(wb, XLC$"STYLE_ACTION.DATATYPE") # setCellStyle(wb, cellstyle=cs.white_bg, formula=sprintf("%s!A1:XFD%i", sheet, n_max_rows)) # setCellStyle(wb, sheet=sheet, row = 1:n_max_rows, col = 1:n_max_cols, cellstyle = cs.white_bg) } ## -------------------- SHEETS -------------------------- ## # Set style action to 'datatype' setStyleAction(wb, XLC$"STYLE_ACTION.DATATYPE") ## Create all the necessary cell styles cell_styles <- .createFormatStylesForWB(wb) ## Excel-style alphabetical indecies for columns col_indx <- CJ(c(LETTERS, ""), LETTERS)[, paste0(V1, V2)] # now iterating # do.call(writeWorksheet, list(object=wb, data=DTs.list, sheet=sheets, header=TRUE, rownames=NULL)) # now iterating # ## set Width # now iterating # for (i in seq(sheets)) # now iterating # setColumnWidth(wb, sheet=sheets[[i]], column=seq(DTs.list[[i]]), width=-1) for (i in seq_along(DTs.list)) { sheet <- sheets[[i]] DT <- DTs.list[[i]] verboseMsg(verbose, "Writing to sheet '", sheet, "'", sep="") if (nrow(DT) > n_max_rows) warning ("Rows in DT (", nrow(DT), ") exceeds max allowed for by excel (", n_max_rows, ")") if (ncol(DT) > 26*27) warning ("DT has more than 702 columns; col_indx only goes up to 'ZZ'; Formatting may be off") ## Optionally modify the column names to output more cleaner if (clean_col_names) { nms_bak <- copy(names(DT)) setnamestopropper(DT) on.exit(setnames(DT, nms_bak)) } ## POSIXct cols that are NOT UTC will need to be converted ## DATE cols will need to be converted dateCols <- nwhich(sapply(DT, is.Date)) posixCols <- nwhich(sapply(DT, is.POSIX)) wh.to_convert_tz <- nwhich("" == sapply(DT, get_tz, showWarnings=FALSE)) if (length(dateCols) || length(wh.to_convert_tz)) { message("Taking a deep copy of DT before exporting to XLSX since it has either (a) DATE column(s) or (b) POSIX column(s) without a timezone, and these columns need to be changed to POSIXct with 'UTC'") DT <- copy(DT) ## CONVERT if (length(dateCols)) DT[, (dateCols) := lapply(.SD, function(x) as.POSIXct(x, tz="UTC") %>% as.tz(tz="UTC")), .SDcols=dateCols] if (length(wh.to_convert_tz)) DT[, (wh.to_convert_tz) := lapply(.SD, function(x) x %>% as.tz(tz="UTC")), .SDcols=wh.to_convert_tz] } ## WRITE TO EXCEL writeWorksheet(object=wb, data=DT, sheet=sheet, header=TRUE, rownames=NULL) ## Note that the last part for formula (the min(nrow...) part) is only necessary because we are not able to ## simply select a whole column; If that becomes possible, use that option instead mk_formula <- {. %>% {if (!is.logical(.)) (names(DT) %in% .) else .} %>% which %>% {col_indx[.]} %>% sprintf("%s!%s%i:%s%i", sheet, ., 2, ., min(nrow(DT)*2, nrow(DT)+1000, n_max_rows) )} ## Add Styles if (any(percCols <- detectPercentColumns(DT, thresh.for.values.gt.1=percCols.thresh.for.values.gt.1))) capture.output( setCellStyle(object=wb, formula=mk_formula(percCols), cellstyle=cell_styles[["percentage_twodec"]]) ) if (any(idCols <- detectIDColumns(DT))) capture.output( setCellStyle(object=wb, formula=mk_formula(idCols), cellstyle=cell_styles[["id_column"]]) ) if (any(usdCols <- detectUSDColumns(DT))) capture.output( setCellStyle(object=wb, formula=mk_formula(usdCols), cellstyle=cell_styles[["USD_twodec"]]) ) if (any(eurCols <- detectEURColumns(DT))) capture.output( setCellStyle(object=wb, formula=mk_formula(eurCols), cellstyle=cell_styles[["EUR_twodec"]]) ) ## DATE and POSIX columns have already been identified, above. if (length(dateCols)) capture.output( setCellStyle(object=wb, formula=mk_formula(dateCols), cellstyle=cell_styles[["date_std"]]) ) if (length(posixCols)) capture.output( setCellStyle(object=wb, formula=mk_formula(posixCols), cellstyle=cell_styles[["datetime_std"]]) ) ## NEXT, check to see which are integer or numerics; Explicitly exclude any column whose type has already been identified non_numeric <- c(percCols, idCols, usdCols, eurCols) %>% nwhich %>% c(dateCols, posixCols) intCols <- canBeInteger(DT, ignoreIntegers=FALSE) %>% nwhich %>% setdiff(non_numeric) if (length(intCols)) capture.output( setCellStyle(object=wb, formula=mk_formula(intCols), cellstyle=cell_styles[["integer_comma"]]) ) numbCols <- sapply(DT, is.numeric) %>% nwhich %>% setdiff(non_numeric) %>% setdiff(intCols) if (length(numbCols)) capture.output( setCellStyle(object=wb, formula=mk_formula(numbCols), cellstyle=cell_styles[["numeric_comma"]]) ) setRowHeight(wb, sheet=sheet, row=1, height=30) setColumnWidth(wb, sheet=sheet, column=seq(DT), width=-1) ## TODO -- some columns should be smaller than their "auto" size (ie, track names, integer columns) ## I Need to test this out still if (FALSE) { ## int columns get recalculated for (intCol in intCols) setColumnWidth(wb, sheet=sheet, column=names(DT) == intCol, width=256*mnchar(DT[[intCol]])) nms_dt <- names(DT) print(nms_dt == "Release Name") if ("Release Name" %in% nms_dt) { setColumnWidth(wb, sheet=sheet, column=(nms_dt == "Release Name"), width=256*64) } if ("Track Name" %in% nms_dt) { setColumnWidth(wb, sheet=sheet, column=(nms_dt == "Track Name"), width=256*75) } } ## since background is not working, using cell_style[["header"]] is worse than using no style at all for header ## hence this outter if clause. Once this bug is fixed, can remove this clause if (use_templatefile) { ## use the templated header if available h1 <- if (use_templatefile) getCellStyle(wb, "Header") else cell_styles[["header"]] setCellStyle(wb, sheet=sheet, row=1, col=seq(ncol(DT)), cellstyle=h1) } if (ncol(DT)) { # setCellStyle(wb, sheet=sheet, row=1, col=seq(ncol(DT)), cellstyle=cell_styles[["header"]]) createFreezePane(wb, sheet=sheet, rowSplit=2, topRow=2, colSplit=1, leftColumn=1) } } if ("DELETEME" %in% existingSheets) removeSheet(wb, "DELETEME") saveWorkbook(wb) return(invisible(f.out)) } if (FALSE) { setBorder(h1, side = c("bottom"), type = XLC$"BORDER.THICK", color = c(XLC$"COLOR.DARK_BLUE")) setBorder(h2, side = c("right"), type = XLC$"BORDER.THIN", color = c(XLC$"COLOR.ORCHID")) } if (FALSE) { fresh(verbose=FALSE, notify=FALSE) setScience(proj="Looker", subProj="test", subl=FALSE, quiet=TRUE) lib(XLConnect, quietly=TRUE) gc() ftest <- "/Users/rsaporta/Dropbox/The Orchard/Analytics Department/Outbound Reports/TEST/test_20151001_182739.xlsx" wb <- loadWorkbook(ftest) catn("Loaded") sheet <- getSheets(wb)[[1]] h1 <- createCellStyle(wb, name=timeStamp("header_1")) setFillPattern(h1, fill = XLC$FILL.SOLID_FOREGROUND) setFillBackgroundColor(h1, color=XLC$"COLOR.PALE_BLUE") setFillForegroundColor(h1, color=XLC$"COLOR.RED") h2 <- createCellStyle(wb, name=timeStamp("header_2")) setFillPattern(h2, fill = XLC$FILL.ALT_BARS) setFillBackgroundColor(h2, color=XLC$COLOR.CORNFLOWER_BLUE) setCellStyle(wb, sheet=sheet, row=1:3, col=1:3, cellstyle=h1) setCellStyle(wb, sheet=sheet, row=2:5, col=3:6, cellstyle=h2) setCellStyle(wb, sheet=sheet, row=10, col=4:10, cellstyle=h2) setCellStyle(wb, sheet=sheet, row=11:12, col=4:10, cellstyle=h2) saveWorkbook(wb); rm(wb); .o(ftest); gc() } # > csHeader = createCellStyle(wb, name = "header") # > setFillPattern(csHeader, fill = XLC$FILL.SOLID_FOREGROUND) # > setFillForegroundColor(csHeader, color = XLC$COLOR.GREY_25_PERCENT) # # > setCellStyle(wb, sheet = sheet, row = 1, # + col = seq(length.out = ncol(curr)), # + cellstyle = csHeader) showColors.XLC <- function() { xlc_colors <- extract("color", names(XLConnect::XLC)) ordered <- c() for (color in list("automatic", c("white", "black", "grey"), c("yellow", "orange", "red"), c("green"), c("blue", "indigo", "turquoise", "teal", "aqua"), c("purple", "lavender", "plum"))) { # ordered %<>% {c(., "", extract(color, xlc_colors))} print(color) # print(unlist(sapply(color, extract, xlc_colors))) ordered %<>% {c(., "\n", unlist(lapply(color, extract, xlc_colors)))} print(length(ordered)) invisible() } ret <- xlc_colors %>% setdiff(ordered) %>% c(ordered, .) removeText("COLOR\\.", ret) %>% catn(sep="\n") return(invisible(removeNullsAndBlanksFromList(ret))) } ### ------- exportXLS.usingWriteXLS <- function(DT.nms , f.name=getProjName(), ext="xlsx", stamp=TRUE, dir=getOutDir() , SheetNames=names(DT.nms), clean.SheetNames=TRUE ## These arguments are aesthetics, that the user might want to modify , AdjWidth=TRUE, AutoFilter=FALSE, BoldHeaderRow=TRUE, FreezeRow=0, FreezeCol=0 ## These might need moding, but genreally static , row.names=FALSE, col.names=TRUE, perl = "perl", Encoding=c("UTF-8", "latin1") , envir = globalenv() , logfile=NULL , showWarnings=TRUE , verbose=showWarnings ){ ## Note on ext: XLSX allows larger data than XLS suppressPackageStartupMessages(lib(WriteXLS)) source(as.path(getOption("baseDir", default="~/git/misc/rscripts"), "utils", "xls", "WriteXLS2.r")) if (!length(DT.nms)) stop("DT.nms cannot be empty.") ### SHEET NAMES ### if (clean.SheetNames) { if (is.null(SheetNames)) { nms <- substitute(DT.nms) if (nms[[1]]== "list" && length(nms[-1]) == length(DT.nms)) SheetNames <- as.character(nms[-1]) } if (length(SheetNames) < length(DT.nms)) { if (length(SheetNames) == 1) SheetNames <- sprintf("%s_%02i", SheetNames, seq_along(DT.nms)) else SheetNames[seq_along(DT.nms)+3] SheetNames <- SheetNames[seq_along(1:5)] } SheetNames <- gsub("^D[TB]\\.", "", SheetNames) blanks <- SheetNames=="" | is.na(SheetNames) SheetNames[blanks] <- {sprintf("Sheet %02i", seq_along(DT.nms))} [blanks] ## Sheet names can only be a max of 31 Chars. So clean them SheetNames <- trimToNChars(SheetNames, 31) ## Sheet names cannot contain "[" or "]" SheetNames <- gsub("\\[", "(", gsub("\\]", ")", SheetNames)) SheetNames <- gsub("\\*|\\?|:|/|\\\\", "_", SheetNames) SheetNames <- make.unique(SheetNames) } ## Check for SheetNames longer than DT.nms, regardless of whetehr or not cleaning if (length(SheetNames) > length(DT.nms)) { if (showWarnings) warning(warningCols("There are more sheet names than data.frames. The following sheet names will not be used", SheetNames[-seq_along(DT.nms)])) SheetNames <- SheetNames[seq_along(DT.nms)] } ### FILE & DIRECTORY ### ### ----------------- ### # Create export file name f.out <- as.path(outDir, f.name, ts=stamp, ext=ext, expand=FALSE) ## Create Directory if needed dir.fout <- dirname(f.out) if (!file.exists(dir.fout)) { if (showWarnings) warning("Directory '", dir.fout, "' does not exist and thus creating it.") dir.create(dir.fout, showWarnings=showWarnings, recursive=TRUE) } ### ----------------- ### ### In order to allow a call like exportXLS( DT.nms = list(DT.insights[`COUNTRY Country Name` != "USA"], DT.LookerRaw ) if (is.list(DT.nms) && inherits(DT.nms[[1]], "data.frame")) { DT.nms.using <- "DT.nms" envir=environment() } else { DT.nms.using <- DT.nms } cat(sprintf("Columns of the first DT in the list: \n\n %s\n", pasteQ(names( get(DT.nms.using[[1]])) ) )) ## Notify USER verboseMsg(verbose, "The following sheets will be written to file \t (this may take a minute)\n\t '", f.out, "' :\n\t\t", pasteQ(SheetNames, wrap=NULL), sep="") ## Output if (!isSinkOn()) { sinkfile <- if (is.null(logfile)) tempfile(fileext=".txt") else logfile sink(file=sinkfile, append=TRUE, split=FALSE) } cat("Beginning export on ", timeStamp(), "\n") ## EXECUTE. WriteXLS returns T/F based on success success <- WriteXLS (x=DT.nms.using, ExcelFileName=f.out, SheetNames=SheetNames , AdjWidth=AdjWidth, AutoFilter=AutoFilter, BoldHeaderRow=BoldHeaderRow, FreezeRow=FreezeRow, FreezeCol=FreezeCol , row.names=row.names, col.names=col.names, perl=perl, Encoding=Encoding , envir=envir, verbose=verbose ) attr(f.out, "successful.export") <- success ## Output cat("file saved to: \n ", f.out, "\n", pasteR(55), "\n") ## TODO: Make sure isSinkOn() only returns for my sinkOn() function, not generic if (!isSinkOn()) { sink() ## if a temp file was created, clear it if (is.null(logfile)) unlink(sinkfile) } return(f.out) } ## // End Function ## EXAMPLE if (FALSE) { ## preserve the project, for example proj.bak <- getProjName() ## sample data DT.LookerRaw <- fread("~/gitData/orch/data/LabelSpecific/Lee Fields - specific UPCs scheduled.csv") DT.insights <- fread("~/gitData/orch/data/LabelSpecific/insights.csv") setScience("LabelSpecific", quiet=TRUE, subl=FALSE) comment(DT.LookerRaw) <- c("This is the RAW Looker info") f.out.example <- exportXLS(list(DT.insights[`COUNTRY Country Name` != "USA"], DT.LookerRaw), verbose=TRUE) reveal(f.out.example) f.out.example if (length(proj.bak) & nchar(proj.bak)) setScience(proj.bak, quiet=TRUE, subl=FALSE) } # -= ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ =- # # -= ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ =- # ## AFTER TRYING TO WRITE exportXLS AND GETTING HUNG UP ON THE JAVA, I FOUND THE WriteXLS PACKAGE ## Below is the old version # XLCONNECT: # :: ## ----------------------------------------------------------------- ## # XLCONNECT: # :: ## ----------------------------------------------------------------- ## # XLCONNECT: # :: ## ## # XLCONNECT: # :: ## OLD: Based on XLConnect ## # XLCONNECT: # :: ## ## # XLCONNECT: # :: ## KEEPING FOR ARCHIVE PURPOSES ## # XLCONNECT: # :: ## ## # XLCONNECT: # :: ## ----------------------------------------------------------------- ## # XLCONNECT: # :: ## ## # XLCONNECT: # :: ## ----------------------------------------------------------------- ## # XLCONNECT: # :: # XLCONNECT: # :: exportXLS <- function(list.of.DTs, f.name=getProjName(), sheet.names=names(list.of.DTs), rownames=NULL, ext="xls", stamp=TRUE, dir=getOutDir(), increase.java.mem.first=FALSE, verbose=TRUE) { # XLCONNECT: # :: # XLCONNECT: # :: # XLCONNECT: # :: ## ## TODO: # XLCONNECT: # :: ## exportXLS.data.table # XLCONNECT: # :: ## exportXLS.data.frame # XLCONNECT: # :: ## exportXLS.list # XLCONNECT: # :: # XLCONNECT: # :: if (increase.java.mem.first) # XLCONNECT: # :: setJavaMemoryParameter(initial=500, max=2000, units="m", java.handles.signals=TRUE, verbose=verbose, reload=FALSE) # XLCONNECT: # :: # XLCONNECT: # :: verboseMsg(verbose, "Java Parameters are: '", getJavaMemoryParameter(), "'", time=FALSE) # XLCONNECT: # :: wasLoaded <- "XLConnect" %in% loadedNamespaces() # XLCONNECT: # :: library(XLConnect) # XLCONNECT: # :: suppressPackageStartupMessages( library(XLConnect) ) # XLCONNECT: # :: # XLCONNECT: # :: # Create export file name # XLCONNECT: # :: f.out <- as.path(outDir, f.name, ts=stamp, ext=ext, expand=FALSE) # XLCONNECT: # :: # XLCONNECT: # :: ## We expect list.of.DTs to be of the form list.of.DTs=list(DT1=DT1, DT2=DT2) # XLCONNECT: # :: ## however, we also allow for simply list.of.DTs=DT # XLCONNECT: # :: if (is.data.table(list.of.DTs)) { # XLCONNECT: # :: if (missing(sheet.names)) # XLCONNECT: # :: sheet.names <- gsub("^D[TB]\\.", "", capture.output(substitute(list.of.DTs))) # XLCONNECT: # :: list.of.DTs <- list(list.of.DTs) ## TODO: Check if this has any memory implications # XLCONNECT: # :: } # XLCONNECT: # :: # XLCONNECT: # :: if (is.null(sheet.names)) { # XLCONNECT: # :: nms <- substitute(list.of.DTs) # XLCONNECT: # :: if (nms[[1]]== "list" && length(nms[-1]) == length(list.of.DTs)) # XLCONNECT: # :: sheet.names <- as.character(nms[-1]) # XLCONNECT: # :: else # XLCONNECT: # :: sheet.names <- paste0("Sheet ", seq_along(list.of.DTs)) # XLCONNECT: # :: } # XLCONNECT: # :: # XLCONNECT: # :: ## Sheet names can only be a max of 31 Chars. So clean them # XLCONNECT: # :: nc.sh <- nchar(sheet.names) # XLCONNECT: # :: sheet.names[nc.sh > 31] <- trimToNChars(sheet.names[nc.sh > 31], n=31) # XLCONNECT: # :: ## Sheet names cannot contain "[" or "]" # XLCONNECT: # :: sheet.names <- gsub("\\[", "(", gsub("\\]", ")", sheet.names)) # XLCONNECT: # :: # XLCONNECT: # :: ## Notify USER # XLCONNECT: # :: verboseMsg(verbose, "The following sheets will be written to file \t (this may take a minute)\n\t '", f.out, "' :\n\t\t", pasteQ(sheet.names, wrap=NULL), sep="") # XLCONNECT: # :: # XLCONNECT: # :: # Load workbook (create if not exists) # XLCONNECT: # :: wb <- loadWorkbook(f.out, create=TRUE) # XLCONNECT: # :: # XLCONNECT: # :: for (i in seq_along(list.of.DTs)) { # XLCONNECT: # :: # XLCONNECT: # :: ## CLEAN THE NAMES # XLCONNECT: # :: nms.orig <- names(list.of.DTs[[i]]) # XLCONNECT: # :: nms.clean <- gsub("\\s+", "_", cleanChars(nms.orig)) # XLCONNECT: # :: nms.clean <- make.unique(substr(nms.clean, 1, 28)) # XLCONNECT: # :: setnames(list.of.DTs[[i]], old=nms.orig, new=nms.clean) # XLCONNECT: # :: # XLCONNECT: # :: ## Grab the next sheet name # XLCONNECT: # :: sheet <- sheet.names[[i]] # XLCONNECT: # :: # XLCONNECT: # :: # Create a worksheet # XLCONNECT: # :: createSheet(wb, name=sheet) # XLCONNECT: # :: # XLCONNECT: # :: # Write built-in data set 'CO2' to the worksheet created above; # XLCONNECT: # :: # offset from the top left corner and with default header = TRUE # XLCONNECT: # :: writeWorksheet(wb, data=list.of.DTs[[i]], sheet=sheet, rownames=rownames) # XLCONNECT: # :: # XLCONNECT: # :: colWidths <- findColWidth (list.of.DTs[[i]], quant=0.85, max.char=Inf, verbose=FALSE) # XLCONNECT: # :: # XLCONNECT: # :: ## Width units are 1/256th of a character. Thus multiply by 256 # XLCONNECT: # :: colWidths <- colWidths * 256 # XLCONNECT: # :: # XLCONNECT: # :: ## ERROR CHECK ... The names of colWidths should always be the same as the names of the current DT. This just confirms it # XLCONNECT: # :: if (!identical(names(colWidths), names(list.of.DTs[[i]]))) { # XLCONNECT: # :: message("names of colWidths do NOT match names of list.of.DTs[[i]], for i=", i, ".\nENTERING BROWSER") # XLCONNECT: # :: browser(text="Check colWidths") # XLCONNECT: # :: } # XLCONNECT: # :: # XLCONNECT: # :: verboseMsg(verbose, "Setting column width") # XLCONNECT: # :: browser() # XLCONNECT: # :: setColumnWidth(wb, sheet=sheet, column=names(colWidths), width=colWidths) # XLCONNECT: # :: # XLCONNECT: # :: ## PUT THE NAMES BACK # XLCONNECT: # :: setnames(list.of.DTs[[i]], old=nms.clean, new=nms.orig) # XLCONNECT: # :: # XLCONNECT: # :: # XLCONNECT: # :: } # // End for-loop # XLCONNECT: # :: # XLCONNECT: # :: # Save workbook (this actually writes the file to disk) # XLCONNECT: # :: saveWorkbook(wb) # XLCONNECT: # :: verboseMsg(verbose, "Done writing to XLS.") # XLCONNECT: # :: # XLCONNECT: # :: if (!wasLoaded) { # XLCONNECT: # :: verboseMsg(verbose, "Removing Package XLConnect", time=FALSE) # XLCONNECT: # :: try(detach(package:XLConnect), silent=FALSE) # XLCONNECT: # :: } # XLCONNECT: # :: # XLCONNECT: # :: return(f.out) # XLCONNECT: # :: } # old alternate version? ### OLDER VERSION USING XLConnect # old alternate version? if (FALSE) { # old alternate version? # old alternate version? # Load workbook (create if not exists) # old alternate version? wb <- loadWorkbook(f.out, create=TRUE) # old alternate version? # old alternate version? for (i in seq_along(DT.nms)) { # old alternate version? # old alternate version? ## Grab the next sheet name # old alternate version? sheet <- SheetNames[[i]] # old alternate version? # old alternate version? # Create a worksheet # old alternate version? createSheet(wb, name=sheet) # old alternate version? # old alternate version? # Write built-in data set 'CO2' to the worksheet created above; # old alternate version? # offset from the top left corner and with default header = TRUE # old alternate version? writeWorksheet(wb, data=DT.nms[[i]], sheet=sheet, rownames=rownames) # old alternate version? # old alternate version? colWidths <- findColWidth (DT.nms[[i]], quant=0.85, max.char=Inf, verbose=FALSE) # old alternate version? # old alternate version? ## Width units are 1/256th of a character. Thus multiply by 256 # old alternate version? colWidths <- colWidths * 256 # old alternate version? # old alternate version? ## ERROR CHECK ... The names of colWidths should always be the same as the names of the current DT. This just confirms it # old alternate version? if (!identical(names(colWidths), names(DT.nms[[i]]))) { # old alternate version? message("names of colWidths do NOT match names of DT.nms[[i]], for i=", i, ".\nENTERING BROWSER") # old alternate version? browser(text="Check colWidths") # old alternate version? } # old alternate version? # old alternate version? verboseMsg(verbose, "Setting column width") # old alternate version? browser() # old alternate version? setColumnWidth(wb, sheet=sheet, column=names(colWidths), width=colWidths) # old alternate version? # old alternate version? } # // End for-loop # old alternate version? } # old alternate version?