如何在RMD文件导出DT至XLSX时保留colspan属性？

问题概述 #

在RMD中使用带自定义合并表头的DT表格时，默认Buttons扩展导出Excel会丢失主列头（如“Sepal”“Petal”）；尝试改写现有方案时，JS代码在RMD编织阶段无法获取表格DOM元素，且手动运行也无法正确导出完整数据。

解决方案1：修复前端JS导出逻辑 #

核心是等待DT表格初始化完成后再执行导出代码，同时正确配置TableExport保留合并表头：

---
title: "Test"
output: 
  flexdashboard::flex_dashboard:
    theme: bootstrap
    orientation: rows
---

<script src="https://cdnjs.cloudflare.com/ajax/libs/xlsx/0.18.5/xlsx.core.min.js"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/FileSaver.js/2.0.0/FileSaver.min.js"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/TableExport/5.2.0/js/tableexport.min.js"></script>

```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
library(dplyr)
library(htmltools)

my table #

sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'Species'),
      th(colspan = 2, 'Sepal'),
      th(colspan = 2, 'Petal')
    ),
    tr(
      lapply(rep(c('Length', 'Width'), 2), th)
    )
  )
))

datatable(iris[1:5, c(5, 1:4)],
          container = sketch, 
          rownames = FALSE, 
          elementId = "myID",
          extensions = c('Buttons'),
          options = list(
            dom = 'B',
            buttons = list(
              # 保留原导出按钮
              list(extend = "excel", filename = "Test_excel"),
              # 新增带合并表头的导出按钮
              list(
                text = "Excel(带合并表头)",
                action = DT::JS("function(e, dt, node, config) {
                  // 延迟执行确保DT已初始化
                  setTimeout(function() {
                    var $table = $('#myID').find('table');
                    var exportInstance = $table.tableExport({
                      formats: ['xlsx'],
                      filename: 'Test_excel_with_headers',
                      sheetname: 'Sheet1',
                      exportButtons: false, // 隐藏默认导出按钮
                      preserveColours: false
                    });
                    var exportData = exportInstance.getExportData();
                    var targetData = exportData[Object.keys(exportData)[0]]['xlsx'];
                    exportInstance.export2file(
                      targetData.data, 
                      targetData.mimeType, 
                      targetData.filename, 
                      targetData.fileExtension, 
                      targetData.merges, 
                      targetData.RTL, 
                      targetData.sheetname
                    );
                  }, 300); // 延迟时间可根据表格大小调整
                }")
              )
            )
          ))

## 解决方案2：伪下载按钮方案（R端生成Excel）
跳过前端导出，直接在R中生成带合并表头的Excel文件，通过HTML下载按钮触发下载，完全保留表格格式：

```r
---
title: "Test"
output: 
  flexdashboard::flex_dashboard:
    theme: bootstrap
    orientation: rows
---

```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
library(dplyr)
library(htmltools)
library(openxlsx)
library(base64enc)

my table #

# 准备数据
excel_data <- iris[1:5, c(5, 1:4)]

# 生成带合并表头的Excel文件
wb <- createWorkbook()
addWorksheet(wb, "Sheet1")
# 写入第一行主表头
writeData(wb, "Sheet1", c("Species", "Sepal", "", "Petal", ""), startRow = 1, colNames = FALSE)
# 写入第二行子表头
writeData(wb, "Sheet1", c("", "Length", "Width", "Length", "Width"), startRow = 2, colNames = FALSE)
# 设置单元格合并
mergeCells(wb, "Sheet1", cols = 2:3, rows = 1)
mergeCells(wb, "Sheet1", cols = 4:5, rows = 1)
# 写入数据
writeData(wb, "Sheet1", excel_data, startRow = 3, colNames = FALSE)

# 保存为临时文件并转base64
temp_file <- tempfile(fileext = ".xlsx")
saveWorkbook(wb, temp_file, overwrite = TRUE)
base64_content <- base64encode(temp_file)

# 添加下载按钮
tags$a(
  href = paste0("data:application/vnd.openxmlformats-officedocument.spreadsheetml.sheet;base64,", base64_content),
  download = "Test_excel_with_headers.xlsx",
  class = "btn btn-primary",
  "下载带合并表头的Excel"
)

# 显示原DT表格
sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'Species'),
      th(colspan = 2, 'Sepal'),
      th(colspan = 2, 'Petal')
    ),
    tr(
      lapply(rep(c('Length', 'Width'), 2), th)
    )
  )
))

datatable(excel_data,
          container = sketch, 
          rownames = FALSE, 
          extensions = c('Buttons'),
          options = list(
            dom = 'B',
            buttons = list(list(extend = "excel", filename = "Test_excel"))
          ))

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