Question

我正在尝试创建一个闪亮的仪表板（R 3.1.0 /闪亮0.12.0 / shinydashboard 0.5.0）。我已成功创建布局，并决定在仪表板侧栏中使用多个选项卡。

侧边栏包含多个标签，每个标签显示一组特定的图A simple screenshot of what I have made thus far

我正在尝试为这些图添加下载按钮，但我必须将其添加到标题中（以便所有标签都可以使用）。我知道＆＃34; messageItem＆＃34;选项，但我无法使用它。

有人可以帮忙。你认为任何替代方法都是可以接受的。

提前致谢

[更新 - UI.R的新增代码]： -

library(shinydashboard)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
library(ggplot2)
library(rCharts)
library(shiny)
library(data.table)
library(reshape)
library(dplyr)
dashboardPage(
  dashboardHeader(title="MSR Reports",
                  dropdownMenu(type = "task",
                               messageItem(
                                 from = "Download",
                                 message = "Reports",
                                 icon = icon("gear")
                               ),
                               messageItem(
                                 "Download",
                                 message = "TEST",
                                 icon = icon("life-ring"),
                                 href= "http://www.google.com"
                               )
                  )

    ),

  dashboardSidebar(
    sidebarMenu(
               menuItem("SRequests", tabName = "SRequests", icon = icon("dashboard")),
               menuItem("CRequests", tabName = "CRequests", icon = icon("th")),
               menuItem("IN", tabName = "IN", icon = icon("file-word-o")),
               menuItem("IN-Map",tabName="IN-Map",icon=icon("file-word-o"))
    )),

  dashboardBody(
                tags$head(tags$style(HTML('
                 .skin-blue.main-header .logo
                  {
                  background-color: #3c8dbc;
                  }
                 .skin-blue .main-header .logo:hover
                  {
                 background-color: #3c8dbc;
                  }'))
                 ),
                tags$head(tags$style(
                type = 'text/css',
                '#test{ overflow-x: scroll; }')),

                  tabItems(
                    tabItem(tabName = "SRequests",
                            fluidRow
                                  (
                                   h2("Dashboard",align = "center"),
                                   h3(" "),
                                   h3( " " ),
                                   tabItem(tabName = "SRequests",
                                    column(
                                         div(id="test",rpivotTableOutput('PivotTable',height=520)),width=12
                                          )
                                  )
                                  )),
                    tabItem(tabName = "CRequests",
                             fluidRow(
                                      h2("Volume by BA,align = "center"),
                                      h3(" "),
                                      h3(" "),
                                      column(
                                            dataTableOutput("CRequests") , width=10
                                           )
                                     )
                          ),
                    tabItem(tabName = "IN",
                             fluidRow(
                                      h2("INDashboard",align = "center"),
                                      h3(" "),
                                      h3(" "),
                                      column(
                                            width=4, showOutput("chart2", "highcharts")
                                            ),
                                      column(
                                            width=4, showOutput("chart3", "highcharts")
                                            ),
                                      column(
                                            width=4, showOutput("chart4", "highcharts")
                                            )

                                    )
                           ),
                    tabItem(tabName = "IN-Map",
                           h2("IN Locations"),
                             fluidRow(
                                      leafletOutput("mymap"),
                                      actionButton("recalc", "New points")
                                     )

                           )

                      )
               )
)

Answer 1

这是同时下载所有绘图的另一种方法。您可以创建一个下载处理程序按钮，它将以pdf / ppt同时下载所有图表。示例代码如下：

output$downloadReport <- downloadHandler(

    filename = "You report.pdf",
    content = function(file) {
      pdf(file)

      ## If you have displayed some Datatables in any of your tabs
      pushViewport(viewport(layout = grid.layout(3, 2, heights = unit(c(0.5, 5, 5), "null")))) 
      sample<- sampledatatable() ## Function which you have made in server.R
      sample<- grid.table(sample)
      vp = viewport(layout.pos.row = 2, layout.pos.col = 1:2)
      grid.text("Your Datatable", vp = viewport(layout.pos.row = 1, layout.pos.col = 1:2))
      grid.newpage()

      print(plot1()) # Function for the plot you made it in Server.R
      print(plot2())

      dev.off()
    }
  )

将下载/导出按钮添加到R shinydashboard

1 个答案: