css R闪亮DT表忽略背景颜色,同时导出到Excel工作表

1zmg4dgp  于 2023-07-01  发布在  其他
关注(0)|答案(1)|浏览(111)

我试图从R闪亮的DT表中导出数据到Excel工作表后,选择背景颜色的一些细胞在DT表。但是代码只导出DT表中的数据,而不导出单元格中选定的背景颜色。
有人能帮我修改一下代码吗?任何帮助是非常感谢。

library(shiny)
library(DT)
library(htmltools)
library(colourpicker)
library(shinyWidgets)
library(DT)
library(shinythemes)

dat <- mtcars

sketch <- tags$table(
  tags$thead(
    tags$tr(
      tags$th(),
      lapply(names(dat), tags$th)
    ),
    tags$tr(
      tags$th(id = "th0"),
      tags$th(id = "th1"),
      tags$th(id = "th2"),
      tags$th(id = "th3"),
      tags$th(id = "th4"),
      tags$th(id = "th5"),
      tags$th(id = "th6"),
      tags$th(id = "th7"),
      tags$th(id = "th8"),
      tags$th(id = "th9"),
      tags$th(id = "th10"),
      tags$th(id = "th11")
    )
  )
)

js <- c(
  "function(){", 
  "  this.api().columns().every(function(i){",
  "    var column = this;",
  "    var select = $('<select multiple=\"multiple\"><option value=\"\"></option></select>')",
  "      .appendTo( $('#th'+i).empty() )", 
  "      .on('change', function(){",
  "        var vals = $('option:selected', this).map(function(index,element){",
  "          return $.fn.dataTable.util.escapeRegex($(element).val());",
  "        }).toArray().join('|');",
  "        column.search(vals.length > 0 ? '^('+vals+')$' : '', true, false).draw();",
  "      });",
  "    var data = column.data();",
  "    if(i == 0){",
  "      data.each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }else{",
  "      data.unique().sort().each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }",
  "    select.select2({width: '120%', closeOnSelect: false});",
  "  });",
  "}")

ca  <- c(
  "table.on('click', 'td', function(e) {",
  "  const $cell = table.cell(this).nodes().to$();",
  "  const RGB = $cell.css('background-color');",
  "  const cellColor = '#' + RGB.match(/\\d+/g).map(x => (+x).toString(16).padStart(2,0)).join``",
  "  const selectedColor = $('#color').val().toLowerCase();",
  "  const color = cellColor == selectedColor ? '' : selectedColor;",
  "  $cell.css('background-color', color);",
  "});"
)

ui <- fluidPage(HTML(""),
                tags$head(
                  tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
                  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
                ),
                sidebarLayout(
                  sidebarPanel(
                    colourInput(
                      "color", 
                      "Choose background color",
                      palette = "limited",
                      closeOnClick = TRUE
                    )
                  ),
                  
                  
                  mainPanel(
                    br(),
                    DTOutput("dtable")
                  )))

server <- function(input, output, session) {
  
  
  output[["dtable"]] <- renderDT({
    
    datatable(
      dat, callback = JS(ca),  selection = "none", container=sketch, editable = "cell",  class = 'cell-border stripe', extensions = 'Buttons', 
      options = list(dom = 'BPrlftip', buttons = list('copy', 'pdf', 'csv', 'excel', 'print'), 
                     orderCellsTop = TRUE,
                     
                     initComplete  = JS(js),
                     columnDefs = list(
                       list(targets = "_all", className = "dt-center")
                     )
      )
    )
    
  }, server = FALSE)
}

shinyApp(ui, server)

公司代码

library(shiny)
library(DT)
library(htmltools)
library(colourpicker)
library(shinyWidgets)
library(DT)
library(shinythemes)

dat <- mtcars

sketch <- tags$table(
  tags$thead(
    tags$tr(
      tags$th(),
      lapply(names(dat), tags$th)
    ),
    tags$tr(
      tags$th(id = "th0"),
      tags$th(id = "th1"),
      tags$th(id = "th2"),
      tags$th(id = "th3"),
      tags$th(id = "th4"),
      tags$th(id = "th5"),
      tags$th(id = "th6"),
      tags$th(id = "th7"),
      tags$th(id = "th8"),
      tags$th(id = "th9"),
      tags$th(id = "th10"),
      tags$th(id = "th11")
    )
  )
)

js <- c(
  "function(){", 
  "  this.api().columns().every(function(i){",
  "    var column = this;",
  "    var select = $('<select multiple=\"multiple\"><option value=\"\"></option></select>')",
  "      .appendTo( $('#th'+i).empty() )", 
  "      .on('change', function(){",
  "        var vals = $('option:selected', this).map(function(index,element){",
  "          return $.fn.dataTable.util.escapeRegex($(element).val());",
  "        }).toArray().join('|');",
  "        column.search(vals.length > 0 ? '^('+vals+')$' : '', true, false).draw();",
  "      });",
  "    var data = column.data();",
  "    if(i == 0){",
  "      data.each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }else{",
  "      data.unique().sort().each(function(d, j){",
  "        select.append('<option value=\"'+d+'\">'+d+'</option>');",
  "      });",
  "    }",
  "    select.select2({width: '120%', closeOnSelect: false});",
  "  });",
  "}")

ca  <- c(
  "table.on('click', 'td', function(e) {",
  "  const $cell = table.cell(this).nodes().to$();",
  "  const RGB = $cell.css('background-color');",
  "  const cellColor = '#' + RGB.match(/\\d+/g).map(x => (+x).toString(16).padStart(2,0)).join``",
  "  const selectedColor = $('#color').val().toLowerCase();",
  "  const color = cellColor == selectedColor ? '' : selectedColor;",
  "  $cell.css('background-color', color);",
  "});"
)

customize <- "
function(xlsx, button, table) {
 
  const LETTERS = 
    ['A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'];

  var sheet = xlsx.xl.worksheets['sheet1.xml'];
 
  var row = 0;
  const num_columns = table.columns().count();
 
  $('row', sheet).each(function(x) {
    if(x > 1) {
      for(let i=0; i < num_columns; i++) {
        const $cell = $(table.cell(':eq('+row+')', i).node()); 
        const RGB = $cell.css('background-color');
        const cellColor = '#' + RGB.match(/\\d+/g).map(x => (+x).toString(16).padStart(2,0)).join``;
        if(cellColor == '#ff0000') {
          $('row:eq(' + (x) + ') c[r^=' + (LETTERS[i]) + ']', sheet).attr('s', '10');
        } else if(cellColor == '#00ff00') {
          $('row:eq(' + (x) + ') c[r^=' + (LETTERS[i]) + ']', sheet).attr('s', '15');
        }
      }
      row++;
    }
  });
}"

ui <- fluidPage(HTML(""),
                tags$head(
                  tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
                  tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
                ),
                sidebarLayout(
                  sidebarPanel(
                    colourInput(
                      "color", 
                      "Choose background color",
                      palette = "limited",
                      closeOnClick = TRUE
                    )
                  ),
                  
                  
                  mainPanel(
                    br(),
                    DTOutput("dtable")
                  )))

server <- function(input, output, session) {
  output[["dtable"]] <- renderDT({
    datatable(
      dat, callback = JS(ca),  selection = "none", container=sketch, editable = "cell",  class = 'cell-border stripe', extensions = 'Buttons', 
      options = list(dom = 'BPrlftip', buttons = list(list(
                                                 extend = "excel",
                                                 text = "Save XLSX",
                                                 customize = JS(customize))), 
                     orderCellsTop = TRUE,
                     initComplete  = JS(js),
                     columnDefs = list(
                       list(targets = "_all", className = "dt-center")
                     )))
  }, server = FALSE)
}

shinyApp(ui, server)
jchrr9hc

jchrr9hc1#

必须使用Excel按钮的customize选项。这有点烦人,因为每种颜色对应一个特殊的Excel代码,我们必须列出所有的可能性。在这里,我开始只为红色和绿色实现它。

library(shiny)
library(DT)
library(colourpicker)

callback <- c(
  "table.on('click', 'td', function(e) {",
  "  const $cell = table.cell(this).nodes().to$();",
  "  const RGB = $cell.css('background-color');",
  "  const cellColor = '#' + RGB.match(/\\d+/g).map(x => (+x).toString(16).padStart(2,0)).join``",
  "  const selectedColor = $('#color').val().toLowerCase();",
  "  const color = cellColor == selectedColor ? '' : selectedColor;",
  "  $cell.css('background-color', color);",
  "});"
)

customize <- "
function(xlsx, button, table) {
 
  const LETTERS = 
    ['A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'];

  var sheet = xlsx.xl.worksheets['sheet1.xml'];
 
  var row = 0;
  const num_columns = table.columns().count();
 
  $('row', sheet).each(function(x) {
    if(x > 1) {
      for(let i=0; i < num_columns; i++) {
        const $cell = $(table.cell(':eq('+row+')', i).node()); 
        const RGB = $cell.css('background-color');
        const cellColor = '#' + RGB.match(/\\d+/g).map(x => (+x).toString(16).padStart(2,0)).join``;
        if(cellColor == '#ff0000') {
          $('row:eq(' + (x) + ') c[r^=' + (LETTERS[i]) + ']', sheet).attr('s', '10');
        } else if(cellColor == '#00ff00') {
          $('row:eq(' + (x) + ') c[r^=' + (LETTERS[i]) + ']', sheet).attr('s', '15');
        }
      }
      row++;
    }
  });
}"
  

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      colourInput(
        "color", 
        "Choose background color",
        palette = "limited",
        closeOnClick = TRUE
      )
    ),
    mainPanel(
      br(),
      DTOutput("dtable")
    )
  )
)

server <- function(input, output, session) {
  
  output[["dtable"]] <- renderDT({
    datatable(
      iris, 
      extensions = "Buttons",
      selection = "none",
      callback = JS(callback),
      options = list(
        dom = "Bfrtip",
        buttons = list(
          list(
            extend = "excel",
            text = "Save XLSX",
            customize = JS(customize)
          )
        )
      )
    )
  })
}

shinyApp(ui, server)

相关问题