diff --git a/NEWS.md b/NEWS.md index 0a52b139b..7d761e48f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # crane 0.3.3.9001 +* `theme_gtsummary_roche()` now frames the flextable column labels with an outer border only, removing the internal borders between header rows and the inconsistent missing right border. (#272) + * Fixed minor typo in the DESCRIPTION file. * `tbl_hierarchical_incidence_rate()` gains an `overall_row` argument to control whether the overall summary row is included. (#264) diff --git a/R/theme_gtsummary_roche.R b/R/theme_gtsummary_roche.R index 1bbd04d5a..9a6c767d7 100644 --- a/R/theme_gtsummary_roche.R +++ b/R/theme_gtsummary_roche.R @@ -96,8 +96,13 @@ theme_gtsummary_roche <- function(font_size = NULL, ), valign = list( # valign only because it will append to to last commands rlang::expr(flextable::fontsize(size = !!((font_size %||% 8) - 1), part = "footer")), # second fontsize spectbl - rlang::expr(flextable::border_outer(part = "header", border = !!border)), # second command from border - rlang::expr(flextable::border_inner_h(part = "header", border = !!border)), # fix different line sizes + # outer box only. style = "none" (not width = 0) so docx doesn't draw + # a line between a spanner and the column labels. + rlang::expr(flextable::border_inner_h( + part = "header", + border = officer::fp_border(width = 0, style = "none") + )), + rlang::expr(flextable::border_outer(part = "header", border = !!border)), rlang::expr(flextable::valign(valign = "top", part = "all")), rlang::expr(flextable::font(fontname = "Arial", part = "all")), rlang::expr(flextable::padding(padding.top = 0, part = "all")), diff --git a/tests/testthat/_snaps/theme_gtsummary_roche.md b/tests/testthat/_snaps/theme_gtsummary_roche.md index 8392e7167..45ec25003 100644 --- a/tests/testthat/_snaps/theme_gtsummary_roche.md +++ b/tests/testthat/_snaps/theme_gtsummary_roche.md @@ -26,11 +26,11 @@ flextable::fontsize(size = 7, part = "footer") $user_added3[[2]] - flextable::border_outer(part = "header", border = list(width = 0.5, - color = "#666666", style = "solid")) + flextable::border_inner_h(part = "header", border = officer::fp_border(width = 0, + style = "none")) $user_added3[[3]] - flextable::border_inner_h(part = "header", border = list(width = 0.5, + flextable::border_outer(part = "header", border = list(width = 0.5, color = "#666666", style = "solid")) $user_added3[[4]] @@ -52,4 +52,3 @@ flextable::set_table_properties(layout = "autofit") - diff --git a/tests/testthat/test-theme_gtsummary_roche.R b/tests/testthat/test-theme_gtsummary_roche.R index 3a0f9a3b2..423c6708e 100644 --- a/tests/testthat/test-theme_gtsummary_roche.R +++ b/tests/testthat/test-theme_gtsummary_roche.R @@ -119,8 +119,60 @@ test_that("theme pre-conversion modifies header not to be bold and border only 0 # check no bold syntax in header expect_true(all(!grepl(tbl$header$dataset[1, -1], pattern = "\\*"))) - # check border width is 0.5 - expect_true(all(tbl$header$styles$cells$border.width.bottom$data == 0.5)) + # Column labels are framed with an outer border only (width 0.5), so the + # outer edges carry the border while inner edges between header rows are 0. + n_hdr <- nrow(tbl$header$dataset) + bottom <- tbl$header$styles$cells$border.width.bottom$data + top <- tbl$header$styles$cells$border.width.top$data + expect_true(all(top[1, ] == 0.5)) # top of the block + expect_true(all(bottom[n_hdr, ] == 0.5)) # bottom of the block + if (n_hdr > 1) { + expect_true(all(bottom[-n_hdr, ] == 0)) # no internal horizontal borders + # The internal border must also be style "none": a width-0 solid border is + # still written as a visible single line in docx (regression with spanners). + style_bottom <- tbl$header$styles$cells$border.style.bottom$data + expect_true(all(style_bottom[-n_hdr, ] == "none")) + } +}) + +test_that("theme draws no internal horizontal line between spanner and column labels in docx", { + skip_if_not_installed("officer") + skip_if_not_installed("flextable") + + tbl <- with_gtsummary_theme( + x = theme_gtsummary_roche(), + { + t1 <- gtsummary::trial |> gtsummary::tbl_summary(by = trt, include = age) + t2 <- gtsummary::trial |> gtsummary::tbl_summary(by = trt, include = grade) + gtsummary::tbl_merge( + list(t1, t2), + tab_spanner = c("**Group A**", "**Group B**") + ) |> + gtsummary::as_flex_table() + } + ) + + f <- withr::local_tempfile(fileext = ".docx") + flextable::save_as_docx(tbl, path = f) + d <- withr::local_tempdir() + utils::unzip(f, exdir = d) + xml <- paste(readLines(file.path(d, "word", "document.xml"), warn = FALSE), collapse = "") + rows <- regmatches(xml, gregexpr("", xml))[[1]] + + spanner <- rows[grepl("Group A", rows)][1] + labels <- rows[grepl("Characteristic", rows)][1] + + border_val <- function(row, side) { + m <- regmatches(row, regexpr(sprintf('