How to make this XML code generate bold text? - r

Question

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:
I need to change some part of the xml code to generate bold text as this:
I tried using the formating from openxlsx package but I get:
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)

Answer 1

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
}