0

为了响应这个关于将 R 闪亮的应用程序图形内容导出到 Excel的堆栈溢出帖子，用户ismirsehregal提供了一个很好的解决方案，通过添加一个专用的新工作表，将通过library(rvg)/library(officer)包生成的可编辑图形内容与通过 生成的内容合并到同一个工作簿中library(openxlsx)到 rvg/officer 内容。

我正在尝试做类似的事情，但想将通过 rvg/officer 包生成的可编辑图形内容添加到与来自的表格内容相同的工作表library(xlsx)中，而不是将它们保存在单独的工作表中。但是，当我尝试通过下面的 R 闪亮应用程序代码将library(rvg)/library(officer)内容添加到与内容相同的工作表library(openxlsx)时，Excel 工件不会呈现 rvg/officer 内容（它只呈现初始library(xlsx)内容）。

library(shiny)
library(ggplot2)
library(officer)
library(rvg)
library(xlsx)
library(data.table)

data("mpg")

ui <- fluidPage(
  downloadButton('Export', label = 'Click here to export content')
)

server <- function(input, output) {
  
  # generate table from mpg data
  mpg.dt <- as.data.table(mpg)
  mpg.dt[, hwy_avg := mean(hwy), by=class]
  mpg.dt[, classIndex := 1:.N, by = class]
  mpg.table <- mpg.dt[which(classIndex==1),c("class", "hwy_avg")] 
  mpg.table <- as.data.frame(mpg.table)
  
  # specify function to add tablar content to xlsx-compatible file
  xlsx.addcell1<-function(sheet, rows,colIndex,title) {
    sheetTitle <-createCell(rows, colIndex=colIndex)
    setCellValue(sheetTitle[[1,1]], ifelse((is.na(title)),"-",title))
  }
  
  # download handler
  output$Export <- downloadHandler(
    
    filename = function() {
      timedatestamp <- Sys.time()
      timedatestamp <- gsub(":","-",timedatestamp)
      paste0("artifact ", timedatestamp, ".xlsx")
    },
    
    content = function(file){
  
      # create initial file for tabular content using xlsx package
      shell <- xlsx::createWorkbook()
      createSheet(shell, "Content")
      sheets<-getSheets(shell)
      
      # populate tabular data
      rows <-createRow(sheets[[1]],rowIndex=1)
      xlsx.addcell1(sheets[[1]], rows, 1, "class")
      xlsx.addcell1(sheets[[1]], rows, 2, "hwy_avg")
      
      for(i in 1:nrow(mpg.table)){
        rows <-createRow(sheets[[1]],rowIndex=1+i)
        for(j in 1:ncol(mpg.table)){
          xlsx.addcell1(sheets[[1]], rows, j, mpg.table[i,j])
        }
      }
      
      tmpwb <- tempfile(fileext = ".xlsx")
      xlsx::saveWorkbook(shell, tmpwb)
      
      # convert xlsx file to rxlsx and delete temp file
      wbShell_officer <- read_xlsx(tmpwb)
      file.remove(tmpwb)
      
      # add editable graph content into rxlsx file
      mpgPlot <-ggplot(data = mpg.table,  aes(x = class , y = hwy_avg)) + geom_bar(stat = "identity")
      
      wbShell_officer <- add_sheet(wbShell_officer, label = "mpgPlot")
      wbShell_officer <- xl_add_vg(wbShell_officer, sheet = "mpgPlot", code = print(mpgPlot), width = 5, height = 5, left = 1, top = 1)
      
      print(wbShell_officer, target = file)
      
    }
  )
}

shinyApp(ui, server)

请注意，如果我运行相同的程序，但将以下两行替换为上述代码块中对应的（倒数第二行）行——从而将library(rvg)/保留library(officer)在单独的选项卡上——应用程序成功地将可编辑的图形内容呈现在附加的床单：

wbShell_officer <- add_sheet(wbShell_officer, label = "mpgPlot")
wbShell_officer <- xl_add_vg(wbShell_officer, sheet = "mpgPlot", code = print(carPlot), width = 5, height = 5, left = 1, top = 1)

有没有办法让可编辑library(rvg)/library(officer)内容与表格内容在同一张纸上呈现library(xlsx)？

4

0 回答 0