R datatable buttons export with formated cells

问题:

The extensions Buttons works great for shiny application, from library(DT). However it export the data without formatting. Is there a way to export data with format (e.g. percentage, or currency)? Similar question left unsolved.

Reproducible code

library(DT)

data.frame(a = c(1,2),
           b = c(2,3)) %>%
  datatable(extensions = 'Buttons', options = list(
     dom = 'Bfrtip',
     buttons = c('copy', 'csv', 'excel', 'pdf', 'print')) )%>%
   formatPercentage('a') %>%
   formatCurrency('b')

回答1:

Instead of using the Buttons extension, you can use the TableExport library.

library(shiny)
library(DT)
library(shinyjs)

js_export <- 
"
var $table = $('#DTtable').find('table');
var instance = $table.tableExport({
  formats: ['xlsx'],
  exportButtons: false,
  filename: 'myTable',
  sheetname: 'Sheet1'
});
var exportData0 = instance.getExportData();
var exportData = exportData0[Object.keys(exportData0)[0]]['xlsx'];
instance.export2file(exportData.data, exportData.mimeType, exportData.filename, 
                     exportData.fileExtension, exportData.merges, 
                     exportData.RTL, exportData.sheetname);
"

ui <- fluidPage(
  useShinyjs(),
  tags$head(
    # put these files in the www subfolder
    tags$script(src = "xlsx.core.min.js"),
    tags$script(src = "FileSaver.min.js"),
    tags$script(src = "tableexport.min.js")
  ),

  DTOutput("DTtable"),

  actionButton("export", "Export table")
)

server <- function(input, output, session){

  output$DTtable <- renderDT({
    data.frame(
      a = c(1,2),
      b = c(2,3)
    ) %>%
      datatable() %>%
      formatPercentage('a') %>%
      formatCurrency('b')
  })

  observeEvent(input$export, {
    runjs(js_export)
  })

}

shinyApp(ui, server)