r - 格式化 xlsx 文件中的表格

Question

我正在尝试创建用于格式化 xlsx 文件中每个表的函数。

我想在 xlsx 中保存 N 个表格，并在 xlsx 文件中格式化所有表格。但它仅格式化第一个表格。

library(openxlsx)
format_tbl <- function(workbook,tbll){
  setColWidths(workbook, 1,cols = 1:ncol(tbll), widths = "auto")
  writeData(workbook, 1, tbll)
  
  header_style <- createStyle(fgFill = "#009DE0", halign = "center", textDecoration = "bold", fontColour = "white")
  addStyle(workbook, 1, style = header_style, rows = 1, cols = 1:ncol(tbll))
  
  name_style <- createStyle(fgFill = "gray70", halign = "center", fontColour = "white")
  addStyle(workbook, 1, style = name_style, rows = 2 : nrow(tbll), cols = 1)
  
  percent_style <- createStyle(halign = "center", numFmt = "00%")
  addStyle(workbook, 1, style = percent_style, rows = 2 : nrow(tbll), which(colnames(tbll) == "disp"))
  
  center_style <- createStyle(halign = "center")
  addStyle(workbook, 1, style = center_style, rows = 2 : nrow(tbll), cols = which(!colnames(tbll) %in% c("model", "disp")), gridExpand = TRUE)
  
  total_style <- createStyle(fgFill = "#009DE0", halign = "center", fontColour = "black", fontSize = 12)
  addStyle(workbook, 1, style = total_style, rows = nrow(tbll), cols = 1:ncol(tbll))
  
  Na_style <- createStyle(fgFill = "#00968F", halign = "center", fontColour = "black", fontSize = 12)
  addStyle(workbook, 1, style = Na_style, rows = nrow(tbll)+1, cols = 1:ncol(tbll))
  
}

t1 = mtcars
t2 = mtcars[,1:5]
t3= iris
t4 = iris[1:8,] 

format_tbl(workbook=wb,tbll=t1)
format_tbl(workbook=wb,tbll=t2)
format_tbl(workbook=wb,tbll=t3)
format_tbl(workbook=wb,tbll=t4)

tbls <- list(t1,t2,t3,t4)



startRows <- c(0, cumsum(2 + sapply(tbls, nrow)[-length(tbls)])) + 1

fn <- tempfile(fileext = "xlsx")

wb <- createWorkbook()
addWorksheet(wb, "tbls")
mapply(function(tbl, startRow) writeData(wb, "tbls", x = tbl, startRow = startRow), tbls, startRows)

saveWorkbook(wb, fn, overwrite = TRUE) %>% file.show(.)

Answer 1

这是一个格式化数据框列表中每个元素的函数。使用 R 范围规则，注意 format_tbls 返回一个工作簿对象，它允许将函数内部发生的更新传递给最终保存到文件的对象。

注意:我试图遵循原始问题中显示的格式，但我排除了“Na_string”addStyle 调用。这可能是为了突出 data.frames 中的 NA。当前代码不这样做。

library(openxlsx)
library(expss)

# make list of tables
tbls <- list( mtcars,mtcars[,1:5],iris,iris[1:8,])

# function that formats each table in a list
format_tbls <- function(tbls, wb){
  
  # add worksheet
  addWorksheet(wb, "tbls")
  
  # calculate start rows
  rows <- c(0, cumsum(2 + sapply(tbls, nrow)[-length(tbls)])) + 1
  
  # styles
  header_style <- createStyle(fgFill = "#009DE0", halign = "center", textDecoration = "bold", fontColour = "white")
  name_style <- createStyle(fgFill = "gray70", halign = "center", fontColour = "white")
  percent_style <- createStyle(halign = "center", numFmt = "00%")
  center_style <- createStyle(halign = "center")
  total_style <- createStyle(fgFill = "#009DE0", halign = "center", fontColour = "black", fontSize = 12)
  Na_style <- createStyle(fgFill = "#00968F", halign = "center", fontColour = "black", fontSize = 12)
  
  setColWidths(wb, 1,cols = 1:100, widths = "auto")
  
  for(i in seq_along(tbls)){
    
    #writeData(wb, 1, tbls[[i]], startRow = rows[i]) # this works
    expss::xl_write(tbls[[i]], wb, "tbls", row = rows[i]) # this also works
     
    addStyle(wb, 1, style = total_style, rows = rows[i]:(rows[i]+nrow(tbls[[i]])), 
             cols = 1:ncol(tbls[[i]]), gridExpand = TRUE) # set 
    
    addStyle(wb, 1, style = header_style, 
             rows = rows[i], cols = 1:ncol(tbls[[i]]))
    
    addStyle(wb, 1, style = name_style, 
             rows = rows[i]+1, cols = 1)
    
    addStyle(wb, 1, style = percent_style, rows = rows[i]+1, 
               which(colnames(tbls[[i]]) == "disp"))
    
    addStyle(wb, 1, style = center_style, rows = rows[i]+1, 
             cols = which(!colnames(tbls[i]) %in% c("model", "disp")), gridExpand = TRUE)
    
    # not included. probably needs conditional formatting to detect NA values?
    #addStyle(wb, 1, style = Na_style, rows = rows[i]+1:(rows[i]+nrow(tbls[[i]])), 
             #cols = 1:ncol(tbls[[i]]), gridExpand = TRUE) # set stack = TRUE to allow styles to be merged
  }
  
  return(wb)
  
}

# create wb
wb <- createWorkbook()

# use function
wb <- format_tbls(tbls = tbls, wb = wb)

# save to file
saveWorkbook(wb, "test.xlsx", overwrite = TRUE)