[Suggestion] allow superscripts and subscripts to be created.

[Fergus-Boyd]

I've written the following function to enable me to do this write XML directly to the 'shared strings' list. Is there a more straightforward way this could be achieved?:

#' Writes text to a cell within a wookbook object and adds a superscript or a subscript
#
#' @param wb A workbook object
#' @param sheet A sheet within the workbook object
#' @param row The row number you want to write to
#' @param col The column number you want to write to
#' @param text The text (not including the superscript) you want written.
#' @param superScriptText The text you want in the superscript
#' @param position A number specifying how far along in the text you want the superscript to occur. Defaults to nchar(text), (ie, the last position)
#' @param superOrSub TRUE or FALSE is you want to return a superscript or a subscript. Defaults to superscript (TRUE)
#' @param size The size of the font. Defaults to 10
#' @param colour The hex code of the colour of the text. Defaults to black (000000) 
#' @param font The font. Defaults to Arial
#' @param family Not sure what this is for.
#' @param bold TRUE or FALSE if you want text to be bold
#' @param italic TRUE or FALSE if you want text to be italic
#' @param underlined TRUE or FALSE if you want text to be underlined

addSuperScriptToCell <- function(wb,
                                 sheet,
                                 row,
                                 col,
                                 text,
                                 superScriptText,
                                 position = nchar(text),
                                 superOrSub = TRUE,
                                 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 before and after the superscript

  preText <- stringr::str_sub(text,
                              1,
                              position)

  postText <- stringr::str_sub(text,
                               position + 1,
                               nchar(text))

  #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(superOrSub){
    vert <- '<vertAlign val=\"superscript\"/>'
  } else{vert <- '<vertAlign val=\"subscript\"/>'}

  if(bold){
    bld <- '<b/>'
  } else{bld <- ''}

  if(italic){
    itl <- '<i/>'
  } else{itl <- ''}

  if(underlined){
    uld <- '<u/>'
  } else{uld <- ''}

  #run properties

  rPrText <- paste(sz,
                   col,
                   rFont,
                   fam,
                   bld,
                   itl,
                   uld,
                   sep = '')

  rPrSuperText <- paste(vert,
                        sz,
                        col,
                        rFont,
                        fam,
                        bld,
                        itl,
                        uld,
                        sep = '')

  newString <- paste('<si><r><rPr>',
                     rPrText,
                     '</rPr><t xml:space="preserve">',
                     preText,
                     '</t></r><r><rPr>',
                     rPrSuperText,
                     '</rPr><t xml:space="preserve">',
                     superScriptText,
                     '</t></r><r><rPr>',
                     rPrText,
                     '</rPr><t xml:space="preserve">',
                     postText,
                     '</t></r></si>',
                     sep = '')

  wb$sharedStrings[stringToUpdate] <- newString
}

[statzg]

I've writen this small snippet to replace certain substrings with substrings in superscript (for example "1)"). We use this to create footnotes in our excel-sheets. The snippet replaces "1)" to "9)" with "1)" to "9)" in superscript.

`for (i in grep("\*(\d)", wb$sharedStrings)) {

prepare string for additional formating

wb$sharedStrings[i]=gsub("", "", gsub("", "", wb$sharedStrings[i]))

replacing the desired strings using regex

wb$sharedStrings[i]=gsub("\*(\d))", "<vertAlign val=\"superscript\"/><t xml:space=\"preserve\">\1)<t xml:space=\"preserve\">", wb$sharedStrings[i]) }`

Could be easily adappted to do subscript or reformat any other substring. Be aware that this migth destroy any other cell-specific text formating. I have not tested that.

[AlvaroMCMC]

I modified your function to make it more general, you only need one input:

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
}