R Shiny DT表格导出Excel丢失单元格背景色的解决问询

问题 #

在R Shiny的DT表格中通过点击设置了单元格背景色，但使用默认导出按钮生成的Excel文件仅包含数据，丢失了背景色设置。

核心原因 #

DT默认的Excel导出仅提取表格的原始数据，不会捕获前端通过JavaScript动态设置的CSS背景样式。需要通过自定义导出逻辑，直接修改生成的XLSX文件的底层XML结构来应用单元格样式。

修改要点 #

1. 替换默认导出按钮：将原来的'excel'按钮替换为自定义按钮，通过extend = "excel"继承基础导出功能，同时添加customize参数绑定自定义处理函数。
2. 编写自定义样式处理JS函数：遍历页面表格的每个单元格，获取其背景色，然后对应修改XLSX文件中sheet的XML节点，为匹配颜色的单元格设置对应样式编号。
3. 注意样式编号对应关系：示例中使用了XLSX内置的红色（s="10"）和绿色（s="15"）样式，若需要其他颜色，可扩展样式判断逻辑。

完整修改后代码 #

library(shiny)
library(DT)
library(htmltools)
library(colourpicker)
library(shinyWidgets)
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)

额外说明 #

• 示例中仅处理了红色（#ff0000）和绿色（#00ff00），若需要支持更多颜色，只需在customize函数中添加对应的else if分支，匹配目标颜色并设置合适的样式编号。
• 样式编号s对应XLSX的内置样式，若需要自定义颜色，可进一步修改XLSX的样式XML部分，但内置样式已能满足基础需求。

内容的提问来源于stack exchange，提问作者KApril