Copy a Shiny DT cell to users clipboard

Question

Based on this question: I want to select a row in a shiny datatable and want to copy the content of a specific cell to the clipboard.

What I've got so far:

library(DT)

ui <- basicPage(
 h2("The mtcars data"),
 DT::dataTableOutput("mytable")
)

server <- function(input, output) {
 output$mytable <- DT::renderDataTable({
   DT::datatable(mtcars, 
                 rownames = FALSE,
                 extensions = c("Buttons", "Select"),
                 selection = 'none',
                 options = 
                       list(
                         select = TRUE,
                         dom = "Bfrtip",
                         buttons = list(
                           list(
                             extend = "copy",
                             text = 'Copy',
                             exportOptions = list(modifier = list(selected = TRUE))
                           )
                         )
                  ))
 })
}

shinyApp(ui, server)

With this code after selecting row 1 I got following data in the clipboard:

Exported data

mpg cyl disp    hp  drat    wt  qsec    vs  am  gear    carb
21  6   160 110 3.9 2.62    16.46   0   1   4   4

Is it possible to remove the header and get the data of a specific cell (e.g. disp)?

160

Answer 1

For the sake of completeness here a modified and shortened solution from the RStudio Community

library(shiny)
library(DT)

ui <- fluidPage(
  fluidRow(
    DT::dataTableOutput(outputId = "my_data_table")
  )
)

server <- function(input, output) {

  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  
  my_data_table <- reactive({
    data.frame(
      mtcars,
      Actions = shinyInput(actionButton, nrow(mtcars),
                           'button_',
                           label = "clipboard",
                           onclick = paste0('Shiny.onInputChange( \"select_button\" , this.id)')
      )
    )
  })
  
  output$my_data_table <- renderDataTable({
    my_data_table()
  }, escape = FALSE)
  
  observeEvent(input$select_button, {
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
    writeClipboard(as.character(my_data_table()[selectedRow,3]))
  })
}

shinyApp(ui, server)

Answer 2

Here is how to remove the title and the header:

datatable(
  iris, 
  rownames = FALSE,
  extensions = c("Buttons", "Select"),
  options = list(
    select = TRUE,
    dom = "Bfrtip",
    buttons = list(
      list(
        extend = "copy",
        text = "Copy",
        title = NULL,
        exportOptions = list(
          modifier = list(selected = TRUE),
          format = list(
            header = JS(
              "function(text, index, node) {",
              "  return '';",
              "}"
            )
          )
        )
      )
    )
  )
)

Answer 3

Here is a way using the rclipboard package:

library(shiny)
library(DT)
library(rclipboard)

ui <- fluidPage(
  rclipboardSetup(),
  br(),
  fluidRow(
    column(
      width = 9,
      DTOutput("dtable")
    ),
    column(
      width = 3,
      tags$h2("Try to paste here:"),
      tags$textarea()
    )
  )
)

server <- function(input, output, session) {
  
  my_data_table <- mtcars
  my_data_table[["Action"]] <- vapply(1L:nrow(my_data_table), function(i){
    as.character(
      rclipButton(
        paste0("clipbtn_", i), 
        label = "Copy", 
        clipText = my_data_table[i, "disp"], 
        icon = icon("copy", lib = "glyphicon"),
        class = "btn-primary btn-sm"
      )
    )
  }, character(1L))

  output[["dtable"]] <- renderDT({
    datatable(
      my_data_table,
      escape = FALSE,
      selection = "none",
      options = list(
        columnDefs = list(
          list(targets = ncol(my_data_table), orderable = FALSE)
        )
      )
    )
  })
  
}

shinyApp(ui, server)