0

I'm trying to export a flextable to PowerPoint and have users download the PowerPoint. The table involves merging two datasets together based on users inputs. However, when I try to export the document, clicking the document handler names the document "download_powerpoint" (e.g., the output ID in the UI) rather than the filename I've specified. As a result, nothing happens.

I added the runApp() function like this post suggested but to no avail. I got my example from this helpful guide, which works as long as the object isn't reactive.

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)
J.Sabree
  • 2,280
  • 19
  • 48

1 Answers1

0

Fixed it! It works when, within the documenthandler() call, the only reactive element is the my_final_table() object.

Solution:

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)
J.Sabree
  • 2,280
  • 19
  • 48