为什么 R Shiny 的文档处理程序不会将我的反应式 flextable 导出到 PowerPoint?

Why won't R Shiny's document handler export my reactive flextable to PowerPoint?

我正在尝试将 flextable 导出到 PowerPoint 并让用户下载 PowerPoint。 table 涉及根据用户输入将两个数据集合并在一起。但是,当我尝试导出文档时,单击文档处理程序将文档命名为“download_powerpoint”(例如,UI 中的输出 ID)而不是我指定的文件名。结果,什么也没发生。

我添加了这样的 runApp() 函数 post suggested but to no avail. I got my example from this helpful guide,只要对象不是反应性的,它就可以工作。

library(shiny)
library(officer)
library(flextable)
library(dplyr)

my_table <- data.frame(
    Name = letters[1:4],
    Age = seq(20, 26, 2),
    Occupation = LETTERS[15:18],
    Income = c(50000, 20000, 30000, 45000)
)

ui <- fluidRow(
    column(
        width = 12,
        numericInput(inputId = "age", "Age Input for Table 1", 15),
        numericInput(inputId = "income", "Income Input for Table 2", 52000),
        downloadButton("download_powerpoint", "Download Data to PowerPoint")
    )
)

server <- function(input, output) {
    my_table1 <- reactive({data.frame(
        Name = letters[1:4],
        Age = c(25, 26, 27, input$age))
    })
    
    my_table2 <- reactive({data.frame(
        Name = letters[1:4],
        Income = c(50000, 20000, 30000, input$income)
    )
    })
    
    my_final_table <- reactive({
        my_table1() %>%
            full_join(my_table2())
    })
    
    output$download_powerpoint <- downloadHandler(
        filename = function() {  
            paste0(today(),"employee_data.pptx")
        },
        content = function(file) {
            flextable_prep <- flextable(my_final_table()) %>% 
                colformat_num(col_keys = c("Age", "Income"), digits = 0) %>% 
                width(width = 1.25) %>% 
                height_all(height = 0.35) %>% 
                theme_zebra() %>% 
                align(align = "center", part = "all")
            
            example_pp <- read_pptx() %>% 
                add_slide(layout = "Title Slide", master = "Office Theme") %>% 
                ph_with(
                    value = "Hi", location = ph_location(left = .1, top = .2,height=.7)
                ) %>%
                ph_with(value = flextable_prep(), location = ph_location(left = .1, top = .2,height=.3))
            print(example_pp(), target = file)
            

        }
    )
}

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

已修复!当在 documenthandler() 调用中,唯一的反应元素是 my_final_table() 对象时,它起作用。

解决方案:

library(shiny)
library(officer)
library(flextable)
library(dplyr)

my_table <- data.frame(
    Name = letters[1:4],
    Age = seq(20, 26, 2),
    Occupation = LETTERS[15:18],
    Income = c(50000, 20000, 30000, 45000)
)

ui <- fluidRow(
    column(
        width = 12,
        numericInput(inputId = "age", "Age Input for Table 1", 15),
        numericInput(inputId = "income", "Income Input for Table 2", 52000),
        downloadButton("download_powerpoint", "Download Data to PowerPoint")
    )
)

server <- function(input, output) {
    my_table1 <- reactive({data.frame(
        Name = letters[1:4],
        Age = c(25, 26, 27, input$age))
    })
    
    my_table2 <- reactive({data.frame(
        Name = letters[1:4],
        Income = c(50000, 20000, 30000, input$income)
    )
    })
    
    my_final_table <- reactive({
        my_table1() %>%
        full_join(my_table2())
    })

    
    output$download_powerpoint <- downloadHandler(
        filename = function() {  
            paste0(today(),"employee_data.pptx")
        },
        content = function(file) {
            flextable_prep <- flextable(my_final_table()) %>% 
                colformat_num(col_keys = c("Age", "Income"), digits = 0) %>% 
                width(width = 1.25) %>% 
                height_all(height = 0.35) %>% 
                theme_zebra() %>% 
                align(align = "center", part = "all")
            
            flextable_prep <- flextable_prep %>%
                align(j = "Name", align = "center", part = "body") %>%
                width(width = 2)
            
            example_pp <- read_pptx() %>% 
                add_slide(layout = "Title Slide", master = "Office Theme") %>% 
                ph_with(
                    value = "Hi", location = ph_location_left()) %>%
                ph_with(value = flextable_prep, location = ph_location(left = .1, top = .2,height=.3))
            print(example_pp, target = file)
            

        }
    )
}

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