Search code examples
rexcelshinyoutputrpivottable

shiny: Saving rpivotTableOutput as Excel


I could not figured out how to save the output of in . My minimum working example is below for reference.

library(tidyverse)
library(shiny)
library(shinydashboard)

ui <-
  dashboardPage(
    skin = "green",
    dashboardHeader(
      title      = "Test",
      titleWidth = 280
      ),
    dashboardSidebar(
      width = 280,
      sidebarMenu(
        menuItem(text = "Output", tabName = "Out1",     icon = icon("file-upload"))
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
                 tabName = "Out1",
                 fluidRow(column(width = 10, strong("Data")), align = "center"),
                 br(),
                 fluidRow(rpivotTableOutput("Data1"))
                 ) 
      )
    )
  )

  
server <- 
  function(input, output){
    library(rpivotTable)
      
    output$Data1 <- 
      renderRpivotTable(
        rpivotTable(
            data = mtcars
          , rows = "cyl"
          , cols = "gear"
          , height = "780px"
          )
        )
          }

runApp(
    list(ui = ui, server = server)
  , launch.browser = TRUE
  ) 

Solution

  • Edit/Update: with the help of rvest and xlsx packages, we can save the extracted html pivot table as xls file. Updated code below

    I agree with @danlooo 's comment that trying to extract data from the render of rpivotTable might not be the best way forward. However, I can offer a way of extracting the HTML code of generated pivot table.

    Below code extracts the html code of the generated pivot table, uses rvest to extract a dataframe from this html , finally using xlsx for export. More info on interaction between shiny and js can be found in this article

    The code generates an xls file containing the pivot table generated by rpivotTable

    library(tidyverse)
    library(shiny)
    library(shinydashboard)
    library(rpivotTable)
    
    library(shinyjs)
    library(dplyr)
    library(rvest)
    library(xlsx)
    
    ui <-
      dashboardPage(
        skin = "green",
        
        dashboardHeader(
          title      = "Test",
          titleWidth = 280
        ),
        
        dashboardSidebar(
          width = 280,
          sidebarMenu(
            menuItem(text = "Output", tabName = "Out1")
          ),
          
          hr(),
          useShinyjs(),
          actionButton(inputId = "btnExport", "Export Table")
          
          
        ),
        dashboardBody(
          tabItems(
            tabItem(
              tabName = "Out1",
              fluidRow(column(width = 10, strong("Data")), align = "center"),
              br(),
              fluidRow(rpivotTableOutput("Data1"))
            ) 
          )
        )
      )
    
    
    server <- 
      function(input, output){
        #library(rpivotTable)
        
        output$Data1 <- 
          renderRpivotTable(
            rpivotTable(
              data = mtcars
              , rows = "cyl"
              , cols = "gear"
              , height = "780px"
            )
          )
        
        
        observeEvent(input$btnExport,{
          
          runjs(
            "
            var tblhtml=document.getElementsByClassName('pvtRendererArea')[0].innerHTML;
            console.log(tblhtml)
            //set shiny Input value to read reactively from R 
            Shiny.setInputValue('tblvar_shiny', tblhtml);
            "
          )
          
        } )
        
        #save pivot table to html file
        # observeEvent(input$tblvar_shiny, 
        #              { write_file(sprintf("<html><body> %s </body></html>", 
        #                                   input$tblvar_shiny), 
        #                           file = "000pivothtml.html" )})
        
        #save pivot table to xls file 
        observeEvent(input$tblvar_shiny,
                     { 
                         minimal_html(input$tblvar_shiny) %>% 
                         html_element("table")   %>% 
                         html_table() %>% 
                         as.data.frame() %>% 
                         write.xlsx2(file="000pivot_final.xls")
                       })
      } 
    
    runApp(
      list(ui = ui, server = server)  , launch.browser = TRUE
    )