R - Shiny - 如何将整个选项卡面板导出为 png/pdf/excel？

问题描述

我已经创建了一个仪表板（使用 ShinyUI/shinydashboard 包），它有一个使用 GT 包设计的表格。

我正在尝试将整个面板/格式化表格导出为 pdf/image/（excel 中的数据），但不知道该怎么做。

有什么办法可以达到我的要求吗？

我在下面提到了我正在使用的脚本的简化版本。

谢谢...

脚本：

TableA = data.frame(Product = c('iPhone','Macbook','Airpod','iPhone'),East = c(1:7),West = c(5:11),north = c(15:21),South = c(24:30))

library(shiny)
library(shinythemes)
library(DT)
library(rhandsontable)
library(tidyverse)
library(tidyquant)
library(knitr)
library(gt)
library(shinycssloaders)
library(shinydashboard)
library(shinyWidgets)

header = dashboardHeader(title = 'Shiny Dashboard',titleWidth = 400)

sidebar = dashboardSidebar()

body <- dashboardBody(uIoUtput("mainpanel"))

ui = dashboardPage(header,sidebar,body)

############

server = function(input,output,session)
  
{
  
  output$mainpanel = renderUI({
      
      fluidRow(tabBox(width = 250,height = 100,tabPanel("Apple Sales",value = 'tab1',gt_output(outputId = "TableC")%>% withSpinner(color="#3483CA",type = 1,size = 2),downloadButton(outputId = "Downloadpng",label = "Download Png"))
      ))
    })
    
    
    TableB = as.data.frame(TableA) %>%
      
            gt() %>%
            
            grand_summary_rows(columns = 2:5,fns = list(TotalSales = "sum")) %>%
            
            tab_options(grand_summary_row.background.color = "#DDEBF7") %>%
            
            cols_width(columns = 1 ~ px(1),columns = 2 ~ px(300),everything() ~ px(100)) %>%
            
            tab_spanner(label = "Sales",columns = 3:6)
      
    output$TableC = render_gt(expr = TableB)
  
  
  output$Downloadpng = downloadHandler(filename = "Apple Sales.png",content = function(file)
              
            {
              png(file)
              with(tabPanel == 'tab1')
              dev.off()
            }
  )
  
}


############

shinyApp(ui = ui,server = server)

输出：

解决方法

这可能是 shinyscreenshot 包的一个很好的用例。您可以使用 screenshotButton 函数并传递您想要图像的区域的 id。

library(shinyscreenshot)

header = dashboardHeader(title = 'Shiny Dashboard',titleWidth = 400)

sidebar = dashboardSidebar()

body <- dashboardBody(uiOutput("mainpanel"))

ui = dashboardPage(header,sidebar,body)

############

server = function(input,output,session)
  
{
  
  output$mainpanel = renderUI({
    
    fluidRow(tabBox(width = 250,height = 100,tabPanel("Apple Sales",value = 'tab1',gt_output(outputId = "TableC")%>% 
              withSpinner(color="#3483CA",type = 1,size = 2),screenshotButton(selector="#TableC",label = 'Download Png',filename = 'screenshot')
    )))
  })
  
  
  TableB = as.data.frame(TableA) %>%
    
    gt() %>%
    
    grand_summary_rows(columns = 2:5,fns = list(TotalSales = "sum")) %>%
    
    tab_options(grand_summary_row.background.color = "#DDEBF7") %>%
    
    cols_width(columns = 1 ~ px(1),columns = 2 ~ px(300),everything() ~ px(100)) %>%
    
    tab_spanner(label = "Sales",columns = 3:6)
  
  output$TableC = render_gt(expr = TableB)
  
}

shinyApp(ui = ui,server = server)

点击 'Download PNG' 按钮后，返回以下图像。