Inspect worksheet cell styles

[JanMarvin]

A recent discussion with @sjewo inspired me to mimic what I had see in the tidyxl vignette a while ago. This is just a proof of concept, there are other font styles like underlines, strikes etc. that the code below does not cover.

library(openxlsx2)

# helper function
get_color <- function(x) {
  out <- openxlsx2:::rbindlist(xml_attr(x, "patternFill", "fgColor"))$rgb
  out <- if (length(out)) paste0("#", substr(out, 3, 8)) else ""
  out
}

# example data set
ttnc <- system.file("extdata", "titanic.xlsx", package = "tidyxl")


# read file as is and construct dims
wb   <- wb_load(ttnc)
df   <- wb_to_df(wb, col_names = FALSE)
dims <- dataframe_to_dims(df)

# get cell styles and create a matrix matching df
sty                     <- wb$get_cell_style(dims = dims)
df_cell_style           <- matrix(sty, nrow(df), ncol(df), byrow = TRUE)
dimnames(df_cell_style) <- dimnames(df)

# all style informations are linked into xf XML styles
cell_styles <- as.integer(unique(replace(sty, sty == "", "0")))
xfs_xml <- wb$styles_mgr$styles$cellXfs[cell_styles + 1L]

styles    <- openxlsx2:::read_xf(read_xml(xfs_xml))
styles$id <- as.character(cell_styles)

## get cell background colors
fill_styles <- as.integer(unique(replace(styles$fillId, styles$fillId == "", "0")))
fills_xml   <- wb$styles_mgr$styles$fills[fill_styles + 1L]

fills      <- openxlsx2:::read_fill(read_xml(fills_xml))
fills$id   <- as.character(fill_styles)
fills$rgbs <- vapply(fills$patternFill, get_color, NA_character_)

styles$colors <- fills$rgbs[match(styles$fillId, fills$id)]

## print colors
rgbs <- unique(fills$rgbs)
rgbs <- rgbs[rgbs != ""]
barplot(
  rep(1, length(rgbs)),
  col = rgbs, names.arg = rgbs,
  main = "colors", yaxt = "n", las = 2
)

## get cell fonts
font_styles <- as.integer(unique(replace(styles$fontId, styles$fontId == "", "0")))
fonts_xml   <- wb$styles_mgr$styles$fonts[font_styles + 1L]

font_ids        <- openxlsx2:::read_font(read_xml(fonts_xml))
font_ids$id     <- as.character(font_styles)
font_ids$bold   <- ifelse(font_ids$b != "", "bold", "")
font_ids$italic <- ifelse(font_ids$i != "", "italic", "")
font_ids$font   <- trimws(paste(font_ids$bold, font_ids$italic))

styles$font <- font_ids$font[match(styles$fontId, font_ids$id)]

## create data frames to understand the styles applied to the data
df_colors <- df_cell_style
df_fonts  <- df_cell_style

for (id in styles$id) {
  df_colors[df_colors == id] <- styles$colors[styles$id == id]
  df_fonts[df_fonts == id]   <- styles$font[styles$id == id]
}

message("cell background colors")
#> cell background colors
df_colors
#>    A  B  C  D  E  F         G        
#> 1  "" "" "" "" "" ""        ""       
#> 2  "" "" "" "" "" ""        ""       
#> 3  "" "" "" "" "" ""        ""       
#> 4  "" "" "" "" "" ""        ""       
#> 5  "" "" "" "" "" ""        ""       
#> 6  "" "" "" "" "" ""        ""       
#> 7  "" "" "" "" "" ""        ""       
#> 8  "" "" "" "" "" ""        ""       
#> 9  "" "" "" "" "" ""        ""       
#> 10 "" "" "" "" "" ""        ""       
#> 11 "" "" "" "" "" "#FFFF00" "#FFFF00"

message("cell font styles")
#> cell font styles
df_fonts
#>    A        B        C      D        E        F        G       
#> 1  ""       ""       "bold" "italic" "italic" "italic" "italic"
#> 2  ""       ""       "bold" "italic" "italic" "italic" "italic"
#> 3  "bold"   "bold"   ""     ""       ""       ""       ""      
#> 4  "italic" "italic" ""     ""       ""       ""       ""      
#> 5  "italic" "italic" ""     ""       ""       ""       ""      
#> 6  "italic" "italic" ""     ""       ""       ""       ""      
#> 7  "italic" "italic" ""     ""       ""       ""       ""      
#> 8  "italic" "italic" ""     ""       ""       ""       ""      
#> 9  "italic" "italic" ""     ""       ""       ""       ""      
#> 10 "italic" "italic" ""     ""       ""       ""       ""      
#> 11 "italic" "italic" ""     ""       ""       ""       ""