[R] Excel Export in a beauty way

[Erich Studerus, Psychiatrische Uni-Klinik]

Hi,

Here's a function to export dataframes to an excel-file with the RDCOMClient 
package. It makes bold headers and fits the column widths automatically. If 
more than one dataframe is provided to the function, the dataframes are 
saved to seperate spreadheets within file.

export.xls <- function (..., colnames = TRUE, rownames = FALSE) {

require(RDCOMClient, quietly = TRUE)
y <- COMCreate("Excel.Application")
wbs <- y$Workbooks()
wb <-wbs$add()
shs <- wb$Worksheets()

export <- function(df, sheetname, sheetnr, colnames = colnames,
             rownames = rownames) {
if (!is.data.frame(df)) {
         df <- as.data.frame(df)
         if (ncol(df) == 1) names(df) <- sheetname}

cl <- sapply(df, function(x) class(x)[1])
dates <- which(cl == 'Date')
for (i in dates) df[, i] <- format(df[,i], '%Y.%m.%d')
datetimes <- which(cl %in% c('POSIXt', 'POSIXct', 'POSIXlt'))
for (i in datetimes) df[, i] <- format(df[,i], '%Y.%m.%d %H:%M')
numerics <- cl == 'numeric'
for (i in which(!numerics)) df[, i] <- as.character(df[, i])
nas <- sapply(df, function(x) any(is.na(x)))
missings <- which(!numerics & nas)
for (i in missings) df[is.na(df[, i]), i] <- ''
   
sh <- shs$Item(sheetnr)
sh[['Name']] <- sheetname
nr <- nrow(df) + colnames
nc <- ncol(df) + rownames
cn <- dimnames(df)[[2]]
rn <- dimnames(df)[[1]]

startstop <- function(x) {
     l <- length(x)
     stops <- starts <- rep(NA, l)
     if (x[1] == TRUE) starts[1] <- 1
     for (i in seq_along(x)[-1]) {
          if (x[i] == TRUE & x[i-1] == FALSE) starts[i] <- i
          if (x[i] == FALSE & x[i-1] == TRUE) stops[i] <- i-1
          }
     if (x[l] == TRUE) stops[l] <- l
     rbind(starts = starts[!is.na(starts)], stops = stops[!is.na(stops)])
     }

startrow <- 1+colnames
startcol <- 1+rownames
num <- startstop(numerics)
num2 <- num + rownames
for (i in seq_len(ncol(num))) {
     x <- sh$Range(sh$Cells(startrow,num2[1,i]), sh$Cells(nr, num2[2,i]))
     x[['Value']] <- asCOMArray(df[, num[1,i]:num[2,i]])
     }

notnum <- startstop(!numerics)
notnum2 <- notnum + rownames
for (i in seq_len(ncol(notnum))) {
   x <- sh$Range(sh$Cells(startrow, notnum2[1, i]), sh$Cells(nr,
   notnum2[2, i]))
   x[['Value']] <- asCOMArray(df[,notnum[1,i]:notnum[2,i]])
   }

missings <- which(numerics & nas) + rownames
for (i in missings)   {
     na <- startstop(is.na(df[,i-rownames])) + colnames
     for (k in seq_len(ncol(na)))  {
       x <- sh$Range(sh$Cells(na[1, k] , i), sh$Cells(na[2, k], i))
       x[['Value']] <- ''
       }
     }

for (i in (1+rownames):nc) {
       x <- sh$Cells(1,i)
       if (colnames)  {
              x[['Value']]<-cn[i-rownames]
              Font <- x$Font()
              Font[['Bold']] <- TRUE
              }
       EntCol <-x$EntireColumn()
       if (i %in% dates)  EntCol[['NumberFormat']] <- 'JJJJ.MM.TT'
       if (i %in% datetimes)  EntCol[['NumberFormat']] <- 'JJJJ.MM.TT hh:mm'
       EntCol$AutoFit()
       }
if (rownames)  {
       x <- sh$Range(sh$Cells(startrow,1),sh$Cells(nr,1))
       x[['Value']] <- asCOMArray(rn)
       EntCol <-x$EntireColumn()
       Font <- x$Font()
       Font[['Bold']] <- TRUE
       }
}

dfn <- deparse(substitute(list(...)))
df <- list(...)
dfn <- gsub('^list\\(', '', dfn)
dfn <- gsub('\\)$', '', dfn)
dfn <- gsub('[ ]', '', dfn)
dfn <- strsplit(dfn, split = ',')[[1]]
dfn <- make.names(dfn, unique = TRUE)
if (length(df) > 2) for (i in seq_len(length(df) - 2)) shs$Add()
for (i in seq_len(length(df))) export(df[[i]], sheetname = dfn[i],
  sheetnr = i, colnames = colnames, rownames = rownames)
y[["Visible"]] <- TRUE
}

#example:
export.xls(iris, mtcars, trees)


>If you are willing to do the work RDCOMClient or rcom packages
>give you complete control.  See example here:
>https://stat.ethz.ch/pipermail/r-help/2005-July/075877.html
>This assumes your platform is Windows and that you have R and Excel
>on the same machine so that R can control Excel.
>
>On Wed, Jun 3, 2009 at 8:29 AM, koj <jens.koch <at> gmx.li> wrote:
>
>> Hallo all,
>>
>> I`ve read a lot of things in this forum about an Excel export via R. It is
>> no problem to export my data frames via write.table or write.xls (xls or
>> csv), but some things are not very convenient for me: I always have to
>> adjust the column with to see all the numbers or the text and there is no
>> frame between the cells. And I missing the possibility to make some headers
>> bold or coloured. I`ve see the output from a Perl-Export and this is a very
>> nice thing, so my question: Is there really no possibility to produce a xls
>> or a xlsx - File with this nice features.
>>
>> Thank you very much in advance,
>>
>> Jens.