如何下载Shiny App中无HTML标签的tableby/kbl生成表格

问题分析 #

你当前的代码中，页面显示和下载复用了summary(tab1, text = "html")生成的带HTML标签的data.frame，后续用gsub移除标签时破坏了列名结构，导致Excel列名异常。核心问题是用带HTML格式的数据源做下载，正确做法是为下载单独生成纯文本格式的tableby结果。

解决方案 #

核心思路 #

页面显示保留HTML格式的tableby结果（用于kable渲染加粗等样式），下载时使用纯文本格式的tableby结果，从源头避免HTML标签产生，无需后续复杂的标签清理。

修改步骤 #

1. 新增下载专用的reactive对象，生成纯文本格式的tableby结果（设置text = "text"）
2. 移除原来的rapply+gsub标签清理逻辑，直接用纯文本结果生成Excel
3. 页面显示的reactive对象仍使用HTML格式，不影响前端渲染效果

修改后的完整代码 #

library(shiny)
library(tidyverse)
library(readxl)
library(arsenal)
library(kableExtra)

ui <- fluidPage(
  titlePanel("(in true app, user uploads the data)"),
  sidebarLayout(
    sidebarPanel(
      downloadButton(
        outputId = "downloadTable",
        label = "Descargar tabla"
      )
    ),
    mainPanel(
      tabsetPanel(
        type = "tabs",
        tabPanel(
          "Tabla 1",
          htmlOutput("table")
        ),
        tabPanel(
          "Tabla 2",
          htmlOutput("table2")
        )
      )
    )
  )
)

server <- function(input, output, session) {
  
  ID <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19)
  Provincia <- c("Santa Fe", "Santa Fe", "Cordoba", "Santa Fe", "Santa Fe", "Cordoba", "Cordoba", "Santa Fe", "Cordoba", "Cordoba", "Santa Fe", "Santa Fe", "Santa Fe", "Santa Fe", "Santa Fe", "Cordoba", "Cordoba", "Cordoba", "Santa Fe")
  Ciudad <- c("Carlos Paz", "Esperanza", "Rafaela", "Carlos Paz", "Carlos Paz", "Rafaela", "Villa General", "Belgrano", "Villa General Belgrano", "Rafaela", "Esperanza", "Rafaela", "Esperanza", "Esperanza", "Villa General", "Belgrano", "Carlos Paz", "Carlos Paz", "Esperanza")
  Valor1 <- rpois(n = 19, lambda = 10)
  Valor2 <- runif(n = 19, min = 1, max = 10)
  Color <- c("Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo", "Azul", "Rojo")
  df <- data.frame(ID, Provincia, Ciudad, Valor1, Valor2, Color)
  
  base <- reactive({
    df
  })

  controles <- reactive({
    tableby.control(
      test = T,
      total = T,
      numeric.test = "anova", cat.test = "chisq",
      numeric.stats = c("meanCI"),
      cat.stats = c("countpct"),
      stats.labels = list(
        meanCI = "Media (95%CI)",
        countpct = "n (%)"
      )
    )
  })
  
  # 页面显示用：带HTML格式的tableby结果
  tabla1 <- reactive({
    x <- base()
    my_controls <- controles()
    tab1 <- tableby(Color ~ Valor1+Valor2, data=x, control=my_controls)
    as.data.frame(summary(tab1,digits=1, text = "html"))
  })
  
  output$table <- function(){
    kable(tabla1(),align = "lccccc", escape = FALSE)%>%
      kable_styling(bootstrap_options = c("striped", "hover","condensed","responsive"), full_width = TRUE)
  }
  
  tabla2 <- reactive({
    x <- base()
    my_controls <- controles()
    tab2 <- tableby(Provincia ~ Valor1+Valor2, data=x, control=my_controls)
    as.data.frame(summary(tab2,digits=1, text = "html"))
  })
  
  output$table2 <- function(){
    kable(tabla2(),align = "lccccc", escape = FALSE)%>%
      kable_styling(bootstrap_options = c("striped", "hover","condensed","responsive"), full_width = TRUE)
  }
  
  # 下载专用：纯文本格式的tableby结果
  tabla1_download <- reactive({
    x <- base()
    my_controls <- controles()
    tab1 <- tableby(Color ~ Valor1+Valor2, data=x, control=my_controls)
    as.data.frame(summary(tab1,digits=1, text = "text"))
  })
  
  tabla2_download <- reactive({
    x <- base()
    my_controls <- controles()
    tab2 <- tableby(Provincia ~ Valor1+Valor2, data=x, control=my_controls)
    as.data.frame(summary(tab2,digits=1, text = "text"))
  })
  
  data_list <- reactive({
    list(
      "Tabla 1" = tabla1_download(),
      "Tabla 2" = tabla2_download()
    )
  })
  
  output$downloadTable <- downloadHandler(
    filename = function() {"prueba1.xlsx"},
    content = function(file) {write_xlsx(data_list(), path = file)}
  )
}

shinyApp(ui, server)

额外优化 #

• 给下载的工作表命名（list("Tabla 1" = ..., "Tabla 2" = ...)），让Excel文件更易读
• 分离页面显示和下载的数据源，避免互相干扰

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