如何用actionButton为rhandsontable表格添加带下拉菜单的列

你的代码核心问题在于仅为初始的Series 1列配置了下拉菜单，新增的列没有被设置对应的下拉属性，同时选中单元格解除只读的逻辑也只绑定了Series 1列，导致新增列既无下拉也无法编辑。

修复方案 #

1. 遍历表格所有列，为每一列统一配置下拉菜单；
2. 动态获取选中的列，让所有列的选中单元格都能解除只读状态。

修改后的完整代码 #

library(shiny)
library(rhandsontable)

ui <- fluidPage(br(),
  mainPanel(
    actionButton("add", "Add column"),br(),br(),
    rHandsontableOutput("Tbl")
    )
  )

server <- function(input, output) {
  DF <- reactiveVal(
    data.frame(
      'Series 1' = NA_character_, 
      stringsAsFactors = FALSE,
      row.names = c("Select option"),
      check.names = FALSE
      )
    )
  
  observeEvent(input$Tbl,{DF(hot_to_r(input$Tbl))})
  
  output$Tbl <- renderRHandsontable({
    select_option <- c(NA_character_, "dog", "cat") # 下拉选项
    tmp <- rhandsontable(DF(), rowHeaderWidth = 200, selectCallback = TRUE, height = 300) %>%
      hot_cols(colWidths = 100)
    
    # 遍历所有列，为每一列设置下拉菜单
    for(col_name in colnames(DF())){
      tmp <- tmp %>%
        hot_col(col_name, 
                allowInvalid = FALSE, 
                type = "dropdown", 
                source = select_option,
                readOnly = TRUE)
    }
    
    # 动态解除选中单元格的只读状态
    if(!is.null(input$Tbl_select$select$r) && !is.null(input$Tbl_select$select$c)){
      selected_col <- colnames(DF())[input$Tbl_select$select$c]
      tmp <- tmp %>% 
        hot_cell(row = input$Tbl_select$select$r, col = selected_col, readOnly = FALSE)
    }
    tmp
  })
  
  observeEvent(input$add, {
    new_col_name <- paste("Series", ncol(DF()) + 1)
    newCol <- data.frame(!!new_col_name := NA_character_, stringsAsFactors = FALSE)
    DF(cbind(DF(), newCol))
  })
  
}

shinyApp(ui = ui, server = server)

关键修改说明 #

• 新增列名生成改为直接基于DF()的列数，避免依赖input$Tbl可能出现的延迟问题；
• 通过for循环遍历所有列，统一配置下拉属性，确保新增列也能继承下拉菜单；
• 动态获取选中列的列名，让任意列的选中单元格都能解除只读。

内容的提问来源于stack exchange，提问作者Village.Idyot