Я собираюсь оставить этот вопрос открытым на несколько дней, чтобы посмотреть, есть ли у кого-нибудь лучший ответ.
На данный момент мне удалось взломать решение, изменив функцию excelTable.
Я добавил к функции строку paramList$tableHeight <- "500px" и переименовал функцию в excelTable2.
Я нашел этот параметр на веб-сайте jExcel: Параметры jExcel
Думаю, я, вероятно, добавлю высоту в качестве входного параметра в excelTable2.
excelTable2 = function (data = NULL, columns = NULL, colHeaders = NULL, rowHeight = NULL,
nestedHeaders = NULL, defaultColWidth = NULL, minDimensions = NULL,
columnSorting = TRUE, columnDrag = FALSE, columnResize = TRUE,
rowResize = FALSE, rowDrag = TRUE, editable = TRUE, allowInsertRow = TRUE,
allowInsertColumn = TRUE, allowDeleteRow = TRUE, allowDeleteColumn = TRUE,
allowRenameColumn = TRUE, allowComments = FALSE, wordWrap = FALSE,
selectionCopy = TRUE, mergeCells = NULL, search = FALSE,
pagination = NULL, fullscreen = FALSE, lazyLoading = FALSE,
loadingSpin = FALSE, style = NULL, autoColTypes = TRUE, showToolbar = FALSE,
dateFormat = "DD/MM/YYYY", digits = 4, autoWidth = TRUE,
autoFill = FALSE, getSelectedData = FALSE, ...)
{
paramList <- list()
if (!is.null(data)) {
if (is.data.frame(data) || is.matrix(data)) {
paramList$data <- jsonlite::toJSON(data, dataframe = "values",
na = "null", digits = digits)
}
else {
stop("'data' must be either a matrix or a data frame, cannot be ",
class(data))
}
}
if (is.null(columns) && is.null(colHeaders)) {
if (!is.null(data)) {
warning("Since both column title and colHeaders are not specified 'data' column name will be used as column headers")
paramList$colHeaders = colnames(data)
}
}
else if (is.null(columns) && !is.null(colHeaders)) {
if (!is.vector(colHeaders)) {
stop("'colHeaders' must be a vector, cannot be ",
class(colHeaders))
}
if (!is.null(data)) {
if (ncol(data) != length(colHeaders)) {
stop("length of 'colHeader' should be equal the number of columns in the 'data', 'data' has ",
ncol(data), "but the length of 'colHeader' is ",
length(colHeaders))
}
}
paramList$colHeaders <- jsonlite::toJSON(colHeaders)
}
else if (!is.null(columns)) {
if (!is.data.frame(columns)) {
stop("'columns' must be a dataframe, cannot be ",
class(columns))
}
if (!is.null(data)) {
if (nrow(columns) != ncol(data)) {
stop("number of rows in 'columns' should be equal to number of columns in 'data', expected number of rows in 'columns' to be ",
ncol(data), " but got ", nrow(columns))
}
}
if (!"title" %in% colnames(columns)) {
if (is.null(colHeaders)) {
if (!is.null(data)) {
warning("Since both column title and colHeaders are not specified 'data' column name will be used as column headers")
paramList$colHeaders = jsonlite::toJSON(colnames(data))
}
}
else {
paramList$colHeaders = jsonlite::toJSON(colHeaders)
}
}
paramList$columns <- jsonlite::toJSON(columns)
}
if (autoColTypes && !is.null(data)) {
if (is.null(columns)) {
message("Since 'type' attribute is not specified and autoColTypes is true, detecting type from 'data'")
colTypes <- get_col_types(data)
columns <- data.frame(type = colTypes)
columns <- add_source_for_dropdown_type(data, columns)
paramList$columns <- jsonlite::toJSON(columns)
}
else {
if (!"type" %in% colnames(columns) && autoColTypes) {
message("Since 'type' attribute is not specified and autoColTypes is true, detecting type from 'data'")
colTypes <- get_col_types(data)
columns$type <- colTypes
columns <- add_source_for_dropdown_type(data,
columns)
paramList$columns <- jsonlite::toJSON(columns)
}
}
}
if (!is.null(rowHeight)) {
if (!is.data.frame(rowHeight) && !is.matrix(rowHeight)) {
stop("'rowHeight' must either be a matrix or a dataframe, cannot be ",
class(rowHeight))
}
if (ncol(rowHeight) != 2) {
stop("'rowHeight' must either be a matrix or a dataframe with two columns, but got ",
ncol(rowHeight), " column(s)")
}
paramList$rowHeight <- jsonlite::toJSON(rowHeight, dataframe = "values")
}
if (!is.null(nestedHeaders)) {
if (!is.list(nestedHeaders)) {
stop("'nestedHeaders' must be a list of dataframe(s), cannot be ",
class(nestedHeaders))
}
headerAttributes <- c("title", "colspan")
for (nestedHeader in nestedHeaders) {
if (!is.data.frame(nestedHeader)) {
stop("'nestedHeaders' must be a list of dataframe(s), but got list of ",
class(nestedHeader), "(s)")
}
if (ncol(nestedHeader) < 2 || nrow(nestedHeader) <
1) {
stop("the dataframe(s) in 'nestedHeaders must contain at least two columns and one row, 'title' and 'colspan', but got only ",
ncol(nestedHeader), " column and ", nrow(nestedHeader),
" row")
}
if (!"title" %in% colnames(nestedHeader)) {
stop("one of the column in the dataframe in list of 'nestedHeaders' should have 'title' as header which will be used as title of the nested header")
}
if (!"colspan" %in% colnames(nestedHeader)) {
stop("one of the column in the dataframe in list of 'nestedHeaders' should have 'colspan' as header which will be used to determine the number of column it needs to span")
}
if (!all(colnames(nestedHeader) %in% headerAttributes)) {
warning("unknown headers(s) ", colnames(nestedHeader)[!colnames(nestedHeader) %in%
headerAttributes], " for 'nestedHeader' found, ignoring column with those header(s)")
}
}
paramList$nestedHeaders <- jsonlite::toJSON(nestedHeaders,
dataframe = "rows")
}
if (!is.null(defaultColWidth)) {
if (!is.numeric(defaultColWidth) || length(defaultColWidth) >
1) {
stop("'defaultColWidth' must be a numeric value of length 1 but got ",
class(defaultColWidth), " of length ",
length(defaultColWidth))
}
paramList$defaultColWidth <- defaultColWidth
}
if (!is.null(minDimensions)) {
if (!is.vector(minDimensions)) {
stop("'minDimensions' must be vector but got ",
class(minDimensions))
}
if (length(minDimensions) != 2) {
stop("'minDimensions' must be a vector of length of 2 but got length of ",
length(minDimensions))
}
paramList$minDimensions <- minDimensions
}
for (arg in c("columnSorting", "columnDrag",
"columnResize", "rowResize", "rowDrag",
"editable", "allowInsertRow", "allowInsertColumn",
"allowDeleteRow", "allowDeleteColumn", "allowRenameColumn",
"allowComments", "wordWrap", "selectionCopy",
"search", "fullscreen", "lazyLoading",
"loadingSpin", "showToolbar", "autoWidth",
"autoFill", "getSelectedData")) {
argvalue <- get(arg)
if (!is.null(argvalue)) {
if (is.logical(argvalue)) {
paramList[[arg]] <- argvalue
}
else {
warning("Argument ", arg, " should be either TRUE or FALSE. Ignoring ",
arg, ".", call. = FALSE)
paramList[[arg]] <- NULL
}
}
}
if (!is.null(mergeCells)) {
if (!is.list(mergeCells)) {
stop("expected 'mergeCells' to be a list but got ",
class(mergeCells))
}
for (mergeCell in mergeCells) {
if (!is.vector(mergeCell)) {
stop("expected each parameter in 'mergeCells' list to be a vector but got ",
class(mergeCell))
}
if (length(mergeCell) != 2) {
stop("expected each parameter in 'mergeCells' list to be a vector of length 2 but got vector of length ",
length(mergeCells))
}
}
paramList$mergeCells <- mergeCells
}
if (!is.null(pagination)) {
if (!is.numeric(pagination) || length(pagination) > 1) {
stop("'pagination' must be an integer of length 1 but got ",
class(pagination), " of length ", length(pagination))
}
paramList$pagination <- pagination
}
if (!is.null(style)) {
if (!is.list(style)) {
stop("'style' should be a list but got ", class(style))
}
paramList$style <- style
}
if (!is.null(dateFormat)) {
paramList$dateFormat <- dateFormat
}
paramList$tableHeight <- "500px"
paramList <- append(paramList, list(...))
htmlwidgets::createWidget(name = "jexcel", x = paramList,
width = if (fullscreen)
"100%"
else 0, height = if (fullscreen)
"100%"
else 0, package = "excelR",
)
}
Рабочее приложение после определения выше excelTable2
shinyApp(
ui = navbarPage("title", selected = "main",
position = "fixed-top",
tags$style(type="text/css", "body {padding-top: 70px;}"),
tabPanel("main", id = "main",
fluidPage(
excelOutput("table", width = "100%", height = "100%")
#htmlOutput("table", width = "100%", height = "500px")
)
)
),
server = function(input, output, session) {
output$table <-renderExcel(
excelTable2(
data = iris,
autoColTypes = FALSE,
autoFill = TRUE,
fullscreen = FALSE,
lazyLoading = TRUE,
search = TRUE
)
)
}
)