├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── rhub.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── RcppExports.R ├── dim_ranges.R ├── flexlsx-package.R ├── ft_to_style.R ├── helpers.R ├── testsuite.R ├── wb_add_caption.R ├── wb_add_flextable.R ├── wb_apply_border.R ├── wb_apply_cell_styles.R ├── wb_apply_content.R ├── wb_apply_merge.R ├── wb_apply_text_styles.R └── wb_change_height_width.R ├── README.Rmd ├── README.md ├── codecov.yml ├── cran-comments.md ├── flexlsx.Rproj ├── inst └── CITATION ├── man ├── figures │ └── logo.png ├── flexlsx-package.Rd ├── ft_to_style_tibble.Rd ├── ft_to_xlsx_border.Rd ├── ftpart_to_style_tibble.Rd ├── get_dim_colwise.Rd ├── get_dim_ranges.Rd ├── get_dim_rowwise.Rd ├── handle_null_border.Rd ├── merge_resolve_type.Rd ├── prepare_color.Rd ├── style_to_hash.Rd ├── wb_add_caption.Rd ├── wb_add_flextable.Rd ├── wb_apply_border.Rd ├── wb_apply_cell_styles.Rd ├── wb_apply_content.Rd ├── wb_apply_merge.Rd ├── wb_apply_text_styles.Rd ├── wb_change_cell_width.Rd └── wb_change_row_height.Rd ├── src ├── .gitignore ├── RcppExports.cpp └── utils.cpp └── tests ├── testthat.R └── testthat ├── _snaps └── ft_to_style.md ├── test-dim_ranges.R ├── test-ft_to_style.R ├── test-string_num.R ├── test-wb_add_caption.R ├── test-wb_add_flextable.R ├── test-wb_apply_cell_styles.R └── test-wb_apply_merge.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^LICENSE\.md$ 5 | ^codecov\.yml$ 6 | ^\.github$ 7 | ^cran-comments\.md$ 8 | ^CRAN-SUBMISSION$ 9 | ^testsuite 10 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow only directly installs "hard" dependencies, i.e. Depends, 5 | # Imports, and LinkingTo dependencies. Notably, Suggests dependencies are never 6 | # installed, with the exception of testthat, knitr, and rmarkdown. The cache is 7 | # never used to avoid accidentally restoring a cache containing a suggested 8 | # dependency. 9 | on: 10 | push: 11 | branches: [main, master] 12 | pull_request: 13 | branches: [main, master] 14 | 15 | name: R-CMD-check-hard 16 | 17 | jobs: 18 | R-CMD-check: 19 | runs-on: ${{ matrix.config.os }} 20 | 21 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 22 | 23 | strategy: 24 | fail-fast: false 25 | matrix: 26 | config: 27 | - {os: ubuntu-latest, r: 'release'} 28 | 29 | env: 30 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 31 | R_KEEP_PKG_SOURCE: yes 32 | 33 | steps: 34 | - uses: actions/checkout@v3 35 | 36 | - uses: r-lib/actions/setup-pandoc@v2 37 | 38 | - uses: r-lib/actions/setup-r@v2 39 | with: 40 | r-version: ${{ matrix.config.r }} 41 | http-user-agent: ${{ matrix.config.http-user-agent }} 42 | use-public-rspm: true 43 | 44 | - uses: r-lib/actions/setup-r-dependencies@v2 45 | with: 46 | dependencies: '"hard"' 47 | cache: false 48 | extra-packages: | 49 | any::rcmdcheck 50 | any::testthat 51 | any::knitr 52 | any::rmarkdown 53 | needs: check 54 | 55 | - uses: r-lib/actions/check-r-package@v2 56 | with: 57 | upload-snapshots: true 58 | -------------------------------------------------------------------------------- /.github/workflows/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's generic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | 28 | setup: 29 | runs-on: ubuntu-latest 30 | outputs: 31 | containers: ${{ steps.rhub-setup.outputs.containers }} 32 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 33 | 34 | steps: 35 | # NO NEED TO CHECKOUT HERE 36 | - uses: r-hub/actions/setup@v1 37 | with: 38 | config: ${{ github.event.inputs.config }} 39 | id: rhub-setup 40 | 41 | linux-containers: 42 | needs: setup 43 | if: ${{ needs.setup.outputs.containers != '[]' }} 44 | runs-on: ubuntu-latest 45 | name: ${{ matrix.config.label }} 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | config: ${{ fromJson(needs.setup.outputs.containers) }} 50 | container: 51 | image: ${{ matrix.config.container }} 52 | 53 | steps: 54 | - uses: r-hub/actions/checkout@v1 55 | - uses: r-hub/actions/platform-info@v1 56 | with: 57 | token: ${{ secrets.RHUB_TOKEN }} 58 | job-config: ${{ matrix.config.job-config }} 59 | - uses: r-hub/actions/setup-deps@v1 60 | with: 61 | token: ${{ secrets.RHUB_TOKEN }} 62 | job-config: ${{ matrix.config.job-config }} 63 | - uses: r-hub/actions/run-check@v1 64 | with: 65 | token: ${{ secrets.RHUB_TOKEN }} 66 | job-config: ${{ matrix.config.job-config }} 67 | 68 | other-platforms: 69 | needs: setup 70 | if: ${{ needs.setup.outputs.platforms != '[]' }} 71 | runs-on: ${{ matrix.config.os }} 72 | name: ${{ matrix.config.label }} 73 | strategy: 74 | fail-fast: false 75 | matrix: 76 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 77 | 78 | steps: 79 | - uses: r-hub/actions/checkout@v1 80 | - uses: r-hub/actions/setup-r@v1 81 | with: 82 | job-config: ${{ matrix.config.job-config }} 83 | token: ${{ secrets.RHUB_TOKEN }} 84 | - uses: r-hub/actions/platform-info@v1 85 | with: 86 | token: ${{ secrets.RHUB_TOKEN }} 87 | job-config: ${{ matrix.config.job-config }} 88 | - uses: r-hub/actions/setup-deps@v1 89 | with: 90 | job-config: ${{ matrix.config.job-config }} 91 | token: ${{ secrets.RHUB_TOKEN }} 92 | - uses: r-hub/actions/run-check@v1 93 | with: 94 | job-config: ${{ matrix.config.job-config }} 95 | token: ${{ secrets.RHUB_TOKEN }} 96 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | 8 | name: test-coverage.yaml 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | test-coverage: 14 | runs-on: ubuntu-latest 15 | env: 16 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 17 | 18 | steps: 19 | - uses: actions/checkout@v4 20 | 21 | - uses: r-lib/actions/setup-r@v2 22 | with: 23 | use-public-rspm: true 24 | 25 | - uses: r-lib/actions/setup-r-dependencies@v2 26 | with: 27 | extra-packages: any::covr, any::xml2 28 | needs: coverage 29 | 30 | - name: Test coverage 31 | run: | 32 | cov <- covr::package_coverage( 33 | quiet = FALSE, 34 | clean = FALSE, 35 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 36 | ) 37 | covr::to_cobertura(cov) 38 | shell: Rscript {0} 39 | 40 | - uses: codecov/codecov-action@v4 41 | with: 42 | # Fail if error if not on PR, or if on PR and token is given 43 | fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} 44 | file: ./cobertura.xml 45 | plugin: noop 46 | disable_search: true 47 | token: ${{ secrets.CODECOV_TOKEN }} 48 | 49 | - name: Show testthat output 50 | if: always() 51 | run: | 52 | ## -------------------------------------------------------------------- 53 | find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true 54 | shell: bash 55 | 56 | - name: Upload test results 57 | if: failure() 58 | uses: actions/upload-artifact@v4 59 | with: 60 | name: coverage-test-failures 61 | path: ${{ runner.temp }}/package 62 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | R/test.R 6 | R/ft_debug.R 7 | *.xlsx 8 | *.html 9 | *.rds 10 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: flexlsx 2 | Type: Package 3 | Title: Exporting 'flextable' to 'xlsx' Files 4 | Version: 0.3.5 5 | Authors@R: person(given = "Tobias", 6 | family = "Heidler", 7 | role = c("aut", "cre", "cph"), 8 | email = "flexlsx@heidler.ovh", 9 | comment = c(ORCID = "0000-0001-9193-0980")) 10 | Description: Exports 'flextable' objects to 'xlsx' files, 11 | utilizing functionalities provided by 'flextable' and 'openxlsx2'. 12 | License: MIT + file LICENSE 13 | Encoding: UTF-8 14 | LazyData: true 15 | Imports: 16 | dplyr (>= 1.1.1), 17 | grDevices, 18 | openxlsx2 (>= 1.0.0), 19 | purrr, 20 | Rcpp, 21 | rlang, 22 | stringi, 23 | tibble, 24 | tidyr (>= 1.0.0) 25 | Suggests: 26 | covr, 27 | gtsummary, 28 | flextable (>= 0.9.5), 29 | testthat (>= 3.0.0), 30 | officer 31 | Depends: 32 | R (>= 4.1.0) 33 | Roxygen: list(markdown = TRUE) 34 | RoxygenNote: 7.3.2 35 | Config/testthat/edition: 3 36 | URL: https://github.com/pteridin/flexlsx 37 | BugReports: https://github.com/pteridin/flexlsx/issues 38 | LinkingTo: 39 | Rcpp 40 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2024 2 | COPYRIGHT HOLDER: Tobias Heidler 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2024 Tobias Heidler 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(wb_add_flextable) 4 | importFrom(Rcpp,sourceCpp) 5 | importFrom(dplyr,across) 6 | importFrom(dplyr,all_of) 7 | importFrom(dplyr,arrange) 8 | importFrom(dplyr,bind_cols) 9 | importFrom(dplyr,bind_rows) 10 | importFrom(dplyr,case_when) 11 | importFrom(dplyr,coalesce) 12 | importFrom(dplyr,everything) 13 | importFrom(dplyr,filter) 14 | importFrom(dplyr,first) 15 | importFrom(dplyr,group_by) 16 | importFrom(dplyr,if_else) 17 | importFrom(dplyr,lag) 18 | importFrom(dplyr,last) 19 | importFrom(dplyr,left_join) 20 | importFrom(dplyr,mutate) 21 | importFrom(dplyr,rename) 22 | importFrom(dplyr,row_number) 23 | importFrom(dplyr,rowwise) 24 | importFrom(dplyr,select) 25 | importFrom(dplyr,slice_min) 26 | importFrom(dplyr,starts_with) 27 | importFrom(dplyr,summarize) 28 | importFrom(grDevices,col2rgb) 29 | importFrom(grDevices,rgb) 30 | importFrom(openxlsx2,dims_to_rowcol) 31 | importFrom(openxlsx2,fmt_txt) 32 | importFrom(openxlsx2,int2col) 33 | importFrom(openxlsx2,wb_color) 34 | importFrom(purrr,map_chr) 35 | importFrom(purrr,pluck) 36 | importFrom(rlang,.data) 37 | importFrom(stringi,stri_count) 38 | importFrom(tibble,tibble) 39 | importFrom(tidyr,unnest_legacy) 40 | useDynLib(flexlsx, .registration = TRUE) 41 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # flexlsx 0.3.5 2 | 3 | * Use snake_case in openxlsx2 arguments (#42, thanks to @JanMarvin) 4 | 5 | 6 | # flexlsx 0.3.4 7 | 8 | * Hotfix for #40 - Export to Excel not working 9 | 10 | # flexlsx 0.3.2 11 | 12 | * Improved performance of wb_apply_border 13 | * Improved performance of wb_apply_merge 14 | * Bugfix: Styles from parent cells are applied to complex text paragraphs (#36, 15 | thanks to @ZhaonanFang) 16 | 17 | # flexlsx 0.3.1 18 | 19 | * Fix: Border issues (#32, thanks to @MeganMcAuliffe) 20 | * Fix: Some numbers where not formatted as numbers when 21 | `options("openxlsx2.string_nums" = TRUE)` 22 | * Implemented: `openxlsx2::current_sheet()` as default for `sheet` parameter 23 | (#34, thanks to @JanMarvin) 24 | * Still, throw an error when sheet does not exist 25 | * Completely reworked merge logic 26 | * Added new border types 27 | 28 | # flexlsx 0.3.0 29 | 30 | * Numerics will be written as numerics unless 31 | `options("openxlsx2.string_nums" = TRUE)` is set - thanks to @JanMarvin 32 | * BUGFIX #28: flextables without headers will be correctly displayed 33 | 34 | # flexlsx 0.2.2 35 | 36 | * CRAN release :) 37 | * Added Bugfix: Can't export flextable with no header (#28) 38 | 39 | # flexlsx 0.2.1 40 | 41 | * Fixes for CRAN release 42 | 43 | # flexlsx 0.1.3 44 | 45 | * Release candidate for CRAN 46 | 47 | # flexlsx 0.1.2 48 | 49 | * Column width will now be set (#3) 50 | * Row height will now be set (#11) 51 | * Bugfixes: 52 | * Number stored as text warning removed (#5) 53 | * Text-colors will now be handled correct (maybe?, #4) 54 | * Caption is longer than table (#3) 55 | * Caption `
` should be replaced by `\n` and the cell be wrapped? (#3) 56 | * Merged cells border issues fixed (#3) 57 | 58 | # flexlsx 0.1.1 59 | 60 | * Several Bugfixes regarding caption generation 61 | * Cleaned up `devtools::check()` warnings & documentation errors 62 | 63 | # flexlsx 0.1.0 64 | 65 | * First implementation 66 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | cpp_merge_resolve_type <- function(df_to_merge) { 5 | .Call(`_flexlsx_cpp_merge_resolve_type`, df_to_merge) 6 | } 7 | 8 | -------------------------------------------------------------------------------- /R/dim_ranges.R: -------------------------------------------------------------------------------- 1 | #' Retrieves dims of same style rows within same column 2 | #' 3 | #' @description 4 | #' `r lifecycle::badge("experimental")` 5 | #' 6 | #' @param df_x styling information incl. col_id & row_id 7 | #' 8 | #' @importFrom dplyr select group_by summarize mutate 9 | #' @importFrom dplyr arrange bind_cols first everything slice_min 10 | #' @importFrom openxlsx2 int2col 11 | #' @importFrom rlang .data 12 | #' 13 | #' @return merged styles as a [tibble][tibble::tibble-package] 14 | get_dim_ranges <- function(df_x) { 15 | df_style_hashed <- df_x |> 16 | style_to_hash() 17 | 18 | df_rowwise <- df_x |> 19 | get_dim_rowwise(df_style_hashed) 20 | 21 | df_colwise <- df_rowwise |> 22 | get_dim_colwise() 23 | 24 | df_aggregated <- df_colwise |> 25 | mutate( 26 | dims = paste0( 27 | openxlsx2::int2col(.data$col_from), 28 | .data$row_from, 29 | ":", 30 | openxlsx2::int2col(.data$col_to), 31 | .data$row_to 32 | ), 33 | multi_rows = .data$row_to != .data$row_from, 34 | multi_cols = .data$col_to != .data$col_from 35 | ) |> 36 | left_join(df_style_hashed, by = "hash") 37 | 38 | return(df_aggregated) 39 | } 40 | 41 | #' Retrieves hashed style information 42 | #' 43 | #' @description 44 | #' `r lifecycle::badge("experimental")` 45 | #' 46 | #' Converts each style to an individual integer hash 47 | #' for easy comparison and aggregation. 48 | #' 49 | #' @inheritParams get_dim_ranges 50 | #' 51 | #' @return hashed style information as a [tibble][tibble::tibble-package] 52 | #' 53 | #' @importFrom dplyr arrange group_by summarize mutate all_of 54 | #' @importFrom dplyr across row_number 55 | #' 56 | style_to_hash <- function(df_x) { 57 | df_style_hashed <- df_x |> 58 | arrange(across(all_of(c( 59 | "row_id", "col_id" 60 | )))) |> 61 | group_by(across(-all_of(c( 62 | "col_id", "row_id" 63 | )))) |> 64 | summarize(hash = 1L, .groups = "drop") |> 65 | mutate(hash = row_number()) 66 | 67 | cols_to_join <- names(df_style_hashed)[names(df_style_hashed) != "hash"] 68 | attr(df_style_hashed, "cols_to_join") <- cols_to_join 69 | return(df_style_hashed) 70 | } 71 | 72 | 73 | #' Groups each column with same style each row 74 | #' 75 | #' @description 76 | #' `r lifecycle::badge("experimental")` 77 | #' 78 | #' @inheritParams get_dim_ranges 79 | #' @param df_style_hashed [tibble][tibble::tibble-package] of hashed style 80 | #' information 81 | #' 82 | #' @return [tibble][tibble::tibble-package] of row-wise aggregates style 83 | #' information 84 | #' 85 | #' @importFrom dplyr left_join select arrange group_by 86 | #' @importFrom dplyr mutate summarize first last 87 | #' @importFrom dplyr all_of first last across lag 88 | #' @importFrom rlang .data 89 | #' 90 | get_dim_rowwise <- function(df_x, df_style_hashed) { 91 | df_rows <- df_x |> 92 | left_join(df_style_hashed, by = attr(df_style_hashed, "cols_to_join")) |> 93 | select(all_of(c("row_id", "col_id", "hash"))) |> 94 | arrange(across(all_of(c( 95 | "row_id", "col_id" 96 | )))) |> 97 | group_by(across(all_of("row_id"))) |> 98 | mutate(col_change = cumsum(.data$hash != 99 | lag(.data$hash, 100 | default = first(.data$hash) 101 | ))) |> 102 | group_by(across(all_of(c( 103 | "row_id", "hash", "col_change" 104 | )))) |> 105 | summarize( 106 | col_from = min(.data$col_id), 107 | col_to = max(.data$col_id), 108 | .groups = "drop" 109 | ) |> 110 | select(-all_of("col_change")) |> 111 | arrange(across(all_of(c( 112 | "row_id", "col_from" 113 | )))) 114 | 115 | return(df_rows) 116 | } 117 | 118 | 119 | #' Groups each row with same style each column 120 | #' 121 | #' @description 122 | #' `r lifecycle::badge("experimental")` 123 | #' 124 | #' @param df_rows [tibble][tibble::tibble-package] of row-wise aggregates style 125 | #' 126 | #' @return [tibble][tibble::tibble-package] of column-wise aggregates style 127 | #' 128 | #' @importFrom dplyr arrange group_by summarize mutate all_of 129 | #' @importFrom dplyr across lag 130 | #' @importFrom rlang .data 131 | #' 132 | get_dim_colwise <- function(df_rows) { 133 | df_rows |> 134 | arrange(across(all_of(c( 135 | "col_from", "col_to", "row_id" 136 | )))) |> 137 | group_by(across(all_of(c( 138 | "col_from", "col_to" 139 | )))) |> 140 | mutate( 141 | row_change = .data$row_id != lag(.data$row_id, 142 | default = min(.data$row_id) 143 | ) + 1L, 144 | style_change = .data$hash != lag(.data$hash, 145 | default = min(.data$hash) 146 | ), 147 | change = cumsum(.data$row_change | .data$style_change) 148 | ) |> 149 | group_by(across(all_of( 150 | c("hash", "col_from", "col_to", "change") 151 | ))) |> 152 | summarize( 153 | row_from = min(.data$row_id), 154 | row_to = max(.data$row_id), 155 | .groups = "drop" 156 | ) |> 157 | select(-all_of("change")) |> 158 | arrange(across(all_of(c( 159 | "row_from", "col_from" 160 | )))) 161 | } 162 | -------------------------------------------------------------------------------- /R/flexlsx-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | #' @importFrom Rcpp sourceCpp 6 | #' @importFrom tibble tibble 7 | #' @useDynLib flexlsx, .registration = TRUE 8 | ## usethis namespace: end 9 | NULL 10 | -------------------------------------------------------------------------------- /R/ft_to_style.R: -------------------------------------------------------------------------------- 1 | #' Converts a flextable-part to a tibble styles 2 | #' 3 | #' @description 4 | #' `r lifecycle::badge("experimental")` 5 | #' 6 | #' @param ft_part the part of the flextable to extract the style from 7 | #' @param part the name of the part 8 | #' 9 | #' @description 10 | #' `r lifecycle::badge("experimental")` 11 | #' 12 | #' @return a [tibble][tibble::tibble-package] 13 | #' 14 | #' @importFrom dplyr bind_cols select rename all_of arrange 15 | #' @importFrom openxlsx2 int2col 16 | #' @importFrom rlang .data 17 | #' 18 | ftpart_to_style_tibble <- function(ft_part, 19 | part = c( 20 | "header", 21 | "body", 22 | "footer" 23 | )) { 24 | ## map styles to data.frames 25 | 26 | # Cells 27 | df_styles_cells <- lapply( 28 | ft_part$styles$cells, 29 | \(x) { 30 | if ("data" %in% names(x)) { 31 | return(as.vector(x$data)) 32 | } 33 | return(NULL) 34 | } 35 | ) |> 36 | data.frame() 37 | df_styles_cells$rowheight <- round(ft_part$rowheights * 91.4400, 0) 38 | 39 | # Pars 40 | df_styles_pars <- lapply( 41 | ft_part$styles$pars, 42 | \(x) { 43 | if ("data" %in% names(x)) { 44 | return(as.vector(x$data)) 45 | } 46 | return(NULL) 47 | } 48 | ) |> 49 | data.frame() 50 | 51 | # Text 52 | df_styles_text <- lapply( 53 | ft_part$styles$text, 54 | \(x) { 55 | if ("data" %in% names(x)) { 56 | return(as.vector(x$data)) 57 | } 58 | return(NULL) 59 | } 60 | ) |> 61 | data.frame() 62 | 63 | # Merge 64 | df_styles <- dplyr::bind_cols( 65 | df_styles_cells, 66 | dplyr::rename( 67 | df_styles_text, 68 | "text.vertical.align" = 69 | dplyr::all_of("vertical.align") 70 | ), 71 | dplyr::select( 72 | df_styles_pars, 73 | dplyr::all_of("text.align") 74 | ) 75 | ) 76 | 77 | # Determine spans 78 | df_styles$span.rows <- ft_part$spans$rows |> as.vector() 79 | df_styles$span.cols <- ft_part$spans$columns |> as.vector() 80 | 81 | # Add row and col id 82 | idims <- dim(ft_part$content$data) 83 | df_styles$col_id <- sort(rep(seq_len(idims[2]), idims[1])) 84 | df_styles$row_id <- rep(seq_len(idims[1]), idims[2]) 85 | 86 | # Add content 87 | df_styles$content <- lapply(seq_len(nrow(df_styles)), function(i) { 88 | ft_part$content$data[[df_styles$row_id[i], df_styles$col_id[i]]] 89 | }) 90 | 91 | # Arrange 92 | df_styles <- dplyr::arrange(df_styles, .data$row_id, .data$col_id) 93 | 94 | return(df_styles) 95 | } 96 | 97 | #' Converts a flextable to a tibble with style information 98 | #' 99 | #' @description 100 | #' `r lifecycle::badge("experimental")` 101 | #' 102 | #' @param ft a [flextable][flextable::flextable-package] 103 | #' @param offset_rows offsets the start-row 104 | #' @param offset_cols offsets the start-columns 105 | #' @param offset_caption_rows number of rows to offset the caption by 106 | #' 107 | #' @return a [tibble][tibble::tibble-package] 108 | #' 109 | #' @importFrom dplyr bind_rows 110 | #' @importFrom openxlsx2 int2col 111 | #' 112 | ft_to_style_tibble <- function(ft, offset_rows = 0L, 113 | offset_cols = 0L, 114 | offset_caption_rows = 0L) { 115 | has_caption <- length(ft$caption$value) > 0 116 | has_footer <- length(ft$footer$content) > 0 117 | 118 | # Caption 119 | df_caption <- if (has_caption) { 120 | tibble::tibble(row_id = 1, col_id = 1) 121 | } else { 122 | tibble::tibble() 123 | } 124 | 125 | # Header 126 | df_header <- ftpart_to_style_tibble(ft$header) 127 | # Offset row-id based on caption rows 128 | if (has_caption) { 129 | df_header$row_id <- df_header$row_id + max(df_caption$row_id) 130 | } 131 | 132 | # Body 133 | df_body <- ftpart_to_style_tibble(ft$body) 134 | df_body$row_id <- df_body$row_id + max(df_header$row_id, 0L) 135 | 136 | # Footer 137 | if (has_footer) { 138 | df_footer <- ftpart_to_style_tibble(ft$footer) 139 | df_footer$row_id <- df_footer$row_id + max(df_body$row_id) 140 | } else { 141 | df_footer <- tibble::tibble() 142 | } 143 | 144 | df_style <- dplyr::bind_rows( 145 | df_caption, 146 | df_header, 147 | df_body, 148 | df_footer 149 | ) 150 | 151 | # offset the rows 152 | df_style$row_id <- df_style$row_id + offset_rows + offset_caption_rows 153 | df_style$col_id <- df_style$col_id + offset_cols 154 | 155 | df_style$col_name <- paste0( 156 | openxlsx2::int2col(df_style$col_id), 157 | df_style$row_id 158 | ) 159 | 160 | if (has_caption) { 161 | df_style <- df_style[-1, ] 162 | } 163 | 164 | return(df_style) 165 | } 166 | -------------------------------------------------------------------------------- /R/helpers.R: -------------------------------------------------------------------------------- 1 | #' Prepares the color for content style 2 | #' 3 | #' Converts a color name to the hexadecimal RGB-value 4 | #' Removes "transparent" color 5 | #' 6 | #' @param color_name The name of the color 7 | #' 8 | #' @return The hexadecimal RGB-value 9 | #' 10 | #' @importFrom grDevices col2rgb rgb 11 | #' @importFrom dplyr if_else 12 | #' 13 | prepare_color <- function(color_name) { 14 | color_name <- dplyr::if_else(color_name == "transparent", 15 | NA_character_, 16 | color_name 17 | ) 18 | 19 | colors <- grDevices::col2rgb(color_name) / 255 20 | colors <- grDevices::rgb( 21 | red = colors[1, ], 22 | green = colors[2, ], 23 | blue = colors[3, ] 24 | ) 25 | colors[is.na(color_name)] <- NA_character_ 26 | return(colors) 27 | } 28 | -------------------------------------------------------------------------------- /R/testsuite.R: -------------------------------------------------------------------------------- 1 | test_wb_ft <- function(wb, ft, filename) { 2 | test_path <- Sys.getenv("flexlsxtestdir") 3 | 4 | # For local development testing only 5 | if (test_path != "") { 6 | wb$save(paste0( 7 | test_path, 8 | filename, 9 | ".xlsx" 10 | )) 11 | flextable::save_as_html(ft, path = paste0( 12 | test_path, 13 | filename, 14 | ".html" 15 | )) 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /R/wb_add_caption.R: -------------------------------------------------------------------------------- 1 | #' Adds a caption to an excel file 2 | #' 3 | #' @description 4 | #' `r lifecycle::badge("experimental")` 5 | #' 6 | #' @inheritParams wb_add_flextable 7 | #' @param offset_rows zero-based row offset 8 | #' @param offset_cols zero-based column offset 9 | #' 10 | #' @importFrom openxlsx2 fmt_txt 11 | #' @importFrom purrr map_chr 12 | #' @importFrom stringi stri_count 13 | #' 14 | #' @return NULL 15 | #' 16 | wb_add_caption <- function(wb, sheet, 17 | ft, 18 | offset_rows = offset_rows, 19 | offset_cols = offset_cols) { 20 | idims <- dim(ft$body$content$data) 21 | 22 | # Default values from header 23 | df_styles_default <- lapply( 24 | ft$header$styles$text, 25 | \(x) { 26 | if ("default" %in% names(x)) { 27 | return(as.vector(x$data)) 28 | } 29 | return(NULL) 30 | } 31 | ) |> 32 | data.frame() 33 | df_styles_default <- df_styles_default[1, ] 34 | 35 | # create content 36 | if (ft$caption$simple_caption) { 37 | # Replace
in flextables with newlines 38 | ft$caption$value <- gsub("
", "\n", ft$caption$value) 39 | 40 | content <- openxlsx2::fmt_txt( 41 | ft$caption$value, 42 | bold = df_styles_default$bold, 43 | italic = df_styles_default$italic, 44 | underline = df_styles_default$underlined, 45 | size = df_styles_default$font.size, 46 | color = openxlsx2::wb_color(df_styles_default$color), 47 | font = df_styles_default$font.family, 48 | vert_align = df_styles_default$vertical.align 49 | ) 50 | } else { 51 | ft$caption$value$txt <- gsub("
", "\n", ft$caption$value$txt) 52 | content <- purrr::map_chr( 53 | seq_len(nrow(ft$caption$value)), 54 | \(i) { 55 | x <- ft$caption$value[i, ] 56 | openxlsx2::fmt_txt( 57 | x$txt, 58 | bold = x$bold, 59 | italic = x$italic, 60 | underline = x$underlined, 61 | size = x$font.size, 62 | color = openxlsx2::wb_color(x$color), 63 | font = x$font.family, 64 | vert_align = x$vertical.align 65 | ) |> 66 | paste0() 67 | } 68 | ) 69 | } 70 | 71 | # wrap text if necessary 72 | to_apply_text_wrap <- ifelse(ft$caption$simple_caption, 73 | stringi::stri_count(ft$caption$value, regex = "\\n"), 74 | sum(stringi::stri_count(ft$caption$value$txt, regex = "\\n")) 75 | ) + 1 76 | if (to_apply_text_wrap > 0) { 77 | wb$add_cell_style( 78 | sheet = sheet, 79 | wrap_text = TRUE, 80 | dims = paste0( 81 | int2col(offset_cols + 1), 82 | offset_rows + 1 83 | ) 84 | ) 85 | 86 | wb$set_row_heights( 87 | sheet = sheet, 88 | heights = to_apply_text_wrap * 15, 89 | rows = offset_rows + 1 90 | ) 91 | } 92 | 93 | # add to wb & merge 94 | wb$add_data( 95 | sheet = sheet, 96 | x = paste0(content, collapse = ""), 97 | dims = paste0( 98 | int2col(offset_cols + 1), 99 | offset_rows + 1 100 | ) 101 | ) 102 | wb$merge_cells(sheet = sheet, dims = paste0( 103 | int2col(offset_cols + 1), 104 | offset_rows + 1, 105 | ":", 106 | int2col(offset_cols + idims[2]), 107 | offset_rows + 1 108 | )) 109 | 110 | return(invisible(NULL)) 111 | } 112 | -------------------------------------------------------------------------------- /R/wb_add_flextable.R: -------------------------------------------------------------------------------- 1 | #' Adds a flextable to an openxlsx2 workbook sheet 2 | #' 3 | #' @description 4 | #' `r lifecycle::badge("experimental")` 5 | #' 6 | #' @param wb an openxlsx2 workbook 7 | #' @param sheet an openxlsx2 workbook sheet 8 | #' @param ft a flextable 9 | #' @param start_col a vector specifying the starting column to write to. 10 | #' @param start_row a vector specifying the starting row to write to. 11 | #' @param dims Spreadsheet dimensions that will determine start_col and 12 | #' start_row: "A1", "A1:B2", "A:B" 13 | #' @param offset_caption_rows number of rows to offset the caption by 14 | #' 15 | #' @return an openxlsx2 workbook 16 | #' @export 17 | #' 18 | #' @importFrom openxlsx2 dims_to_rowcol 19 | #' 20 | #' @examples 21 | #' 22 | #' if (requireNamespace("flextable", quietly = TRUE)) { 23 | #' # Create a flextable 24 | #' ft <- flextable::as_flextable(table(mtcars[, c("am", "cyl")])) 25 | #' 26 | #' # Create a workbook 27 | #' wb <- openxlsx2::wb_workbook()$add_worksheet("mtcars") 28 | #' 29 | #' # Add flextable to workbook 30 | #' wb <- wb_add_flextable(wb, "mtcars", ft) 31 | #' 32 | #' # Workbook can now be saved wb$save(), 33 | #' # opened wb$open() - or removed 34 | #' rm(wb) 35 | #' } 36 | #' 37 | wb_add_flextable <- function(wb, 38 | sheet = openxlsx2::current_sheet(), 39 | ft, 40 | start_col = 1, 41 | start_row = 1, 42 | offset_caption_rows = 0L, 43 | dims = NULL) { 44 | # Check input 45 | stopifnot("wbWorkbook" %in% class(wb)) 46 | 47 | sheet_validated <- wb$validate_sheet(sheet) 48 | if (is.na(sheet_validated)) { 49 | stop("Sheet '", sheet, "' does not exist!") 50 | } 51 | sheet <- sheet_validated 52 | 53 | stopifnot("flextable" %in% class(ft)) 54 | 55 | # Retrieve offsets 56 | if (!is.null(dims)) { 57 | dims <- openxlsx2::dims_to_rowcol(dims, as_integer = TRUE) 58 | offset_cols <- min(dims[[1]]) - 1 59 | offset_rows <- min(dims[[2]]) - 1 60 | } else { 61 | stopifnot( 62 | is.numeric(start_col), 63 | start_col >= 1, 64 | as.integer(start_col) == start_col, 65 | length(start_col) == 1 66 | ) 67 | stopifnot( 68 | is.numeric(start_row) && 69 | start_row >= 1 && 70 | as.integer(start_col) == start_col, 71 | length(start_col) == 1 72 | ) 73 | 74 | offset_cols <- start_col - 1 75 | offset_rows <- start_row - 1 76 | } 77 | 78 | # ignore offset if there is no caption 79 | if (length(ft$caption$value) == 0) { 80 | offset_caption_rows <- 0L 81 | } 82 | 83 | wb <- wb$clone() 84 | 85 | df_style <- ft_to_style_tibble(ft, 86 | offset_rows = offset_rows, 87 | offset_cols = offset_cols, 88 | offset_caption_rows = offset_caption_rows 89 | ) 90 | 91 | # Apply styles & add content 92 | if (length(ft$caption$value) > 0) { 93 | wb_add_caption(wb, 94 | sheet = sheet, ft = ft, 95 | offset_rows = offset_rows, 96 | offset_cols = offset_cols 97 | ) 98 | } 99 | 100 | df_style <- wb_apply_merge(wb, sheet, df_style) 101 | wb_apply_border(wb, sheet, df_style) 102 | wb_apply_text_styles(wb, sheet, df_style) 103 | wb_apply_cell_styles(wb, sheet, df_style) 104 | wb_apply_content(wb, sheet, df_style) 105 | wb_change_cell_width(wb, sheet, ft, offset_cols) 106 | wb_change_row_height(wb, sheet, df_style) 107 | 108 | return(wb) 109 | } 110 | -------------------------------------------------------------------------------- /R/wb_apply_border.R: -------------------------------------------------------------------------------- 1 | #' Determines the border style 2 | #' 3 | #' openxlsx2/Excel does handle borders differently than 4 | #' flextable. This function maps the flextable border styles 5 | #' to the Excel border styles. 6 | #' 7 | #' @description 8 | #' `r lifecycle::badge("experimental")` 9 | #' 10 | #' @param border_color the color of the border 11 | #' @param border_width a numeric vector determining the border-width 12 | #' @param border_style the flextable style name of the border 13 | #' 14 | #' @return a factor of xlsx border styles 15 | #' 16 | #' @importFrom dplyr case_when 17 | #' 18 | ft_to_xlsx_border <- function(border_color, 19 | border_width, 20 | border_style) { 21 | dplyr::case_when( 22 | border_color == "transparent" | 23 | border_style %in% c("none", "nil") | 24 | border_width <= 0 ~ "no border", 25 | border_style == "double" ~ "double", # ? 26 | border_style == "dotted" ~ "dotted", 27 | border_style == "dashed" & border_width < 1.25 ~ "dashed", 28 | border_style == "dotDash" & border_width < 1.25 ~ "dashDot", 29 | border_style == "dashed" & border_width < 1.25 ~ "mediumDashed", 30 | border_style == "dotDash" & border_width < 1.25 ~ "mediumDashDot", 31 | border_style == "dashed" ~ "dashed", 32 | border_style == "dotDash" ~ "dashDot", 33 | border_style == "dotDotDash" ~ "dashedDotDot", 34 | border_width < .5 ~ "hair", 35 | border_width < 1 ~ "thin", 36 | border_width < 1.25 ~ "medium", 37 | TRUE ~ "thick" 38 | ) 39 | } 40 | 41 | #' Where there is no border return NULL 42 | #' 43 | #' @description 44 | #' `r lifecycle::badge("experimental")` 45 | #' 46 | #' @param border_style the openxlsx2 style of the border 47 | #' 48 | #' @return border_style or NULL 49 | #' 50 | handle_null_border <- function(border_style) { 51 | if (border_style == "no border") { 52 | return(NULL) 53 | } 54 | return(border_style) 55 | } 56 | 57 | #' Applies the border styles 58 | #' 59 | #' @description 60 | #' `r lifecycle::badge("experimental")` 61 | #' 62 | #' @param wb the [workbook][openxlsx2::wbWorkbook] 63 | #' @param sheet the sheet of the workbook 64 | #' @param df_style the styling tibble from [ft_to_style_tibble] 65 | #' 66 | #' @importFrom dplyr select mutate all_of starts_with across 67 | #' @importFrom dplyr if_else 68 | #' @importFrom purrr pluck 69 | #' @importFrom openxlsx2 wb_color 70 | #' @importFrom rlang .data 71 | #' 72 | wb_apply_border <- function(wb, sheet, df_style) { 73 | wb$validate_sheet(sheet) 74 | 75 | ## Prepare borders 76 | df_borders <- df_style |> 77 | dplyr::select( 78 | dplyr::starts_with("border."), 79 | dplyr::all_of(c( 80 | "col_id", 81 | "row_id" 82 | )) 83 | ) |> 84 | # Do not apply empty borders 85 | dplyr::filter(.data$border.width.top > 0 | 86 | .data$border.width.bottom > 0 | 87 | .data$border.width.left > 0 | 88 | .data$border.width.right > 0) |> 89 | # Restyle 90 | dplyr::mutate( 91 | border.style.top = ft_to_xlsx_border( 92 | .data$border.color.top, 93 | .data$border.width.top, 94 | .data$border.style.top 95 | ), 96 | border.style.bottom = ft_to_xlsx_border( 97 | .data$border.color.bottom, 98 | .data$border.width.bottom, 99 | .data$border.style.bottom 100 | ), 101 | border.style.left = ft_to_xlsx_border( 102 | .data$border.color.left, 103 | .data$border.width.left, 104 | .data$border.style.left 105 | ), 106 | border.style.right = ft_to_xlsx_border( 107 | .data$border.color.right, 108 | .data$border.width.right, 109 | .data$border.style.right 110 | ), 111 | dplyr::across( 112 | dplyr::starts_with("border.color."), 113 | ~ dplyr::if_else(.x == "transparent", 114 | "black", .x 115 | ) 116 | ) 117 | ) 118 | 119 | 120 | df_borders_aggregated <- get_dim_ranges(df_borders) 121 | 122 | for (i in seq_len(nrow(df_borders_aggregated))) { 123 | crow <- df_borders_aggregated[i, ] 124 | 125 | crow$border.style.top <- handle_null_border(crow$border.style.top) 126 | crow$border.style.bottom <- handle_null_border(crow$border.style.bottom) 127 | crow$border.style.left <- handle_null_border(crow$border.style.left) 128 | crow$border.style.right <- handle_null_border(crow$border.style.right) 129 | 130 | 131 | # Spans across multiple rows 132 | if (crow$multi_rows) { 133 | if (is.null(purrr::pluck(crow, "border.style.bottom"))) { 134 | hgrid_border <- purrr::pluck(crow, "border.style.top") 135 | hgrid_color <- openxlsx2::wb_color(crow$border.color.top) 136 | } else { 137 | hgrid_border <- purrr::pluck(crow, "border.style.bottom") 138 | hgrid_color <- openxlsx2::wb_color(crow$border.color.bottom) 139 | } 140 | } 141 | 142 | # Spans across multiple cols 143 | if (crow$multi_cols) { 144 | if (is.null(purrr::pluck(crow, "border.style.left"))) { 145 | vgrid_border <- purrr::pluck(crow, "border.style.right") 146 | vgrid_color <- openxlsx2::wb_color(crow$border.color.right) 147 | } else { 148 | vgrid_border <- purrr::pluck(crow, "border.style.left") 149 | vgrid_color <- openxlsx2::wb_color(crow$border.color.left) 150 | } 151 | } 152 | 153 | wb$add_border( 154 | sheet = sheet, 155 | dims = crow$dims, 156 | bottom_color = openxlsx2::wb_color(crow$border.color.bottom), 157 | left_color = openxlsx2::wb_color(crow$border.color.left), 158 | right_color = openxlsx2::wb_color(crow$border.color.right), 159 | top_color = openxlsx2::wb_color(crow$border.color.top), 160 | bottom_border = purrr::pluck(crow, "border.style.bottom"), 161 | left_border = purrr::pluck(crow, "border.style.left"), 162 | right_border = purrr::pluck(crow, "border.style.right"), 163 | top_border = purrr::pluck(crow, "border.style.top"), 164 | inner_hgrid = if (crow$multi_rows) hgrid_border else NULL, 165 | inner_hcolor = if (crow$multi_rows) hgrid_color else NULL, 166 | inner_vgrid = if (crow$multi_cols) vgrid_border else NULL, 167 | inner_vcolor = if (crow$multi_cols) vgrid_color else NULL 168 | ) 169 | } 170 | return(invisible(NULL)) 171 | } 172 | -------------------------------------------------------------------------------- /R/wb_apply_cell_styles.R: -------------------------------------------------------------------------------- 1 | #' Applies the cell styles 2 | #' 3 | #' @description 4 | #' `r lifecycle::badge("experimental")` 5 | #' 6 | #' @param wb the [workbook][openxlsx2::wbWorkbook] 7 | #' @param sheet the sheet of the workbook 8 | #' @param df_style the styling tibble from [ft_to_style_tibble] 9 | #' 10 | #' @importFrom dplyr select all_of mutate 11 | #' @importFrom openxlsx2 wb_color 12 | #' @importFrom rlang .data 13 | #' 14 | wb_apply_cell_styles <- function(wb, sheet, df_style) { 15 | wb$validate_sheet(sheet) 16 | 17 | ## aggregate borders 18 | df_cell_styles <- df_style |> 19 | dplyr::mutate( 20 | background.color = ifelse(.data$shading.color != "transparent", 21 | .data$shading.color, 22 | .data$background.color 23 | ), 24 | text.direction = dplyr::case_when( 25 | .data$text.direction == "tbrl" ~ "180", 26 | .data$text.direction == "btrl" ~ "90", 27 | TRUE ~ "" 28 | ) 29 | ) |> 30 | dplyr::select(dplyr::all_of(c( 31 | "col_id", 32 | "row_id", 33 | "text.align", 34 | "vertical.align", 35 | "text.direction", 36 | "background.color" 37 | ))) 38 | 39 | df_cell_styles_aggregated <- get_dim_ranges(df_cell_styles) 40 | 41 | for (i in seq_len(nrow(df_cell_styles_aggregated))) { 42 | crow <- df_cell_styles_aggregated[i, ] 43 | 44 | wb$add_cell_style( 45 | sheet = sheet, 46 | dims = crow$dims, 47 | horizontal = crow$text.align, 48 | vertical = crow$vertical.align, 49 | text_rotation = crow$text.direction, 50 | wrap_text = "1" 51 | ) 52 | 53 | if (crow$background.color != "transparent") { 54 | wb$add_fill( 55 | sheet = sheet, 56 | dims = crow$dims, 57 | color = openxlsx2::wb_color(crow$background.color) 58 | ) 59 | } 60 | } 61 | return(invisible(NULL)) 62 | } 63 | -------------------------------------------------------------------------------- /R/wb_apply_content.R: -------------------------------------------------------------------------------- 1 | 2 | apply_if_set <- function(sub, .fn = identity) { 3 | if(is.na(sub)) 4 | return(NULL) 5 | return(.fn(sub[[1]])) 6 | } 7 | 8 | 9 | #' Applies the content 10 | #' 11 | #' @description 12 | #' `r lifecycle::badge("experimental")` 13 | #' 14 | #' @param wb the [workbook][openxlsx2::wbWorkbook] 15 | #' @param sheet the sheet of the workbook 16 | #' @param df_style the styling tibble from [ft_to_style_tibble] 17 | #' 18 | #' @importFrom dplyr select all_of mutate filter coalesce 19 | #' @importFrom dplyr group_by summarize arrange left_join 20 | #' @importFrom dplyr rowwise 21 | #' @importFrom openxlsx2 wb_color 22 | #' @importFrom rlang .data 23 | #' @importFrom tidyr unnest_legacy 24 | #' 25 | wb_apply_content <- function(wb, sheet, df_style) { 26 | wb$validate_sheet(sheet) 27 | 28 | df_content <- dplyr::select( 29 | df_style, 30 | dplyr::all_of(c( 31 | "row_id", 32 | "col_id", 33 | "span.rows", 34 | "span.cols", 35 | "font.size", 36 | "font.family", 37 | "color", 38 | "italic", 39 | "bold", 40 | "underlined", 41 | "content", 42 | "vertical.align" 43 | )) 44 | ) 45 | 46 | ## unnest the content 47 | df_content_rows <- dplyr::select( 48 | df_style, 49 | dplyr::all_of(c( 50 | "row_id", 51 | "col_id", 52 | "content" 53 | )) 54 | ) |> 55 | tidyr::unnest_legacy() 56 | 57 | ## join to the "default" options & replace nas 58 | df_content <- dplyr::select(df_content, -all_of("content")) |> 59 | dplyr::left_join(df_content_rows, 60 | by = c("row_id", "col_id"), 61 | relationship = "one-to-many" 62 | ) 63 | 64 | df_content <- dplyr::mutate(df_content, 65 | italic.y = dplyr::coalesce( 66 | .data$italic.y, 67 | .data$italic.x 68 | ), 69 | bold.y = dplyr::coalesce( 70 | .data$bold.y, 71 | .data$bold.x 72 | ), 73 | underlined.y = dplyr::coalesce( 74 | .data$underlined.y, 75 | .data$underlined.x 76 | ), 77 | 78 | # colors, font-size, font-family & vertical align will only be applied when 79 | # different from the default 80 | dplyr::across( 81 | dplyr::all_of(c("color.x", "color.y")), 82 | ~ prepare_color(.x) 83 | ), 84 | color.y = dplyr::coalesce(.data$color.y, .data$color.x), 85 | color.y = dplyr::if_else(.data$color.y == "#000000" & 86 | .data$color.x == "#000000", 87 | NA_character_, 88 | .data$color.y 89 | ) 90 | ) 91 | 92 | # Replace
in flextables with newlines 93 | df_content$txt <- gsub("
", "\n", df_content$txt) 94 | 95 | df_content <- df_content |> 96 | dplyr::rowwise() |> 97 | dplyr::mutate(txt = paste0(openxlsx2::fmt_txt( 98 | .data$txt, 99 | bold = apply_if_set(.data$bold.y), 100 | italic = apply_if_set(.data$italic.y), 101 | underline = apply_if_set(.data$underlined.y), 102 | size = apply_if_set(.data$font.size.y), 103 | color = apply_if_set(.data$color.y, .fn = openxlsx2::wb_color), 104 | font = apply_if_set(.data$font.family.y), 105 | vert_align = apply_if_set(.data$vertical.align.y), 106 | ))) |> 107 | dplyr::ungroup() |> 108 | dplyr::mutate(txt = ifelse(.data$span.rows == 0 | .data$span.cols == 0, 109 | "", .data$txt 110 | )) |> 111 | dplyr::group_by(.data$col_id, .data$row_id) |> 112 | dplyr::summarize( 113 | txt = paste0(.data$txt, collapse = ""), 114 | max_font_size = max(coalesce(.data$font.size.y, .data$font.size.x), 115 | na.rm = TRUE 116 | ), 117 | .groups = "drop" 118 | ) 119 | 120 | min_col_id <- min(df_content$col_id) 121 | max_col_id <- max(df_content$col_id) 122 | min_row_id <- min(df_content$row_id) 123 | max_row_id <- max(df_content$row_id) 124 | 125 | dims <- paste0( 126 | openxlsx2::int2col(min_col_id), 127 | min_row_id, ":", 128 | openxlsx2::int2col(max_col_id), 129 | max_row_id 130 | ) 131 | 132 | df <- matrix(df_content$txt, 133 | nrow = max_row_id - min_row_id + 1, 134 | ncol = max_col_id - min_col_id + 1 135 | ) |> 136 | as.data.frame() 137 | 138 | if (getOption("openxlsx2.string_nums", default = FALSE)) { 139 | # convert from styled character to numeric 140 | xml_to_num <- function(x) { 141 | val <- vapply(x, 142 | \(x) { 143 | ifelse(x == "", NA_character_, 144 | openxlsx2::xml_value(x, "r", "t") 145 | ) 146 | }, 147 | FUN.VALUE = character(1), 148 | USE.NAMES = FALSE 149 | ) 150 | suppressWarnings(got <- as.numeric(val)) 151 | sel <- !is.na(val) & !is.na(got) 152 | x[sel] <- got[sel] 153 | x 154 | } 155 | 156 | df[] <- lapply(df, xml_to_num) 157 | } 158 | 159 | wb$add_data( 160 | sheet = sheet, 161 | x = df, 162 | dims = dims, 163 | col_names = FALSE 164 | ) 165 | 166 | wb$add_ignore_error(dims = dims, number_stored_as_text = TRUE) 167 | 168 | return(invisible(NULL)) 169 | } 170 | -------------------------------------------------------------------------------- /R/wb_apply_merge.R: -------------------------------------------------------------------------------- 1 | #' Determine problematic merges 2 | #' 3 | #' @param df_to_merge The data.frame containing information about the cells to 4 | #' merge 5 | #' 6 | #' @return df_to_merge is extended by is_encapsulated and is_need_resolve 7 | #' 8 | #' @importFrom rlang .data 9 | #' @importFrom dplyr mutate arrange 10 | #' 11 | merge_resolve_type <- function(df_to_merge) { 12 | n_x <- nrow(df_to_merge) 13 | df_to_merge <- df_to_merge |> 14 | dplyr::mutate(merge_type = dplyr::case_when( 15 | .data$span.rows > 0 & 16 | .data$span.cols > 0 ~ 1L, 17 | .data$span.rows > 0 ~ 2L, 18 | TRUE ~ 3L 19 | )) |> 20 | dplyr::arrange( 21 | .data$merge_type, 22 | .data$row_id, 23 | .data$col_id 24 | ) 25 | 26 | df_to_merge <- cpp_merge_resolve_type(df_to_merge) 27 | 28 | return(df_to_merge) 29 | } 30 | 31 | #' Merges cells 32 | #' 33 | #' @description 34 | #' `r lifecycle::badge("experimental")` 35 | #' 36 | #' @inheritParams wb_apply_border 37 | #' 38 | #' @return df_style tibble 39 | #' 40 | #' @importFrom dplyr select all_of mutate filter 41 | #' @importFrom openxlsx2 wb_color 42 | #' @importFrom rlang .data 43 | #' 44 | wb_apply_merge <- function(wb, sheet, df_style) { 45 | df_merges <- df_style |> 46 | dplyr::mutate( 47 | span.rows = pmax(.data$span.rows - 1, 0), 48 | span.cols = pmax(.data$span.cols - 1, 0) 49 | ) |> 50 | dplyr::filter(.data$span.rows > 0 | 51 | .data$span.cols > 0) |> 52 | dplyr::mutate( 53 | row_end = .data$row_id + .data$span.cols, 54 | col_end = .data$col_id + .data$span.rows, 55 | dims = paste0( 56 | openxlsx2::int2col(.data$col_id), .data$row_id, ":", 57 | openxlsx2::int2col(.data$col_end), .data$row_end 58 | ) 59 | ) |> 60 | dplyr::select(dplyr::all_of(c( 61 | "span.rows", 62 | "span.cols", 63 | "row_id", 64 | "row_end", 65 | "col_id", 66 | "col_end", 67 | "dims" 68 | ))) |> 69 | merge_resolve_type() |> 70 | dplyr::filter(!.data$is_encapsulated) 71 | 72 | if (sum(df_merges$is_need_resolve) > 0) { 73 | warning("Found ", sum(df_merges$is_need_resolve), " overlapping merges! 74 | Conflicting merges are removed; 75 | Styling might not fully resemble the flextable!") 76 | df_merges <- df_merges |> 77 | dplyr::filter(!.data$is_need_resolve) 78 | } 79 | 80 | ## Apply merges 81 | for (i in seq_len(nrow(df_merges))) { 82 | df_style_def <- df_merges[i, ] 83 | wb$merge_cells( 84 | sheet = sheet, 85 | dims = df_style_def$dims, 86 | solve = df_style_def$is_need_resolve 87 | ) 88 | } 89 | 90 | return(df_style) 91 | } 92 | -------------------------------------------------------------------------------- /R/wb_apply_text_styles.R: -------------------------------------------------------------------------------- 1 | #' Applies the text styles 2 | #' 3 | #' @description 4 | #' `r lifecycle::badge("experimental")` 5 | #' 6 | #' @param wb the [workbook][openxlsx2::wbWorkbook] 7 | #' @param sheet the sheet of the workbook 8 | #' @param df_style the styling tibble from [ft_to_style_tibble] 9 | #' 10 | #' @importFrom dplyr select all_of 11 | #' @importFrom openxlsx2 wb_color 12 | #' 13 | wb_apply_text_styles <- function(wb, sheet, df_style) { 14 | wb$validate_sheet(sheet) 15 | 16 | ## aggregate borders 17 | df_text_styles <- df_style |> 18 | dplyr::select(dplyr::all_of(c( 19 | "col_id", 20 | "row_id", 21 | "font.family", 22 | "color", 23 | "font.size", 24 | "bold", 25 | "italic", 26 | "underlined" 27 | ))) 28 | 29 | df_text_styles_aggregated <- get_dim_ranges(df_text_styles) 30 | 31 | for (i in seq_len(nrow(df_text_styles_aggregated))) { 32 | crow <- df_text_styles_aggregated[i, ] 33 | 34 | wb$add_font( 35 | dims = crow$dims, 36 | name = crow$font.family, 37 | color = openxlsx2::wb_color(crow$color), 38 | size = crow$font.size, 39 | bold = ifelse(crow$bold, "1", ""), 40 | italic = ifelse(crow$italic, "1", ""), 41 | underline = ifelse(crow$underlined, "1", "") 42 | ) 43 | } 44 | return(invisible(NULL)) 45 | } 46 | -------------------------------------------------------------------------------- /R/wb_change_height_width.R: -------------------------------------------------------------------------------- 1 | #' Changes the cell width 2 | #' 3 | #' @inheritParams wb_add_caption 4 | #' 5 | #' @return NULL 6 | #' 7 | wb_change_cell_width <- function(wb, sheet, ft, offset_cols) { 8 | # Tell me why? 9 | cwidths <- rbind( 10 | ft$header$colwidths, 11 | ft$body$colwidths, 12 | ft$footer$colwidths 13 | ) |> 14 | apply(2, max) * 2.54 * 4 / 16 * 20 # Ain't nothing but a constant 15 | 16 | 17 | wb$set_col_widths( 18 | sheet = sheet, 19 | cols = paste0( 20 | openxlsx2::int2col(1 + offset_cols), ":", 21 | openxlsx2::int2col(length(cwidths) + offset_cols) 22 | ), 23 | widths = cwidths 24 | ) 25 | 26 | return(invisible(NULL)) 27 | } 28 | 29 | #' Changes the row height 30 | #' 31 | #' @inheritParams wb_add_caption 32 | #' @param df_style the styling tibble from [ft_to_style_tibble] 33 | #' 34 | #' @return NULL 35 | #' 36 | #' @importFrom dplyr select mutate group_by all_of summarize 37 | #' @importFrom rlang .data 38 | #' @importFrom stringi stri_count 39 | #' 40 | wb_change_row_height <- function(wb, sheet, df_style) { 41 | font_sizes <- vapply(df_style$content, 42 | \(x) { 43 | ifelse(all(is.na(x$font.size)), 44 | NA_real_, 45 | max(x$font.size, na.rm = TRUE) 46 | ) 47 | }, 48 | FUN.VALUE = numeric(1) 49 | ) 50 | 51 | newline_counts <- vapply(df_style$content, 52 | \(x) { 53 | sum(stringi::stri_count(x$txt, regex = "
") + 54 | stringi::stri_count(x$txt, regex = "\n")) 55 | }, 56 | FUN.VALUE = numeric(1) 57 | ) + 1 58 | 59 | row_heights <- newline_counts * 60 | coalesce(font_sizes, df_style$font.size) / 11 * 15 61 | 62 | df_row_heights <- df_style |> 63 | dplyr::select(dplyr::all_of("row_id")) |> 64 | dplyr::mutate(rh = row_heights) |> 65 | dplyr::group_by(.data$row_id) |> 66 | dplyr::summarize( 67 | row_heights = max(.data$rh), 68 | .groups = "drop" 69 | ) 70 | 71 | wb$set_row_heights( 72 | sheet = sheet, 73 | rows = df_row_heights$row_id, 74 | heights = df_row_heights$row_heights 75 | ) 76 | } 77 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # flexlsx 17 | 18 | 19 | 20 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) [![Codecov test coverage](https://codecov.io/gh/pteridin/flexlsx/branch/main/graph/badge.svg)](https://app.codecov.io/gh/pteridin/flexlsx?branch=main) 21 | [![R-CMD-check](https://github.com/pteridin/flexlsx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/pteridin/flexlsx/actions/workflows/R-CMD-check.yaml) 22 | 23 | 24 | The primary objective of `flexlsx` is to offer an effortless interface for exporting `flextable` objects directly to Microsoft Excel. Building upon the robust foundation provided by `openxlsx2` and `flextable`, `flexlsx` ensures compatibility, precision, and efficiency when working with both trivial and complex tables. 25 | 26 | ## Installation 27 | 28 | You can install the development version of `flexlsx` like so: 29 | 30 | ``` r 31 | # install.packages("remotes") 32 | remotes::install_github("pteridin/flexlsx") 33 | ``` 34 | 35 | Or install the CRAN release like so: 36 | 37 | ``` r 38 | install.packages("flexlsx") 39 | ``` 40 | 41 | ## Example 42 | 43 | This is a basic example which shows you how to solve a common problem: 44 | 45 | ``` r 46 | library(flexlsx) 47 | 48 | # Create a flextable and an openxlsx2 workbook 49 | ft <- flextable::as_flextable(table(mtcars[,1:2])) 50 | wb <- openxlsx2::wb_workbook()$add_worksheet("mtcars") 51 | 52 | # add the flextable ft to the workbook, sheet "mtcars" 53 | # offset the table to cell 'C2' 54 | wb <- wb_add_flextable(wb, "mtcars", ft, dims = "C2") 55 | 56 | # save the workbook to a temporary xlsx file 57 | tmpfile <- tempfile(fileext = ".xlsx") 58 | wb$save(tmpfile) 59 | 60 | ``` 61 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # flexlsx 5 | 6 | 7 | 8 | [![Lifecycle: 9 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 10 | [![Codecov test 11 | coverage](https://codecov.io/gh/pteridin/flexlsx/branch/main/graph/badge.svg)](https://app.codecov.io/gh/pteridin/flexlsx?branch=main) 12 | [![R-CMD-check](https://github.com/pteridin/flexlsx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/pteridin/flexlsx/actions/workflows/R-CMD-check.yaml) 13 | 14 | 15 | The primary objective of `flexlsx` is to offer an effortless interface 16 | for exporting `flextable` objects directly to Microsoft Excel. Building 17 | upon the robust foundation provided by `openxlsx2` and `flextable`, 18 | `flexlsx` ensures compatibility, precision, and efficiency when working 19 | with both trivial and complex tables. 20 | 21 | ## Installation 22 | 23 | You can install the development version of `flexlsx` like so: 24 | 25 | ``` r 26 | # install.packages("remotes") 27 | remotes::install_github("pteridin/flexlsx") 28 | ``` 29 | 30 | Or install the CRAN release like so: 31 | 32 | ``` r 33 | install.packages("flexlsx") 34 | ``` 35 | 36 | ## Example 37 | 38 | This is a basic example which shows you how to solve a common problem: 39 | 40 | ``` r 41 | library(flexlsx) 42 | 43 | # Create a flextable and an openxlsx2 workbook 44 | ft <- flextable::as_flextable(table(mtcars[,1:2])) 45 | wb <- openxlsx2::wb_workbook()$add_worksheet("mtcars") 46 | 47 | # add the flextable ft to the workbook, sheet "mtcars" 48 | # offset the table to cell 'C2' 49 | wb <- wb_add_flextable(wb, "mtcars", ft, dims = "C2") 50 | 51 | # save the workbook to a temporary xlsx file 52 | tmpfile <- tempfile(fileext = ".xlsx") 53 | wb$save(tmpfile) 54 | ``` 55 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 1 note 4 | 5 | * unable to verify current time 6 | -------------------------------------------------------------------------------- /flexlsx.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite flexlsx in publications use:") 2 | 3 | bibentry( 4 | "Misc", 5 | title = "flexlsx: Adding flextables to Excel", 6 | author = person("Tobias", "Heidler"), 7 | year = "2023", 8 | url = "https://github.com/pteridin/flexlsx", 9 | note = "Heidler, Tobias (2023). flexlsx: Adding flextables to Excel, https://github.com/pteridin/flexlsx" 10 | ) 11 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pteridin/flexlsx/0b0aa7dffc9fcb45e894f4dd3c96070d79e87c84/man/figures/logo.png -------------------------------------------------------------------------------- /man/flexlsx-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/flexlsx-package.R 3 | \docType{package} 4 | \name{flexlsx-package} 5 | \alias{flexlsx} 6 | \alias{flexlsx-package} 7 | \title{flexlsx: Exporting 'flextable' to 'xlsx' Files} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | Exports 'flextable' objects to 'xlsx' files, utilizing functionalities provided by 'flextable' and 'openxlsx2'. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://github.com/pteridin/flexlsx} 17 | \item Report bugs at \url{https://github.com/pteridin/flexlsx/issues} 18 | } 19 | 20 | } 21 | \author{ 22 | \strong{Maintainer}: Tobias Heidler \email{tobias.heidler@googlemail.com} (\href{https://orcid.org/0000-0001-9193-0980}{ORCID}) [copyright holder] 23 | 24 | } 25 | \keyword{internal} 26 | -------------------------------------------------------------------------------- /man/ft_to_style_tibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ft_to_style.R 3 | \name{ft_to_style_tibble} 4 | \alias{ft_to_style_tibble} 5 | \title{Converts a flextable to a tibble with style information} 6 | \usage{ 7 | ft_to_style_tibble( 8 | ft, 9 | offset_rows = 0L, 10 | offset_cols = 0L, 11 | offset_caption_rows = 0L 12 | ) 13 | } 14 | \arguments{ 15 | \item{ft}{a \link[flextable:flextable-package]{flextable}} 16 | 17 | \item{offset_rows}{offsets the start-row} 18 | 19 | \item{offset_cols}{offsets the start-columns} 20 | 21 | \item{offset_caption_rows}{number of rows to offset the caption by} 22 | } 23 | \value{ 24 | a \link[tibble:tibble-package]{tibble} 25 | } 26 | \description{ 27 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 28 | } 29 | -------------------------------------------------------------------------------- /man/ft_to_xlsx_border.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_border.R 3 | \name{ft_to_xlsx_border} 4 | \alias{ft_to_xlsx_border} 5 | \title{Determines the border style} 6 | \usage{ 7 | ft_to_xlsx_border(border_color, border_width, border_style) 8 | } 9 | \arguments{ 10 | \item{border_color}{the color of the border} 11 | 12 | \item{border_width}{a numeric vector determining the border-width} 13 | 14 | \item{border_style}{the flextable style name of the border} 15 | } 16 | \value{ 17 | a factor of xlsx border styles 18 | } 19 | \description{ 20 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 21 | } 22 | \details{ 23 | openxlsx2/Excel does handle borders differently than 24 | flextable. This function maps the flextable border styles 25 | to the Excel border styles. 26 | } 27 | -------------------------------------------------------------------------------- /man/ftpart_to_style_tibble.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ft_to_style.R 3 | \name{ftpart_to_style_tibble} 4 | \alias{ftpart_to_style_tibble} 5 | \title{Converts a flextable-part to a tibble styles} 6 | \usage{ 7 | ftpart_to_style_tibble(ft_part, part = c("header", "body", "footer")) 8 | } 9 | \arguments{ 10 | \item{ft_part}{the part of the flextable to extract the style from} 11 | 12 | \item{part}{the name of the part} 13 | } 14 | \value{ 15 | a \link[tibble:tibble-package]{tibble} 16 | } 17 | \description{ 18 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 19 | 20 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 21 | } 22 | -------------------------------------------------------------------------------- /man/get_dim_colwise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dim_ranges.R 3 | \name{get_dim_colwise} 4 | \alias{get_dim_colwise} 5 | \title{Groups each row with same style each column} 6 | \usage{ 7 | get_dim_colwise(df_rows) 8 | } 9 | \arguments{ 10 | \item{df_rows}{\link[tibble:tibble-package]{tibble} of row-wise aggregates style} 11 | } 12 | \value{ 13 | \link[tibble:tibble-package]{tibble} of column-wise aggregates style 14 | } 15 | \description{ 16 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 17 | } 18 | -------------------------------------------------------------------------------- /man/get_dim_ranges.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dim_ranges.R 3 | \name{get_dim_ranges} 4 | \alias{get_dim_ranges} 5 | \title{Retrieves dims of same style rows within same column} 6 | \usage{ 7 | get_dim_ranges(df_x) 8 | } 9 | \arguments{ 10 | \item{df_x}{styling information incl. col_id & row_id} 11 | } 12 | \value{ 13 | merged styles as a \link[tibble:tibble-package]{tibble} 14 | } 15 | \description{ 16 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 17 | } 18 | -------------------------------------------------------------------------------- /man/get_dim_rowwise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dim_ranges.R 3 | \name{get_dim_rowwise} 4 | \alias{get_dim_rowwise} 5 | \title{Groups each column with same style each row} 6 | \usage{ 7 | get_dim_rowwise(df_x, df_style_hashed) 8 | } 9 | \arguments{ 10 | \item{df_x}{styling information incl. col_id & row_id} 11 | 12 | \item{df_style_hashed}{\link[tibble:tibble-package]{tibble} of hashed style 13 | information} 14 | } 15 | \value{ 16 | \link[tibble:tibble-package]{tibble} of row-wise aggregates style 17 | information 18 | } 19 | \description{ 20 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 21 | } 22 | -------------------------------------------------------------------------------- /man/handle_null_border.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_border.R 3 | \name{handle_null_border} 4 | \alias{handle_null_border} 5 | \title{Where there is no border return NULL} 6 | \usage{ 7 | handle_null_border(border_style) 8 | } 9 | \arguments{ 10 | \item{border_style}{the openxlsx2 style of the border} 11 | } 12 | \value{ 13 | border_style or NULL 14 | } 15 | \description{ 16 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 17 | } 18 | -------------------------------------------------------------------------------- /man/merge_resolve_type.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_merge.R 3 | \name{merge_resolve_type} 4 | \alias{merge_resolve_type} 5 | \title{Determine problematic merges} 6 | \usage{ 7 | merge_resolve_type(df_to_merge) 8 | } 9 | \arguments{ 10 | \item{df_to_merge}{The data.frame containing information about the cells to 11 | merge} 12 | } 13 | \value{ 14 | df_to_merge is extended by is_encapsulated and is_need_resolve 15 | } 16 | \description{ 17 | Determine problematic merges 18 | } 19 | -------------------------------------------------------------------------------- /man/prepare_color.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helpers.R 3 | \name{prepare_color} 4 | \alias{prepare_color} 5 | \title{Prepares the color for content style} 6 | \usage{ 7 | prepare_color(color_name) 8 | } 9 | \arguments{ 10 | \item{color_name}{The name of the color} 11 | } 12 | \value{ 13 | The hexadecimal RGB-value 14 | } 15 | \description{ 16 | Converts a color name to the hexadecimal RGB-value 17 | Removes "transparent" color 18 | } 19 | -------------------------------------------------------------------------------- /man/style_to_hash.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dim_ranges.R 3 | \name{style_to_hash} 4 | \alias{style_to_hash} 5 | \title{Retrieves hashed style information} 6 | \usage{ 7 | style_to_hash(df_x) 8 | } 9 | \arguments{ 10 | \item{df_x}{styling information incl. col_id & row_id} 11 | } 12 | \value{ 13 | hashed style information as a \link[tibble:tibble-package]{tibble} 14 | } 15 | \description{ 16 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 17 | 18 | Converts each style to an individual integer hash 19 | for easy comparison and aggregation. 20 | } 21 | -------------------------------------------------------------------------------- /man/wb_add_caption.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_add_caption.R 3 | \name{wb_add_caption} 4 | \alias{wb_add_caption} 5 | \title{Adds a caption to an excel file} 6 | \usage{ 7 | wb_add_caption( 8 | wb, 9 | sheet, 10 | ft, 11 | offset_rows = offset_rows, 12 | offset_cols = offset_cols 13 | ) 14 | } 15 | \arguments{ 16 | \item{wb}{an openxlsx2 workbook} 17 | 18 | \item{sheet}{an openxlsx2 workbook sheet} 19 | 20 | \item{ft}{a flextable} 21 | 22 | \item{offset_rows}{zero-based row offset} 23 | 24 | \item{offset_cols}{zero-based column offset} 25 | } 26 | \description{ 27 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 28 | } 29 | -------------------------------------------------------------------------------- /man/wb_add_flextable.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_add_flextable.R 3 | \name{wb_add_flextable} 4 | \alias{wb_add_flextable} 5 | \title{Adds a flextable to an openxlsx2 workbook sheet} 6 | \usage{ 7 | wb_add_flextable( 8 | wb, 9 | sheet = openxlsx2::current_sheet(), 10 | ft, 11 | start_col = 1, 12 | start_row = 1, 13 | offset_caption_rows = 0L, 14 | dims = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{wb}{an openxlsx2 workbook} 19 | 20 | \item{sheet}{an openxlsx2 workbook sheet} 21 | 22 | \item{ft}{a flextable} 23 | 24 | \item{start_col}{a vector specifying the starting column to write to.} 25 | 26 | \item{start_row}{a vector specifying the starting row to write to.} 27 | 28 | \item{offset_caption_rows}{number of rows to offset the caption by} 29 | 30 | \item{dims}{Spreadsheet dimensions that will determine start_col and 31 | start_row: "A1", "A1:B2", "A:B"} 32 | } 33 | \value{ 34 | an openxlsx2 workbook 35 | } 36 | \description{ 37 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 38 | } 39 | \examples{ 40 | 41 | if (requireNamespace("flextable", quietly = TRUE)) { 42 | # Create a flextable 43 | ft <- flextable::as_flextable(table(mtcars[, c("am", "cyl")])) 44 | 45 | # Create a workbook 46 | wb <- openxlsx2::wb_workbook()$add_worksheet("mtcars") 47 | 48 | # Add flextable to workbook 49 | wb <- wb_add_flextable(wb, "mtcars", ft) 50 | 51 | # Workbook can now be saved wb$save(), 52 | # opened wb$open() - or removed 53 | rm(wb) 54 | } 55 | 56 | } 57 | -------------------------------------------------------------------------------- /man/wb_apply_border.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_border.R 3 | \name{wb_apply_border} 4 | \alias{wb_apply_border} 5 | \title{Applies the border styles} 6 | \usage{ 7 | wb_apply_border(wb, sheet, df_style) 8 | } 9 | \arguments{ 10 | \item{wb}{the \link[openxlsx2:wbWorkbook]{workbook}} 11 | 12 | \item{sheet}{the sheet of the workbook} 13 | 14 | \item{df_style}{the styling tibble from \link{ft_to_style_tibble}} 15 | } 16 | \description{ 17 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 18 | } 19 | -------------------------------------------------------------------------------- /man/wb_apply_cell_styles.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_cell_styles.R 3 | \name{wb_apply_cell_styles} 4 | \alias{wb_apply_cell_styles} 5 | \title{Applies the cell styles} 6 | \usage{ 7 | wb_apply_cell_styles(wb, sheet, df_style) 8 | } 9 | \arguments{ 10 | \item{wb}{the \link[openxlsx2:wbWorkbook]{workbook}} 11 | 12 | \item{sheet}{the sheet of the workbook} 13 | 14 | \item{df_style}{the styling tibble from \link{ft_to_style_tibble}} 15 | } 16 | \description{ 17 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 18 | } 19 | -------------------------------------------------------------------------------- /man/wb_apply_content.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_content.R 3 | \name{wb_apply_content} 4 | \alias{wb_apply_content} 5 | \title{Applies the content} 6 | \usage{ 7 | wb_apply_content(wb, sheet, df_style) 8 | } 9 | \arguments{ 10 | \item{wb}{the \link[openxlsx2:wbWorkbook]{workbook}} 11 | 12 | \item{sheet}{the sheet of the workbook} 13 | 14 | \item{df_style}{the styling tibble from \link{ft_to_style_tibble}} 15 | } 16 | \description{ 17 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 18 | } 19 | -------------------------------------------------------------------------------- /man/wb_apply_merge.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_merge.R 3 | \name{wb_apply_merge} 4 | \alias{wb_apply_merge} 5 | \title{Merges cells} 6 | \usage{ 7 | wb_apply_merge(wb, sheet, df_style) 8 | } 9 | \arguments{ 10 | \item{wb}{the \link[openxlsx2:wbWorkbook]{workbook}} 11 | 12 | \item{sheet}{the sheet of the workbook} 13 | 14 | \item{df_style}{the styling tibble from \link{ft_to_style_tibble}} 15 | } 16 | \value{ 17 | df_style tibble 18 | } 19 | \description{ 20 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 21 | } 22 | -------------------------------------------------------------------------------- /man/wb_apply_text_styles.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_apply_text_styles.R 3 | \name{wb_apply_text_styles} 4 | \alias{wb_apply_text_styles} 5 | \title{Applies the text styles} 6 | \usage{ 7 | wb_apply_text_styles(wb, sheet, df_style) 8 | } 9 | \arguments{ 10 | \item{wb}{the \link[openxlsx2:wbWorkbook]{workbook}} 11 | 12 | \item{sheet}{the sheet of the workbook} 13 | 14 | \item{df_style}{the styling tibble from \link{ft_to_style_tibble}} 15 | } 16 | \description{ 17 | \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} 18 | } 19 | -------------------------------------------------------------------------------- /man/wb_change_cell_width.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_change_height_width.R 3 | \name{wb_change_cell_width} 4 | \alias{wb_change_cell_width} 5 | \title{Changes the cell width} 6 | \usage{ 7 | wb_change_cell_width(wb, sheet, ft, offset_cols) 8 | } 9 | \arguments{ 10 | \item{wb}{an openxlsx2 workbook} 11 | 12 | \item{sheet}{an openxlsx2 workbook sheet} 13 | 14 | \item{ft}{a flextable} 15 | 16 | \item{offset_cols}{zero-based column offset} 17 | } 18 | \description{ 19 | Changes the cell width 20 | } 21 | -------------------------------------------------------------------------------- /man/wb_change_row_height.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wb_change_height_width.R 3 | \name{wb_change_row_height} 4 | \alias{wb_change_row_height} 5 | \title{Changes the row height} 6 | \usage{ 7 | wb_change_row_height(wb, sheet, df_style) 8 | } 9 | \arguments{ 10 | \item{wb}{an openxlsx2 workbook} 11 | 12 | \item{sheet}{an openxlsx2 workbook sheet} 13 | 14 | \item{df_style}{the styling tibble from \link{ft_to_style_tibble}} 15 | } 16 | \description{ 17 | Changes the row height 18 | } 19 | -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.so 3 | *.dll 4 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | 6 | using namespace Rcpp; 7 | 8 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 9 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 10 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 11 | #endif 12 | 13 | // cpp_merge_resolve_type 14 | DataFrame cpp_merge_resolve_type(DataFrame df_to_merge); 15 | RcppExport SEXP _flexlsx_cpp_merge_resolve_type(SEXP df_to_mergeSEXP) { 16 | BEGIN_RCPP 17 | Rcpp::RObject rcpp_result_gen; 18 | Rcpp::RNGScope rcpp_rngScope_gen; 19 | Rcpp::traits::input_parameter< DataFrame >::type df_to_merge(df_to_mergeSEXP); 20 | rcpp_result_gen = Rcpp::wrap(cpp_merge_resolve_type(df_to_merge)); 21 | return rcpp_result_gen; 22 | END_RCPP 23 | } 24 | 25 | static const R_CallMethodDef CallEntries[] = { 26 | {"_flexlsx_cpp_merge_resolve_type", (DL_FUNC) &_flexlsx_cpp_merge_resolve_type, 1}, 27 | {NULL, NULL, 0} 28 | }; 29 | 30 | RcppExport void R_init_flexlsx(DllInfo *dll) { 31 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 32 | R_useDynamicSymbols(dll, FALSE); 33 | } 34 | -------------------------------------------------------------------------------- /src/utils.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | // [[Rcpp::export]] 5 | DataFrame cpp_merge_resolve_type(DataFrame df_to_merge) { 6 | NumericVector span_rows = df_to_merge["span.rows"]; 7 | NumericVector span_cols = df_to_merge["span.cols"]; 8 | NumericVector row_id = df_to_merge["row_id"]; 9 | NumericVector row_end = df_to_merge["row_end"]; 10 | NumericVector col_id = df_to_merge["col_id"]; 11 | NumericVector col_end = df_to_merge["col_end"]; 12 | CharacterVector dims = df_to_merge["dims"]; 13 | IntegerVector merge_type = df_to_merge["merge_type"]; 14 | 15 | LogicalVector is_encapsulated(row_id.length(), false); 16 | LogicalVector is_need_resolve(row_id.length(), false); 17 | 18 | for (int i = 0; i < row_id.length(); i++) { 19 | if(span_rows[i] > 1 && span_cols[i] > 1) { 20 | merge_type[i] = 1; 21 | } else if(span_rows[i] > 1 && span_cols[i] == 0) { 22 | merge_type[i] = 2; 23 | } 24 | 25 | if (i == 0) { 26 | continue; 27 | } 28 | 29 | bool current_is_encapsulated = false; 30 | bool current_is_need_resolve = false; 31 | 32 | for (int j = 0; j < i; j++) { 33 | // Is encapsulated? 34 | if (row_id[i] >= row_id[j] && 35 | row_end[i] <= row_end[j] && 36 | col_id[i] >= col_id[j] && 37 | col_end[i] <= col_end[j]) { 38 | current_is_encapsulated = true; 39 | break; 40 | } 41 | 42 | // Is overlap? 43 | int overlap_row_start = std::max(row_id[i], row_id[j]); 44 | int overlap_row_end = std::min(row_end[i], row_end[j]); 45 | int overlap_col_start = std::max(col_id[i], col_id[j]); 46 | int overlap_col_end = std::min(col_end[i], col_end[j]); 47 | 48 | if (overlap_row_start <= overlap_row_end && 49 | overlap_col_start <= overlap_col_end) { 50 | current_is_need_resolve = true; 51 | break; 52 | } 53 | } 54 | 55 | is_encapsulated[i] = current_is_encapsulated; 56 | is_need_resolve[i] = current_is_need_resolve; 57 | } 58 | 59 | 60 | return DataFrame::create( 61 | Named("span.rows") = span_rows, 62 | Named("span.cols") = span_cols, 63 | Named("row_id") = row_id, 64 | Named("row_end") = row_end, 65 | Named("col_id") = col_id, 66 | Named("col_end") = col_end, 67 | Named("dims") = dims, 68 | Named("merge_type") = merge_type, 69 | Named("is_encapsulated") = is_encapsulated, 70 | Named("is_need_resolve") = is_need_resolve 71 | ); 72 | } 73 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/tests.html 7 | # * https://testthat.r-lib.org/reference/test_package.html#special-files 8 | 9 | library(testthat) 10 | library(flexlsx) 11 | 12 | test_check("flexlsx") 13 | -------------------------------------------------------------------------------- /tests/testthat/test-dim_ranges.R: -------------------------------------------------------------------------------- 1 | ## Create a test dataset 2 | create_df <- function(m) { 3 | m |> 4 | as.data.frame() |> 5 | mutate(row_id = seq_len(dplyr::n())) |> 6 | tidyr::pivot_longer( 7 | cols = -all_of("row_id"), 8 | names_to = "name", 9 | values_to = "style" 10 | ) |> 11 | mutate(col_id = rep(seq_len(ncol(m)), nrow(m)), style_other = TRUE) |> 12 | select(-all_of("name")) 13 | } 14 | 15 | m <- matrix( 16 | c( 17 | ".", ".", ".", ".", ".", ".", 18 | "-", "-", "-", "-", "-", "-", 19 | "-", ".", ".", ".", ".", "-", 20 | "-", ".", ".", ".", ".", "-", 21 | "-", ".", ".", ".", ".", "-", 22 | "-", "-", "-", "-", "-", "-", 23 | "-", ".", "-", "-", ".", "-", 24 | "-", ".", "-", "-", ".", "-", 25 | ".", "-", ".", ".", ".", "." 26 | ), 27 | ncol = 6, 28 | byrow = TRUE 29 | ) 30 | 31 | df <- create_df(m) 32 | 33 | 34 | 35 | ## recreate matrix 36 | recreate_matrix <- function(df, df_hashes) { 37 | if ("row_id" %in% names(df)) { 38 | df$row_from <- df$row_id 39 | df$row_to <- df$row_id 40 | } 41 | 42 | df$hash <- factor(df$hash, df_hashes$hash, df_hashes$style) |> 43 | as.character() 44 | 45 | 46 | m2 <- matrix(NA_character_, 47 | nrow = max(df$row_to), 48 | ncol = max(df$col_to) 49 | ) 50 | for (i in seq_len(nrow(df))) { 51 | m2[df$row_from[i]:df$row_to[i], df$col_from[i]:df$col_to[i]] <- df$hash[i] 52 | } 53 | 54 | return(m2) 55 | } 56 | 57 | 58 | test_that("style_to_hash works", { 59 | df_hashes <- df |> 60 | style_to_hash() 61 | 62 | df_reference <- tibble::tribble( 63 | ~style, ~style_other, ~hash, 64 | "-", TRUE, 1L, ".", TRUE, 2L 65 | ) 66 | 67 | attr(df_reference, "cols_to_join") <- c("style", "style_other") 68 | 69 | testthat::expect_equal(df_hashes, df_reference) 70 | }) 71 | 72 | 73 | test_that("get_dim_rowwise works", { 74 | df_hashes <- df |> 75 | style_to_hash() 76 | 77 | df_rowwise <- df |> 78 | get_dim_rowwise(df_hashes) 79 | 80 | expect_equal(recreate_matrix(df_rowwise, df_hashes), m) 81 | 82 | set.seed(123) 83 | for (i in 1:10) { 84 | m2 <- matrix(sample( 85 | c("-", ".", "+"), 86 | 100, 87 | replace = TRUE, 88 | prob = c(0.1, 0.8, 0.1) 89 | ), nrow = 10) 90 | df2 <- create_df(m2) 91 | df_hashes <- df2 |> 92 | style_to_hash() 93 | 94 | df_rowwise <- df2 |> 95 | get_dim_rowwise(df_hashes) 96 | 97 | expect_equal(recreate_matrix(df_rowwise, df_hashes), m2) 98 | } 99 | }) 100 | 101 | test_that("get_dim_colwise works", { 102 | df_hashes <- df |> 103 | style_to_hash() 104 | 105 | df_rowwise <- df |> 106 | get_dim_rowwise(df_hashes) 107 | 108 | df_colwise <- df_rowwise |> 109 | get_dim_colwise() 110 | 111 | 112 | expect_equal(recreate_matrix(df_colwise, df_hashes), m) 113 | 114 | set.seed(123) 115 | for (i in 1:10) { 116 | m2 <- matrix(sample( 117 | c("-", ".", "+"), 118 | 100, 119 | replace = TRUE, 120 | prob = c(0.1, 0.8, 0.1) 121 | ), nrow = 10) 122 | df2 <- create_df(m2) 123 | df_hashes <- df2 |> 124 | style_to_hash() 125 | 126 | df_rowwise <- df2 |> 127 | get_dim_rowwise(df_hashes) 128 | 129 | df_colwise <- df_rowwise |> 130 | get_dim_colwise() 131 | 132 | expect_equal(recreate_matrix(df_colwise, df_hashes), m2) 133 | } 134 | }) 135 | 136 | test_that("get_dim_ranges works", { 137 | df_ranges <- df |> 138 | get_dim_ranges() 139 | 140 | expect_equal(sum(!(df_ranges$multi_cols | df_ranges$multi_rows)), 2L) 141 | expect_true(all(df_ranges$style_other)) 142 | expect_true("style" %in% names(df_ranges)) 143 | }) 144 | -------------------------------------------------------------------------------- /tests/testthat/test-ft_to_style.R: -------------------------------------------------------------------------------- 1 | test_that("ft_to_style_tibble does not break", { 2 | skip_if_not_installed("flextable") 3 | require("flextable", quietly = TRUE) 4 | 5 | ft <- as_flextable(table(mtcars[, 1:2])) 6 | 7 | x <- flexlsx:::ft_to_style_tibble(ft, 8 | offset_rows = 0L, offset_cols = 0L, offset_caption_rows = 0L 9 | ) 10 | 11 | # Fix some platforms that use other default fonts & row-heights 12 | x <- x |> select( 13 | -ends_with("family"), 14 | -all_of("rowheight") 15 | ) 16 | 17 | expect_snapshot_value(as.list(x), style = "json2") 18 | }) 19 | 20 | test_that("ft_to_style_tibble does not break with offsets", { 21 | skip_if_not_installed("flextable") 22 | require("flextable", quietly = TRUE) 23 | 24 | ft <- as_flextable(table(mtcars[, 1:2])) 25 | y <- flexlsx:::ft_to_style_tibble(ft, 26 | offset_rows = 5L, offset_cols = 2L, offset_caption_rows = 8L 27 | ) 28 | 29 | # Fix some platforms that use other default fonts & row-heights 30 | y <- y |> select( 31 | -ends_with("family"), 32 | -all_of("rowheight") 33 | ) 34 | 35 | expect_snapshot_value(as.list(y), style = "json2") 36 | }) 37 | -------------------------------------------------------------------------------- /tests/testthat/test-string_num.R: -------------------------------------------------------------------------------- 1 | test_that("option string_num is supported", { 2 | skip_if_not_installed("flextable") 3 | library(flextable) 4 | 5 | ft <- flextable(airquality[seq_len(10), ]) 6 | ft <- add_header_row(ft, 7 | colwidths = c(4, 2), 8 | values = c("Air quality", "Time") 9 | ) 10 | ft <- theme_vanilla(ft) 11 | ft <- add_footer_lines( 12 | ft, 13 | "Daily air quality measurements in New York, May to September 1973." 14 | ) 15 | ft <- color(ft, part = "footer", color = "#666666") 16 | ft <- set_caption(ft, caption = "New York Air Quality Measurements") 17 | ft 18 | 19 | options("openxlsx2.string_nums" = NULL) 20 | wb <- openxlsx2::wb_workbook()$add_worksheet("mtcars") 21 | wb <- flexlsx::wb_add_flextable(wb, "mtcars", ft, dims = "C2") 22 | 23 | options("openxlsx2.string_nums" = TRUE) 24 | wb <- wb$add_worksheet("mtcars numeric") 25 | wb <- flexlsx::wb_add_flextable(wb, "mtcars numeric", ft, dims = "C2") 26 | 27 | cc <- wb$worksheets[[1]]$sheet_data$cc 28 | expect_equal(cc[cc$r == "C5", "v"], "") 29 | 30 | cc <- wb$worksheets[[2]]$sheet_data$cc 31 | expect_equal(cc[cc$r == "C5", "v"], "41") 32 | 33 | test_wb_ft(wb, ft, "string_num") 34 | 35 | options("openxlsx2.string_nums" = NULL) 36 | }) 37 | -------------------------------------------------------------------------------- /tests/testthat/test-wb_add_caption.R: -------------------------------------------------------------------------------- 1 | test_that("flextable with caption works", { 2 | skip_if_not_installed("flextable") 3 | data("mtcars") 4 | 5 | ft <- flextable::flextable(mtcars) 6 | wb <- openxlsx2::wb_workbook()$add_worksheet("wo caption") 7 | 8 | ## Without caption 9 | wb <- wb_add_flextable( 10 | wb = wb, 11 | ft = ft, 12 | sheet = "wo caption", 13 | dims = "B4" 14 | ) 15 | 16 | expect_equal( 17 | names(wb$to_df("wo caption")), 18 | c( 19 | NA, 20 | names(mtcars) 21 | ) 22 | ) 23 | ## With caption 24 | wb$add_worksheet("with caption") 25 | ft <- flextable::set_caption(ft, "This is a caption") 26 | wb <- wb_add_flextable( 27 | wb = wb, 28 | ft = ft, 29 | sheet = "with caption", 30 | dims = "B4" 31 | ) 32 | 33 | test_wb_ft(wb, ft, "caption") 34 | 35 | df <- wb$to_df("with caption") 36 | expect_equal( 37 | names(df)[2], 38 | "This is a caption" 39 | ) 40 | 41 | expect_equal( 42 | unlist(df[1, ]) |> 43 | as.vector(), 44 | c( 45 | NA, 46 | names(mtcars) 47 | ) 48 | ) 49 | }) 50 | 51 | test_that("flextable with complex caption works", { 52 | skip_if_not_installed("flextable") 53 | data("mtcars") 54 | 55 | ft <- flextable::flextable(mtcars) 56 | wb <- openxlsx2::wb_workbook()$add_worksheet("with caption") 57 | 58 | ## With caption 59 | caption <- flextable::as_paragraph( 60 | flextable::as_chunk("This is a complex caption", 61 | props = flextable::fp_text_default( 62 | font.family = "Cambria", 63 | font.size = 14, 64 | bold = TRUE, 65 | italic = TRUE, 66 | underlined = TRUE 67 | ) 68 | ) 69 | ) 70 | 71 | ft <- flextable::set_caption(ft, caption) 72 | 73 | wb <- wb_add_flextable( 74 | wb = wb, 75 | ft = ft, 76 | sheet = "with caption", 77 | dims = "B4" 78 | ) 79 | test_wb_ft(wb, ft, "complex caption") 80 | 81 | df <- wb$to_df("with caption") 82 | expect_equal( 83 | names(df)[2], 84 | "This is a complex caption" 85 | ) 86 | 87 | expect_equal( 88 | unlist(df[1, ]) |> 89 | as.vector(), 90 | c( 91 | NA, 92 | names(mtcars) 93 | ) 94 | ) 95 | }) 96 | -------------------------------------------------------------------------------- /tests/testthat/test-wb_add_flextable.R: -------------------------------------------------------------------------------- 1 | test_that( 2 | "flextable without header", 3 | { 4 | skip_if_not_installed("flextable") 5 | 6 | sheet <- "iris" 7 | ft <- datasets::iris |> 8 | head() |> 9 | flextable::flextable() |> 10 | flextable::delete_part(part = "header") 11 | wb <- openxlsx2::wb_workbook()$add_worksheet(sheet) 12 | dims <- "B2" 13 | 14 | 15 | wb <- wb_add_flextable( 16 | wb = wb, 17 | ft = ft, 18 | sheet = sheet, 19 | dims = dims 20 | ) 21 | test_wb_ft(wb, ft, "without_header") 22 | 23 | df <- openxlsx2::wb_read(wb, 24 | sheet = sheet, 25 | start_row = 2, 26 | start_col = 2, 27 | col_names = FALSE 28 | ) 29 | df$`F` <- NULL 30 | df2 <- datasets::iris |> 31 | head() 32 | df2$Species <- NULL 33 | 34 | 35 | expect_equal( 36 | as.numeric(unlist(df)), 37 | as.numeric(unlist(df2)) 38 | ) 39 | 40 | NULL 41 | } 42 | ) 43 | 44 | test_that("Add with numeric offset", { 45 | skip_if_not_installed("flextable") 46 | data("mtcars") 47 | 48 | sheet <- "iris" 49 | ft <- mtcars |> 50 | head() |> 51 | flextable::flextable() 52 | wb <- openxlsx2::wb_workbook()$add_worksheet(sheet) 53 | 54 | wb <- wb_add_flextable( 55 | wb = wb, 56 | ft = ft, 57 | sheet = sheet, 58 | start_col = 2, 59 | start_row = 2 60 | ) 61 | test_wb_ft(wb, ft, "numeric_offset") 62 | 63 | df <- openxlsx2::wb_read(wb, 64 | sheet = sheet, 65 | start_row = 2, 66 | start_col = 2, 67 | col_names = TRUE 68 | ) 69 | df2 <- mtcars |> 70 | head() 71 | rownames(df2) <- NULL 72 | 73 | 74 | expect_equal( 75 | as.numeric(unlist(df)), 76 | as.numeric(unlist(df2)) 77 | ) 78 | 79 | NULL 80 | }) 81 | 82 | test_that("Add multi-header", { 83 | skip_if_not_installed("flextable") 84 | 85 | typology <- data.frame( 86 | col_keys = c( 87 | "Sepal.Length", "Sepal.Width", "Petal.Length", 88 | "Petal.Width", "Species" 89 | ), 90 | what = c("Sepal", "Sepal", "Petal", "Petal", "Species"), 91 | measure = c("Length", "Width", "Length", "Width", "Species"), 92 | stringsAsFactors = FALSE 93 | ) 94 | 95 | ft_1 <- flextable::flextable(head(iris)) |> 96 | flextable::set_header_df(mapping = typology, key = "col_keys") |> 97 | flextable::merge_h(part = "header") |> 98 | flextable::merge_v(j = "Species", part = "header") |> 99 | flextable::theme_vanilla() |> 100 | flextable::fix_border_issues() |> 101 | flextable::autofit() 102 | 103 | wb <- openxlsx2::wb_workbook()$add_worksheet("multiheader") 104 | 105 | wb <- wb_add_flextable( 106 | wb = wb, 107 | ft = ft_1, 108 | sheet = "multiheader", 109 | start_col = 2, 110 | start_row = 2 111 | ) 112 | test_wb_ft(wb, ft_1, "multi_header") 113 | 114 | expect_equal( 115 | openxlsx2::wb_read(wb, 116 | sheet = "multiheader", 117 | start_row = 2, 118 | start_col = 2, 119 | col_names = TRUE 120 | ) |> 121 | colnames(), 122 | c("Sepal", NA, "Petal", NA, "Species") 123 | ) 124 | 125 | expect_equal( 126 | openxlsx2::wb_read(wb, 127 | sheet = "multiheader", 128 | start_row = 3, 129 | start_col = 2, 130 | col_names = TRUE 131 | ) |> 132 | colnames(), 133 | c("Length", "Width", "Length", "Width", NA) 134 | ) 135 | 136 | NULL 137 | }) 138 | 139 | test_that("using openxlsx2::current_sheet() works", { 140 | skip_if_not_installed("flextable") 141 | 142 | ft <- flextable::as_flextable(table(mtcars[, 1:2])) 143 | 144 | wb <- openxlsx2::wb_workbook() |> 145 | openxlsx2::wb_add_worksheet() |> 146 | flexlsx::wb_add_flextable( 147 | sheet = openxlsx2::current_sheet(), 148 | ft = ft, 149 | dims = "C2" 150 | ) 151 | 152 | expect_equal( 153 | wb$get_sheet_names(), 154 | c(`Sheet 1` = "Sheet 1") 155 | ) 156 | 157 | wb <- openxlsx2::wb_workbook() |> 158 | openxlsx2::wb_add_worksheet() |> 159 | flexlsx::wb_add_flextable( 160 | ft = ft, 161 | dims = "A1" 162 | ) 163 | 164 | expect_equal( 165 | wb$get_sheet_names(), 166 | c(`Sheet 1` = "Sheet 1") 167 | ) 168 | 169 | expect_equal( 170 | names(wb$to_df(sheet = "Sheet 1")), 171 | c("mpg", NA, "cyl", NA, NA, NA) 172 | ) 173 | }) 174 | 175 | test_that("When sheet does not exists throws an error", { 176 | skip_if_not_installed("flextable") 177 | 178 | ft <- flextable::as_flextable(table(mtcars[, 1:2])) 179 | 180 | expect_error( 181 | openxlsx2::wb_workbook() |> 182 | flexlsx::wb_add_flextable( 183 | sheet = openxlsx2::current_sheet(), 184 | ft = ft, 185 | dims = "C2" 186 | ), 187 | regexp = "Sheet 'current_sheet' does not exist!" 188 | ) 189 | 190 | expect_error( 191 | openxlsx2::wb_workbook() |> 192 | flexlsx::wb_add_flextable( 193 | sheet = "test", 194 | ft = ft, 195 | dims = "C2" 196 | ), 197 | regexp = "Sheet 'test' does not exist!" 198 | ) 199 | }) 200 | 201 | test_that("Complex FT", { 202 | skip_if_not_installed("officer") 203 | skip_if_not_installed("flextable") 204 | 205 | library(flextable) 206 | 207 | # --------------------------------------------------------------------------- 208 | # 1. Create a sample data frame. 209 | # Each column name identifies what aspect is being tested. 210 | df <- data.frame( 211 | id = c("Row1", "Row2", "Row3", "Row4"), 212 | chunk_test = c("Format", "Format", "Format", "Format"), 213 | para_test = c("Paragraph", "Paragraph", "Paragraph", "Paragraph"), 214 | h1 = c("Merge", "A", "B", "C"), # For horizontal merging test 215 | h2 = c("Merge", "X", "Y", "Z"), # For horizontal merging test 216 | v1 = c("Unique", "MergeV", "MergeV", "Unique"), # For vertical merging test 217 | append_test = c("Original", "Original", "Original", "Original"), 218 | stringsAsFactors = FALSE 219 | ) 220 | 221 | # --------------------------------------------------------------------------- 222 | # 2. Create the flextable object from the data frame. 223 | ft <- flextable(df) 224 | 225 | # --------------------------------------------------------------------------- 226 | # 3. Set custom column widths (in inches) and row heights. 227 | ft <- width(ft, j = 1, width = 0.7) # 'id' 228 | ft <- width(ft, j = 2, width = 2) # 'chunk_test' 229 | ft <- width(ft, j = 3, width = 2) # 'para_test' 230 | ft <- width(ft, j = 4, width = 1) # 'h1' 231 | ft <- width(ft, j = 5, width = 1) # 'h2' 232 | ft <- width(ft, j = 6, width = 1) # 'v1' 233 | ft <- width(ft, j = 7, width = 2) # 'append_test' 234 | 235 | ft <- height(ft, i = 1:4, height = 0.8, part = "body") 236 | 237 | # --------------------------------------------------------------------------- 238 | # 4. Add a header row (spanning all columns), a caption, and a footer. 239 | ft <- add_header_row(ft, 240 | values = c("Advanced Test Table"), 241 | colwidths = ncol(df) 242 | ) 243 | ft <- merge_h(ft, part = "header") # Merge the header row into one cell 244 | ft <- set_caption(ft, 245 | caption = "Advanced Flextable Test: Chunks, Paragraphs, Merges & Borders" 246 | ) 247 | ft <- add_footer_lines(ft, values = "Footer: End of Advanced Test") 248 | 249 | # --------------------------------------------------------------------------- 250 | # 5. Use sugar functions to style chunks in the 'chunk_test' column. 251 | # Compose a paragraph with multiple formatted chunks. 252 | ft <- compose(ft, 253 | j = "chunk_test", i = 1, 254 | value = as_paragraph( 255 | "Normal text, ", 256 | as_b("Bold text, "), 257 | as_i("Italic text, "), 258 | as_sub("Subscript, "), 259 | as_sup("Superscript") 260 | ) 261 | ) 262 | # For rows 2-4, show a simple composition with inline formatting. 263 | for (i in 2:4) { 264 | ft <- compose(ft, 265 | j = "chunk_test", i = i, 266 | value = as_paragraph("Row ", i, ": ", as_b("Bold"), ", ", as_i("Italic")) 267 | ) 268 | } 269 | 270 | # --------------------------------------------------------------------------- 271 | # 6. Compose multi-line paragraphs in the 'para_test' column. 272 | # Here we mix plain text with formatted chunks. 273 | ft <- compose(ft, 274 | j = "para_test", i = 1, 275 | value = as_paragraph( 276 | "Line1", "\n", 277 | as_b("Line2 Bold"), "\n", 278 | as_i("Line3 Italic") 279 | ) 280 | ) 281 | 282 | # --------------------------------------------------------------------------- 283 | # 7. Apply different alignments. 284 | ft <- align(ft, j = "chunk_test", align = "left", part = "all") 285 | ft <- align(ft, j = "para_test", align = "center", part = "all") 286 | ft <- align(ft, j = "h1", align = "right", part = "all") 287 | 288 | # --------------------------------------------------------------------------- 289 | # 8. Prepend and append content in the 'append_test' column. 290 | # Prepend a label and then append a suffix. 291 | ft <- compose(ft, 292 | j = "append_test", 293 | value = as_paragraph("Prepended: ", as_chunk(append_test)) 294 | ) 295 | ft <- append_chunks(ft, 296 | j = "append_test", 297 | value = as_chunk(" :Appended") 298 | ) 299 | 300 | # --------------------------------------------------------------------------- 301 | # 9. Set inner and outer borders with different colors and sizes. 302 | outer_border <- officer::fp_border(color = "red", width = 2) 303 | inner_border <- officer::fp_border(color = "#3333BB", width = 1) 304 | ft <- border_outer(ft, border = outer_border, part = "all") 305 | ft <- border_inner(ft, border = inner_border, part = "all") 306 | 307 | # --------------------------------------------------------------------------- 308 | # 10. Set padding and line spacing. 309 | ft <- padding(ft, padding = 5, part = "all") 310 | ft <- line_spacing(ft, space = 1.5, part = "all") 311 | 312 | #' --------------------------------------------------------------------------- 313 | #' 11. Merge cells horizontally and vertically. 314 | #' a) Horizontal merge in the body: 315 | #' In row 1, columns 'h1' and 'h2' share identical content ("Merge") 316 | #' so merge them. 317 | ft <- merge_h(ft, i = 1, part = "body") 318 | 319 | # b) Vertical merge in column 'v1' for rows 2 and 3 (they are identical). 320 | ft <- merge_v(ft, j = "v1", part = "body") 321 | 322 | #' c) Simultaneous horizontal and vertical merging: 323 | #' For demonstration, force rows 2 and 3 in columns 'chunk_test' and 324 | #' para_test' 325 | #' to have identical content, then merge horizontally (across these 326 | #' two columns) and vertically (across rows 2 and 3). 327 | ft <- compose(ft, 328 | i = 2:3, j = c("chunk_test", "para_test"), 329 | value = as_paragraph("Combined") 330 | ) 331 | 332 | # Define new border styles using fp_border: 333 | dashed_border <- officer::fp_border( 334 | color = "darkgreen", 335 | width = 1, 336 | style = "dashed" 337 | ) 338 | dotted_border <- officer::fp_border( 339 | color = "orange", 340 | width = 1.5, 341 | style = "dotted" 342 | ) 343 | double_border <- officer::fp_border( 344 | color = "purple", 345 | width = 3, 346 | style = "double" 347 | ) 348 | 349 | # Apply a double border to the bottom edge of the header row: 350 | ft <- border(ft, i = 1, border.bottom = double_border, part = "header") 351 | 352 | # Apply a dashed border on the left side of the "id" column in the body: 353 | ft <- border(ft, j = "id", border.left = dashed_border, part = "body") 354 | 355 | #' Apply a dotted border on the right side of the "append_test" column in 356 | #' the body: 357 | ft <- border(ft, 358 | j = "append_test", 359 | border.right = dotted_border, 360 | part = "body" 361 | ) 362 | 363 | # Apply a dotted border on the bottom side of the "h1" column in the body: 364 | ft <- border(ft, j = "h1", border.bottom = dotted_border, part = "body") 365 | 366 | # Apply a double border on all sides of the "chunk_test" column in the body: 367 | ft <- border(ft, j = "chunk_test", border = double_border, part = "body") 368 | 369 | #' For merged cells in the "chunk_test" and "para_test" columns (rows 2 and 370 | #' 3), apply a combination: dashed border on the top and dotted border on the 371 | #' bottom. 372 | ft <- border(ft, 373 | i = 2:3, j = c("chunk_test", "para_test"), 374 | border.top = dashed_border, border.bottom = dotted_border, 375 | part = "body" 376 | ) 377 | 378 | # Apply a light cyan background to the 'id' column 379 | ft <- bg(ft, j = "id", bg = "#AAFAFA", part = "all") 380 | 381 | # Apply a light blueish background to the 'chunk_test' column 382 | ft <- bg(ft, j = "chunk_test", bg = "#ABBBFA", part = "all") 383 | 384 | # Apply an orange background to the 'para_test' column 385 | ft <- bg(ft, j = "para_test", bg = "orange", part = "all") 386 | 387 | # Merge combined 388 | ft <- merge_v(ft, j = 2:3) 389 | ft <- merge_h(ft, i = 2:3) 390 | 391 | ## Add colinfo 392 | ft <- add_header_row(ft, values = LETTERS[2:8]) 393 | 394 | expect_no_warning(wb <- openxlsx2::wb_workbook() |> 395 | openxlsx2::wb_add_worksheet() |> 396 | flexlsx::wb_add_flextable( 397 | ft = ft, 398 | dims = "B2" 399 | )) 400 | 401 | 402 | test_wb_ft(wb, ft, "complex ft") 403 | }) 404 | 405 | 406 | test_that("MeganMcAuliffe test", { 407 | skip_if_not_installed("flextable") 408 | skip_if(Sys.getenv("flexlsxtestdir") == "") 409 | 410 | 411 | ft <- readRDS(paste0( 412 | Sys.getenv("flexlsxtestdir"), 413 | "ft_list_element.rds" 414 | )) |> 415 | flextable::autofit() 416 | 417 | expect_no_warning(wb <- openxlsx2::wb_workbook() |> 418 | openxlsx2::wb_add_worksheet() |> 419 | flexlsx::wb_add_flextable( 420 | ft = ft, 421 | dims = "B2" 422 | )) 423 | 424 | test_wb_ft(wb, ft, "MeganMcAuliffe ft") 425 | }) 426 | 427 | 428 | test_that("bold test", { 429 | skip_if_not_installed("flextable") 430 | skip_if(Sys.getenv("flexlsxtestdir") == "") 431 | 432 | 433 | library(flextable) 434 | library(flexlsx) 435 | 436 | # flextable 437 | ft <- flextable(head(iris)) |> 438 | separate_header(split = "[.]") |> 439 | font(fontname="Times New Roman", part="all") |> 440 | fontsize(i=1, size=13, part="header") |> 441 | bold(bold=TRUE, part="header") # bold() is the issue here 442 | 443 | 444 | expect_no_warning(wb <- openxlsx2::wb_workbook() |> 445 | openxlsx2::wb_add_worksheet() |> 446 | flexlsx::wb_add_flextable( 447 | ft = ft, 448 | dims = "B2" 449 | )) 450 | 451 | test_wb_ft(wb, ft, "bold ft") 452 | }) 453 | -------------------------------------------------------------------------------- /tests/testthat/test-wb_apply_cell_styles.R: -------------------------------------------------------------------------------- 1 | test_that("error if sheet is non-existant", { 2 | skip_if_not_installed("flextable") 3 | data("mtcars") 4 | 5 | ft <- flextable::flextable(mtcars) 6 | wb <- openxlsx2::wb_workbook() 7 | 8 | wb_add_flextable( 9 | wb = wb, 10 | ft = ft, 11 | sheet = "nonexistant", 12 | dims = "B4" 13 | ) |> 14 | expect_error() 15 | 16 | wb_apply_cell_styles(wb, "nonexistant", NULL) |> 17 | expect_error() 18 | }) 19 | 20 | test_that("add fill", { 21 | skip_if_not_installed("flextable") 22 | data("mtcars") 23 | 24 | ft <- flextable::flextable(mtcars) 25 | wb <- openxlsx2::wb_workbook()$add_worksheet("fill") 26 | 27 | 28 | ft <- flextable::bg(ft, 29 | i = ~ am == 1, 30 | j = ~am, 31 | bg = "orange", 32 | part = "body" 33 | ) |> 34 | flextable::bg( 35 | i = ~ hp > 100, 36 | j = ~hp, 37 | bg = "red", 38 | part = "body" 39 | ) 40 | 41 | 42 | wb <- wb_add_flextable( 43 | wb = wb, 44 | ft = ft, 45 | sheet = "fill", 46 | dims = "D5" 47 | ) 48 | 49 | 50 | expect_true(wb$get_cell_style("fill", dims = "G6") != 51 | wb$get_cell_style("fill", dims = "H6")) 52 | expect_true(wb$get_cell_style("fill", dims = "L6") != 53 | wb$get_cell_style("fill", dims = "H6")) 54 | expect_true(wb$get_cell_style("fill", dims = "L6") != 55 | wb$get_cell_style("fill", dims = "G6")) 56 | }) 57 | -------------------------------------------------------------------------------- /tests/testthat/test-wb_apply_merge.R: -------------------------------------------------------------------------------- 1 | test_that("rowwise merge works", { 2 | skip_if_not_installed("flextable") 3 | data("mtcars") 4 | 5 | sheet <- "iris" 6 | ft <- mtcars |> 7 | head() |> 8 | flextable::flextable() 9 | 10 | ft <- flextable::merge_h(ft, i = 5) 11 | 12 | wb <- openxlsx2::wb_workbook()$add_worksheet(sheet) 13 | 14 | wb <- wb_add_flextable( 15 | wb = wb, 16 | ft = ft, 17 | sheet = sheet, 18 | start_col = 2, 19 | start_row = 2 20 | ) 21 | 22 | test_wb_ft(wb, ft, "merge_row") 23 | 24 | df <- openxlsx2::wb_read(wb, 25 | sheet = sheet, 26 | start_row = 2, 27 | start_col = 2, 28 | col_names = TRUE 29 | ) 30 | 31 | df2 <- mtcars |> 32 | head() 33 | rownames(df2) <- NULL 34 | df2[5, 9] <- NA 35 | 36 | expect_equal( 37 | as.numeric(unlist(df)), 38 | as.numeric(unlist(df2)) 39 | ) 40 | 41 | NULL 42 | }) 43 | 44 | 45 | test_that("columnwise merge works", { 46 | skip_if_not_installed("flextable") 47 | data("mtcars") 48 | 49 | sheet <- "iris" 50 | ft <- mtcars |> 51 | head() |> 52 | flextable::flextable() 53 | 54 | ft <- flextable::merge_v(ft, j = ~ vs + am + gear) 55 | 56 | wb <- openxlsx2::wb_workbook()$add_worksheet(sheet) 57 | 58 | wb <- wb_add_flextable( 59 | wb = wb, 60 | ft = ft, 61 | sheet = sheet, 62 | start_col = 2, 63 | start_row = 2 64 | ) 65 | test_wb_ft(wb, ft, "merge_col") 66 | 67 | df <- openxlsx2::wb_read(wb, 68 | sheet = sheet, 69 | start_row = 2, 70 | start_col = 2, 71 | col_names = TRUE 72 | ) 73 | 74 | df2 <- mtcars |> 75 | head() |> 76 | dplyr::mutate(dplyr::across( 77 | c(vs, am, gear), 78 | ~ ifelse(coalesce(lag(.x), -1) == .x, 79 | NA, .x 80 | ) 81 | )) 82 | rownames(df2) <- NULL 83 | 84 | expect_equal( 85 | as.numeric(unlist(df)), 86 | as.numeric(unlist(df2)) 87 | ) 88 | 89 | NULL 90 | }) 91 | 92 | test_that("complex merge works", { 93 | skip_if_not_installed("flextable") 94 | data("mtcars") 95 | 96 | sheet <- "iris" 97 | ft <- mtcars |> 98 | head() |> 99 | flextable::flextable() 100 | 101 | ft <- flextable::merge_v(ft, j = ~ vs + am + gear) 102 | ft <- flextable::merge_h(ft, i = 5) 103 | 104 | wb <- openxlsx2::wb_workbook()$add_worksheet(sheet) |> 105 | wb_add_flextable( 106 | ft = ft, 107 | sheet = sheet, 108 | start_col = 2, 109 | start_row = 2 110 | ) |> 111 | expect_warning() 112 | 113 | NULL 114 | }) 115 | --------------------------------------------------------------------------------