调整下载按钮，下载两张表

Question

下面的代码生成两个表: Table1和Table2。当我按Download按钮时，我只能下载表1。这工作得很好，但我也想下载表2。如果可能，将两个表一起下载。

我尝试执行以下操作：writexl::write_xlsx(data_subset(), data_subset2(), path = file)，但它不起作用。你能帮帮我吗?

我在下面插入了一个可执行代码，供您测试。

library(shiny)
library(shinythemes)
library(dplyr)
library(writexl)


Test <- structure(list(date2 = structure(c(18808, 18808, 18809, 18810
), class = "Date"), Category = c("FDE", "ABC", "FDE", "ABC"), 
coef = c(4, 1, 6, 1)), row.names = c(NA, 4L), class = "data.frame")

ui <- fluidPage(
  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    
                    
                    tabPanel("",
                             fluidPage(
                               fluidRow(
                                 br(), br(),
                                 column(4,
                                        wellPanel(
                                            uiOutput("daterange"),
                                            downloadButton("dl", "Download")
                                             )),
                                 
                                 column(8,
                                        tabsetPanel(
                                          tabPanel("Table1", dataTableOutput('table')),
                                          tabPanel("Table2", dataTableOutput('table2'))
                
                                               )))
                                                       ))))

server <- function(input, output,session) {
  
  data <- reactive(Test)
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   start = min(data()$date2),
                   end   = max(data()$date2))
  })
  
  data_subset <- reactive({
    req(input$daterange1)
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    subset(data(), date2 %in% days)
  })
 
  output$table <- renderDataTable({
    data_subset()
  })
  
  
  data_subset2 <- reactive({
    req(input$daterange1)
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    subset(data(), date2 %in% days)
  })
  
  output$table2 <- renderDataTable({
    data_subset2()
  })
  
  output$dl <- downloadHandler(
    filename = function() { "data.xlsx"},
    content = function(file) {
      writexl::write_xlsx(data_subset(), path = file)
    }
  )
}

shinyApp(ui = ui, server = server)

Answer 1

尝尝这个

library(shiny)
library(shinythemes)
library(dplyr)
library(writexl)

Test <- structure(list(date2 = structure(c(18808, 18808, 18809, 18810
), class = "Date"), Category = c("FDE", "ABC", "FDE", "ABC"), 
coef = c(4, 1, 6, 1)), row.names = c(NA, 4L), class = "data.frame")

ui <- fluidPage(
  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    
                    
                    tabPanel("",
                             fluidPage(
                               fluidRow(
                                 br(), br(),
                                 column(4,
                                        wellPanel(
                                          uiOutput("daterange"),
                                          downloadButton("dl", "Download")
                                        )),
                                 
                                 column(8,
                                        tabsetPanel(
                                          tabPanel("Table1", dataTableOutput('table')),
                                          tabPanel("Table2", dataTableOutput('table2'))
                                          
                                        )))
                             ))))

server <- function(input, output,session) {
  
  data <- reactive(Test)
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   start = min(data()$date2),
                   end   = max(data()$date2))
  })
  
  data_subset <- reactive({
    req(input$daterange1)
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    subset(data(), date2 %in% days)
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
  
  data_subset2 <- reactive({
    req(input$daterange1)
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    subset(data(), date2 %in% days)
  })
  
  output$table2 <- renderDataTable({
    data_subset2()
  })
  
  
  output$dl <- downloadHandler(
    filename = function() {"data.xlsx"},
    content = function(file) {
      #writexl::write_xlsx(df_list, path = file)
      tbl1<-data_subset()
      tbl2<-data_subset2()
      sheets <- mget(ls(pattern = "tbl")) # getting all objects in your environment with tbl in the name
      names(sheets) <- paste0("Table", seq_len(length(sheets))) # changing the names in your list
      writexl::write_xlsx(sheets, path = file) # saving the file
    }
  )
}

shinyApp(ui = ui, server = server)