R блестящий код для создания вкладок Excel нажатием - PullRequest
Новая
       6

R блестящий код для создания вкладок Excel нажатием

0 голосов
/ 12 марта 2020

Я пытаюсь создать новую книгу Excel с новыми вкладками (загруженными данными) одним щелчком мыши. Например, когда пользователь нажимает «Сохранить это представление», код должен сгенерировать Excel (сначала), добавить вкладку и скопировать таблицу. При следующем щелчке код должен добавить вкладку в существующий файл Excel и скопировать данные. 


library(writexl)
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinydashboard)
library(openxlsx)
library(DT)
library(dplyr)
library(rlist)
ui <- fluidPage(
  sidebarPanel(
    fluidRow(    column(  width = 10,
                          tags$h3("Select Filters"),
                          panel(  selectizeGroupUI(
                            id = "my-filters1",
                            inline = F,
                            params = list(
                              cyl = list(inputId = "cyl", title = "cyl",multiple=TRUE),
                              gear = list(inputId = "gear", title = "gear",multiple=TRUE),
                              carb = list(inputId = "carb", title = "carb",multiple=TRUE)
                            )
                          ), status = "primary"))),
    actionButton("add1","Save This Veiw"),textAreaInput("caption", "Sheetname", "Output", width = "150px",height=40),
    pickerInput("filter", "Select",multiple = TRUE,options = list(
      `actions-box` = TRUE),c("gear","carb","gear"),selected = c("gear"))



  ),
  mainPanel(
    downloadButton("dl", "Download"),
  dataTableOutput("data1")
)

)
server <- function(input, output) {

  res_mod1 <- callModule(
    module = selectizeGroupServer,
    id = "my-filters1",
    data = mtcars,
    vars = c("cyl","gear","carb")

  )


  base_data <- reactive({ 
    res<- mtcars

    #res$Settlement.Amount.GBP<-ifelse(is.na(res$Settlement.Amount),0,res$Settlement.Amount) 
    if (!(is.null(input$`my-filters1-cyl`))) res<-filter(res, (cyl) == input$`my-filters1-cyl`)
    if (!(is.null(input$`my-filters1-gear`))) res<-filter(res, (gear) == input$`my-filters1-gear`)
    if (!(is.null(input$`my-filters1-carb`))) res<-filter(res, (carb) == input$`my-filters1-carb`)

    res2<- res%>% select(input$filter,mpg)%>%
      group_by(!!!rlang::syms(input$filter)) %>% 
      summarise_at(vars(mpg),funs(sum))


    res2
  }) 




  output$data1 <- DT::renderDataTable(datatable(base_data()))



   filename = function() {
          "output_file.xlsx"
       }
   content = function(file) {
         my_workbook <- createWorkbook()}





   x<-reactive({ observeEvent(input$add1, {
     addWorksheet(
              wb = my_workbook,
             sheetName = input$caption
           )
     writeData(
              my_workbook,
             sheet = 1,
             base_data1(),
             startRow = 6,
             startCol = 2
          )

   })})
   # 
  # 
  # 
  # 
  output$downloadData <- downloadHandler(

    filename,
   content,x
  #     
  #   }
  #   
 )

}
shinyApp(ui, server)

Спасибо,

1 Ответ

0 голосов
/ 12 марта 2020

Как уже упоминалось в моем предыдущем комментарии: 

library(writexl)
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinydashboard)
library(openxlsx)
library(DT)
library(dplyr)
library(rlist)

my_workbook <- createWorkbook()

ui <- fluidPage(
  sidebarPanel(
    fluidRow(    column(  width = 10,
                          tags$h3("Select Filters"),
                          panel(  selectizeGroupUI(
                            id = "my-filters1",
                            inline = F,
                            params = list(
                              cyl = list(inputId = "cyl", title = "cyl",multiple=TRUE),
                              gear = list(inputId = "gear", title = "gear",multiple=TRUE),
                              carb = list(inputId = "carb", title = "carb",multiple=TRUE)
                            )
                          ), status = "primary"))),
    actionButton("add1","Save This Veiw"),textAreaInput("caption", "Sheetname", "Output", width = "150px",height=40),
    pickerInput("filter", "Select",multiple = TRUE,options = list(
      `actions-box` = TRUE),c("gear","carb","gear"),selected = c("gear"))



  ),
  mainPanel(
    downloadButton("dl", "Download"),
    dataTableOutput("data1")
  )

)
server <- function(input, output) {

  res_mod1 <- callModule(
    module = selectizeGroupServer,
    id = "my-filters1",
    data = mtcars,
    vars = c("cyl","gear","carb")

  )


  base_data <- reactive({ 
    res<- mtcars

    #res$Settlement.Amount.GBP<-ifelse(is.na(res$Settlement.Amount),0,res$Settlement.Amount) 
    if (!(is.null(input$`my-filters1-cyl`))) res<-filter(res, (cyl) == input$`my-filters1-cyl`)
    if (!(is.null(input$`my-filters1-gear`))) res<-filter(res, (gear) == input$`my-filters1-gear`)
    if (!(is.null(input$`my-filters1-carb`))) res<-filter(res, (carb) == input$`my-filters1-carb`)

    res2<- res%>% select(input$filter,mpg)%>%
      group_by(!!!rlang::syms(input$filter)) %>% 
      summarise_at(vars(mpg),funs(sum))


    res2
  }) 




  output$data1 <- DT::renderDataTable(datatable(base_data()))



  output$dl <- downloadHandler(
    filename = function() {
      paste("output_file",".xlsx", sep = "")
    },
    content = function(file) {
      saveWorkbook(my_workbook, file, overwrite = TRUE)
    }
  )




observeEvent(input$add1, {
    addWorksheet(
      wb = my_workbook,
      sheetName = input$caption
    )
    writeData(
      my_workbook,
      sheet = 1,
      base_data(),
      startRow = 6,
      startCol = 2
    )

  })


}
shinyApp(ui, server)

Это должно сработать. Вам нужно вызвать observeEvent, чтобы добавить таблицу в глобальный заполнитель рабочей книги, как только пользователь нажмет «Сохранить это представление». После этого вы просто saveWorkbook, как только пользователь нажимает кнопку загрузки.

...