How to make this XML code generate bold text?

user_7507590 0
Viewed 199

This a reprex.

dt <- data.frame(a = 1:3, b = c("a", "b", ""))

dt$sup <- paste0(dt$a, "_[", dt$b, "]") # create superscript col, enclosed in '_[]'

wb <- openxlsx::createWorkbook() # create workbook

openxlsx::addWorksheet(wb, sheetName = "data") # add sheet

openxlsx::writeData(wb, sheet=1, x=dt, xy=c(1, 1)) # write data on workbook

for(i in grep("\\_\\[([A-z0-9\\s]*)\\]", wb$sharedStrings)){
  # if empty string in superscript notation, then just remove the superscript notation
  if(grepl("\\_\\[\\]", wb$sharedStrings[[i]])){
   wb$sharedStrings[[i]] <- gsub("\\_\\[\\]", "", wb$sharedStrings[[i]])
   next # skip to next iteration
  }

  # insert additioanl formating in shared string
  wb$sharedStrings[[i]] <- gsub("<si>", "<si><r>", gsub("</si>", "</r></si>", wb$sharedStrings[[i]]))

  # find the "_[...]" pattern, remove brackets and udnerline and enclose the text with superscript format
  wb$sharedStrings[[i]] <- gsub("\\_\\[([A-z0-9\\s]*)\\]", "</t></r><r><rPr><vertAlign val=\"superscript\"/></rPr><t xml:space=\"preserve\">\\1</t></r><r><t xml:space=\"preserve\">", wb$sharedStrings[[i]])
}

openxlsx::saveWorkbook(wb, file="test.xlsx", overwrite = TRUE)

This is a the output from the code above:

enter image description here

I need to change some part of the xml code to generate bold text as this: enter image description here

I tried using the formating from openxlsx package but I get: enter image description here

This is the code from openxlsx formating, but it does not bold the superscript part as you see above. So I think the path for doing that is modifying the xml code in order to get it, and that's the help I need.

openxlsx::addStyle(wb, "text.xlsx", 
         style = openxlsx::createStyle(textDecoration = "bold"),
         rows = 2:3, cols = 3, gridExpand = TRUE)
r excel xml
1 Answers

I solve this with this function with only one input:

your input texto should be in this format:

text: "normal text [superscript] ~ subscript ~" (avoid spaces between ~)

addSuperSubScriptToCell_general <- function(wb,
                                 sheet,
                                 row,
                                 col,
                                 texto,
                                 size = '10',
                                 colour = '000000',
                                 font = 'Arial',
                                 family = '2',
                                 bold = FALSE,
                                 italic = FALSE,
                                 underlined = FALSE) {
  
  placeholderText <- 'This is placeholder text that should not appear anywhere in your document.'
  
  openxlsx::writeData(wb = wb,
                      sheet = sheet,
                      x = placeholderText,
                      startRow = row,
                      startCol = col)
  
  #finds the string that you want to update
  stringToUpdate <- which(sapply(wb$sharedStrings,
                                 function(x){
                                   grep(pattern = placeholderText,
                                        x)
                                 }
  )
  == 1)
  
  #splits the text into normal text, superscript and subcript
  
  normal_text <- str_split(texto, "\\[.*\\]|~.*~") %>% pluck(1) %>% purrr::discard(~ . == "")
  
  sub_sup_text <- str_extract_all(texto, "\\[.*\\]|~.*~") %>% pluck(1)
  
  if (length(normal_text) > length(sub_sup_text)) {
    sub_sup_text <- c(sub_sup_text, "")
  } else if (length(sub_sup_text) > length(normal_text)) {
    normal_text <- c(normal_text, "")
  }
# this is the separated text which will be used next
texto_separado <- map2(normal_text, sub_sup_text, ~ c(.x, .y)) %>% 
    reduce(c) %>% 
    purrr::discard(~ . == "")
  
#formatting instructions
  
  sz    <- paste('<sz val =\"',size,'\"/>',
                 sep = '')
  col   <- paste('<color rgb =\"',colour,'\"/>',
                 sep = '')
  rFont <- paste('<rFont val =\"',font,'\"/>',
                 sep = '')
  fam   <- paste('<family val =\"',family,'\"/>',
                 sep = '')

#if its sub or sup adds the corresponding xml code
sub_sup_no <- function(texto) {
  
  if(str_detect(texto, "\\[.*\\]")){
    return('<vertAlign val=\"superscript\"/>')
  } else if (str_detect(texto, "~.*~")) {
    return('<vertAlign val=\"subscript\"/>')
  } else {
    return('')
  }
}

#get text from normal text, sub and sup
get_text_sub_sup <- function(texto) {
  str_remove_all(texto, "\\[|\\]|~")
}

#formating
  if(bold){
    bld <- '<b/>'
  } else{bld <- ''}
  
  if(italic){
    itl <- '<i/>'
  } else{itl <- ''}
  
  if(underlined){
    uld <- '<u/>'
  } else{uld <- ''}
  
#get all properties from one element of texto_separado

get_all_properties <- function(texto) {
  
  paste0('<r><rPr>',
    sub_sup_no(texto),
        sz,
        col,
        rFont,
        fam,
        bld,
        itl,
        uld,
        '</rPr><t xml:space="preserve">',
        get_text_sub_sup(texto),
        '</t></r>')
}


# use above function in texto_separado
newString <- map(texto_separado, ~ get_all_properties(.)) %>% 
  reduce(paste, sep = "") %>% 
  {c("<si>", ., "</si>")} %>% 
  reduce(paste, sep = "")

# replace initial text
  wb$sharedStrings[stringToUpdate] <- newString
}
user_75075900
Related