R/ooxml.R

Defines functions tcpr_css css_px tcpr_wml tcpr_pml rpr_css rpr_wml rpr_pml ppr_wml ppr_css ppr_pml border_css border_wml border_pml linejoin_pml dash_pml lineend_pml ln_pml prst_geom_pml solid_fill_pml solid_fill is_transparent colalpha hex_color css_color p_xfrm_str a_xfrm_str runs_to_p_wml

# tags with namespaces ----

wp_ns_yes <- "<w:p xmlns:w=\"http://schemas.openxmlformats.org/wordprocessingml/2006/main\" xmlns:wp=\"http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:w14=\"http://schemas.microsoft.com/office/word/2010/wordml\">"
wp_ns_no <- "<w:p>"

tbl_ns_yes <- "<w:tbl xmlns:w=\"http://schemas.openxmlformats.org/wordprocessingml/2006/main\" xmlns:wp=\"http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\">"
tbl_ns_no <- "<w:tbl>"

wr_ns_yes <- "<w:r xmlns:w=\"http://schemas.openxmlformats.org/wordprocessingml/2006/main\" xmlns:wp=\"http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:w14=\"http://schemas.microsoft.com/office/word/2010/wordml\">"
wr_ns_no <- "<w:r>"

ar_ns_yes <- "<a:r xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">"
ar_ns_no <- "<a:r>"

ap_ns_yes <- "<a:p xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">"
ap_ns_no <- "<a:p>"

psp_ns_yes <- "<p:sp xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\">"
psp_ns_no <- "<p:sp>"

# utils -----
runs_to_p_wml <- function(..., add_ns = FALSE, style_id = NULL) {
  runs <- list(...)
  run_str <- lapply(runs, to_wml, add_ns = FALSE)
  run_str$collapse <- ""
  run_str <- do.call(paste0, run_str)
  open_tag <- wp_ns_no
  if (add_ns) {
    open_tag <- wp_ns_yes
  }

  if (!is.null(style_id)) {
    ppr <- paste0("<w:pPr><w:pStyle w:val=\"", style_id, "\"/></w:pPr>")
  } else {
    ppr <- "<w:pPr/>"
  }
  out <- paste0(open_tag, ppr, run_str, "</w:p>")
  out
}


a_xfrm_str <- function(left = 0, top = 0, width = 3, height = 3, rot = 0) {
  start_tag <- "<a:xfrm>"
  if (!is.null(rot) && !is.na(rot) && rot != 0) {
    start_tag <- sprintf("<a:xfrm rot=\"%.0f\">", -rot * 60000)
  }

  xfrm_str <- paste0(start_tag, "<a:off x=\"%.0f\" y=\"%.0f\"/><a:ext cx=\"%.0f\" cy=\"%.0f\"/></a:xfrm>")
  sprintf(
    xfrm_str,
    left * 914400, top * 914400,
    width * 914400, height * 914400
  )
}

p_xfrm_str <- function(left = 0, top = 0, width = 3, height = 3, rot = 0) {
  if (is.null(rot) || !is.finite(rot)) {
    rot <- 0
  }

  xfrm_str <- "<p:xfrm rot=\"%.0f\"><a:off x=\"%.0f\" y=\"%.0f\"/><a:ext cx=\"%.0f\" cy=\"%.0f\"/></p:xfrm>"
  sprintf(
    xfrm_str, -rot * 60000,
    left * 914400, top * 914400,
    width * 914400, height * 914400
  )
}


# colors ----

css_color <- function(color) {
  color <- as.vector(col2rgb(color, alpha = TRUE)) / c(1, 1, 1, 255)

  if (!(color[4] > 0)) {
    "transparent"
  } else {
    sprintf(
      "rgba(%.0f,%.0f,%.0f,%.2f)",
      color[1], color[2], color[3], color[4]
    )
  }
}
hex_color <- function(color) {
  color <- as.vector(col2rgb(color, alpha = TRUE)) / c(1, 1, 1, 255)
  sprintf(
    "%02X%02X%02X",
    color[1], color[2], color[3]
  )
}
colalpha <- function(x) {
  if ("transparent" %in% x) {
    return(0)
  }
  alpha <- as.vector(col2rgb(x, alpha = TRUE))[4] / 255
  alpha
}

is_transparent <- function(color) {
  !(colalpha(color) > 0)
}

solid_fill <- function(color) {
  sprintf(
    paste0(
      "<a:solidFill><a:srgbClr val=\"%s\">",
      "<a:alpha val=\"%.0f\"/>",
      "</a:srgbClr></a:solidFill>"
    ),
    hex_color(color),
    colalpha(color) * 100000
  )
}

solid_fill_pml <- function(bg) {
  bg_str <- ""
  if (!is.null(bg)) {
    bg_str <- solid_fill(bg)
  }
  bg_str
}

# geom ----

prst_geom_pml <- function(x) {
  geom_str <- ""
  if (!is.null(x)) {
    x <- check_set_geom(x)
    tagname <- paste0("a:prstGeom")
    geom_str <- sprintf("<%s prst=\"%s\"><a:avLst/></%s>", tagname, x, tagname)
  }
  geom_str
}

# line ----

ln_pml <- function(x) {
  ln_str <- ""
  if (!is.null(x)) {
    color_ <- ""
    if (is_transparent(x$color) || x$lwd < .001) {
      color_ <- "<a:noFill/>"
    } else {
      color_ <- solid_fill(x$color)
    }

    dash_ <- dash_pml(x$lty)
    join_ <- linejoin_pml(x$linejoin)
    head_ <- lineend_pml(x$headend, "head")
    tail_ <- lineend_pml(x$tailend, "tail")

    ln_str <- sprintf(
      paste0(
        "<a:ln w=\"%s\" cap=\"%s\" cmpd=\"%s\">",
        color_,
        dash_,
        join_,
        head_,
        tail_,
        "</a:ln>"
      ),
      12700 * x$lwd, x$lineend, x$linecmpd
    )
  }
  ln_str
}

lineend_pml <- function(x, side) {
  lineend_str <- ""
  if (!is.null(x)) {
    tagname <- paste0("a:", side, "End")
    lineend_str <- sprintf("<%s type=\"%s\" w=\"%s\" len=\"%s\"/>", tagname, x$type, x$width, x$length)
  }
  lineend_str
}

dash_pml <- function(x) {
  dash_str <- ""
  if (!is.null(x)) {
    dash_str <- sprintf("<a:prstDash val=\"%s\"/>", x)
  }
  dash_str
}

linejoin_pml <- function(x) {
  linejoin_str <- ""
  if (!is.null(x)) {
    linejoin_str <- sprintf("<a:%s/>", x)
  }
  linejoin_str
}

# border ----

border_pml <- function(x, side) {
  tagname <- paste0("a:ln", side)

  width_ <- sprintf("w=\"%.0f\"", x$width * 12700)

  if (is_transparent(x$color) || x$width < .001) {
    color_ <- "<a:noFill/>"
  } else {
    color_ <- solid_fill(x$color)
  }

  if (!x$style %in% c("dotted", "dashed", "solid")) {
    x$style <- "solid"
  }
  if ("dotted" %in% x$style) {
    x$style <- "sysDot"
  } else if ("dashed" %in% x$style) {
    x$style <- "sysDash"
  }

  style_ <- sprintf("<a:prstDash val=\"%s\"/>", x$style)

  paste0(
    "<", tagname,
    " ", "algn=\"ctr\" cmpd=\"sng\" cap=\"flat\"",
    " ", width_,
    ">", color_, style_,
    "</", tagname, ">"
  )
}


border_wml <- function(x, side) {
  tagname <- paste0("w:", side)
  x$style[x$style %in% "solid"] <- "single"
  x$style[x$style %in% "ridge"] <- "threeDEmboss"
  x$style[x$style %in% "groove"] <- "threeDEngrave"
  if (!x$style %in% border_styles) {
    x$style <- "single"
  }
  if (x$width < 0.0001 || is_transparent(x$color)) {
    x$style <- "none"
  }

  style_ <- sprintf("w:val=\"%s\"", x$style)
  width_ <- sprintf("w:sz=\"%.0f\"", x$width * 8)
  color_ <- sprintf("w:color=\"%s\"", hex_color(x$color))

  paste0(
    "<", tagname,
    " ", style_,
    " ", width_,
    " ", "w:space=\"0\"",
    " ", color_,
    "/>"
  )
}
border_css <- function(x, side) {
  color_ <- css_color(x$color)
  if (!(x$width > 0)) {
    color_ <- "transparent"
  }

  width_ <- sprintf("%.02fpt", x$width)

  x$style[x$style %in% "threeDEmboss"] <- "ridge"
  x$style[x$style %in% "threeDEngrave"] <- "groove"
  x$style[x$style %in% "nil"] <- "none"

  if (!x$style %in% c(
    "dotted", "dashed", "solid",
    "double", "inset", "outset",
    "ridge", "groove", "none"
  )) {
    x$style <- "solid"
  }
  paste0("border-", side, ": ", width_, " ", x$style, " ", color_, ";")
}

# ppr ----
ppr_pml <- function(x) {
  align <- " algn=\"r\""
  if (x$text.align == "left") {
    align <- " algn=\"l\""
  } else if (x$text.align == "center") {
    align <- " algn=\"ctr\""
  } else if (x$text.align == "justify") {
    align <- " algn=\"just\""
  }
  leftright_padding <- sprintf(" marL=\"%.0f\" marR=\"%.0f\"", x$padding.left * 12700, x$padding.right * 12700)
  top_padding <- sprintf("<a:spcBef><a:spcPts val=\"%.0f\" /></a:spcBef>", x$padding.top * 100)
  bottom_padding <- sprintf("<a:spcAft><a:spcPts val=\"%.0f\" /></a:spcAft>", x$padding.bottom * 100)

  line_spacing <- sprintf("<a:lnSpc><a:spcPct val=\"%.0f\"/></a:lnSpc>", x$line_spacing * 100000)

  paste0(
    "<a:pPr", align, leftright_padding, ">",
    line_spacing,
    top_padding, bottom_padding, "<a:buNone/>",
    "</a:pPr>"
  )
}

ppr_css <- function(x) {
  text.align <- sprintf("text-align:%s;", x$text.align)
  borders <- paste0(
    border_css(x$border.bottom, "bottom"),
    border_css(x$border.top, "top"),
    border_css(x$border.left, "left"),
    border_css(x$border.right, "right")
  )

  paddings <- sprintf(
    "padding-top:%.0fpt;padding-bottom:%.0fpt;padding-left:%.0fpt;padding-right:%.0fpt;",
    x$padding.top, x$padding.bottom, x$padding.left, x$padding.right
  )
  ls <- formatC(x$line_spacing, format = "f", digits = 2, decimal.mark = ".", drop0trailing = TRUE)
  line_spacing <- sprintf("line-height: %s;", ls)

  shading.color <- sprintf("background-color:%s;", css_color(x$shading.color))

  paste0(
    "margin:0pt;", text.align, borders, paddings, line_spacing,
    shading.color
  )
}

ppr_wml <- function(x) {
  if ("justify" %in% x$text.align) {
    x$text.align <- "both"
  }
  pstyle <- ""
  if (!is.null(x$word_style)) {
    word_style_id <- gsub("[^a-zA-Z0-9]", "", x$word_style)
    pstyle <- sprintf("<w:pStyle w:val=\"%s\"/>", word_style_id)
  }
  tabs <- ""
  if (!is.null(x$tabs)) {
    tabs <- to_wml(x$tabs)
  }
  text_align_ <- sprintf("<w:jc w:val=\"%s\"/>", x$text.align)
  keep_with_next <- ""
  if (x$keep_with_next) {
    keep_with_next <- "<w:keepNext/>"
  }
  borders_ <- paste0(
    "<w:pBdr>",
    border_wml(x$border.bottom, "bottom"),
    border_wml(x$border.top, "top"),
    border_wml(x$border.left, "left"),
    border_wml(x$border.right, "right"), "</w:pBdr>"
  )

  leftright_padding <- sprintf(
    "<w:ind w:left=\"%.0f\" w:right=\"%.0f\" w:firstLine=\"0\" w:firstLineChars=\"0\"/>",
    x$padding.left * 20, x$padding.right * 20
  )
  topbot_spacing <- sprintf(
    "<w:spacing w:after=\"%.0f\" w:before=\"%.0f\" w:line=\"%.0f\"/>",
    x$padding.bottom * 20, x$padding.top * 20, x$line_spacing * 240
  )
  shading_ <- ""
  if (!is_transparent(x$shading.color)) {
    shading_ <- sprintf(
      "<w:shd w:val=\"clear\" w:color=\"auto\" w:fill=\"%s\"/>",
      hex_color(x$shading.color)
    )
  }

  paste0(
    "<w:pPr>",
    pstyle,
    text_align_,
    keep_with_next,
    borders_,
    tabs,
    topbot_spacing,
    leftright_padding,
    shading_,
    "</w:pPr>"
  )
}


# rpr ----

rpr_pml <- function(x) {
  if (is_transparent(x$color)) {
    return("")
  }

  out <- "<a:rPr cap=\"none\""

  if (!is.na(x$font.size)) {
    if (x$font.size > 0) {
      out <- paste0(out, sprintf(" sz=\"%.0f\"", x$font.size * 100))
    }
  }

  if (!is.na(x$italic)) {
    if (x$italic) {
      out <- paste0(out, " i=\"1\"")
    } else {
      out <- paste0(out, " i=\"0\"")
    }
  }

  if (!is.na(x$bold)) {
    if (x$bold) {
      out <- paste0(out, " b=\"1\"")
    } else {
      out <- paste0(out, " b=\"0\"")
    }
  }

  if (!is.na(x$underlined)) {
    if (x$underlined) {
      out <- paste0(out, " u=\"sng\"")
    } else {
      out <- paste0(out, " u=\"none\"")
    }
  }

  if (x$vertical.align == "superscript") {
    out <- paste0(out, " baseline=\"40000\"")
  } else if (x$vertical.align == "subscript") {
    out <- paste0(out, " baseline=\"-40000\"")
  }
  out <- paste0(out, ">")

  if (!is.na(x$color)) {
    out <- paste0(out, solid_fill(x$color))

    if (!is_transparent(x$shading.color)) {
      shad <- sprintf(
        paste0(
          "<a:highlight><a:srgbClr val=\"%s\">",
          "<a:alpha val=\"%.0f\"/>",
          "</a:srgbClr></a:highlight>"
        ),
        hex_color(x$shading.color),
        colalpha(x$shading.color) * 100000
      )
      out <- paste0(out, shad)
    }
  }

  out <- paste0(
    out,
    if (!is.na(x$font.family)) sprintf("<a:latin typeface=\"%s\"/>", x$font.family),
    if (!is.na(x$cs.family)) sprintf("<a:cs typeface=\"%s\"/>", x$cs.family),
    if (!is.na(x$eastasia.family)) sprintf("<a:ea typeface=\"%s\"/>", x$eastasia.family),
    if (!is.na(x$hansi.family)) sprintf("<a:sym typeface=\"%s\"/>", x$hansi.family)
  )

  out <- paste0(out, "</a:rPr>")
  out
}

rpr_wml <- function(x) {
  out <- paste0(
    "<w:rPr><w:rFonts",
    if (!is.na(x$font.family)) paste0(" w:ascii=\"", x$font.family, "\""),
    if (!is.na(x$hansi.family)) paste0(" w:hAnsi=\"", x$hansi.family, "\""),
    if (!is.na(x$eastasia.family)) paste0(" w:eastAsia=\"", x$eastasia.family, "\""),
    if (!is.na(x$cs.family)) paste0(" w:cs=\"", x$cs.family, "\""),
    "/>"
  )

  if (!is.na(x$italic)) {
    if (x$italic) {
      out <- paste0(out, "<w:i w:val=\"true\"/>")
    } else {
      out <- paste0(out, "<w:i w:val=\"false\"/>")
    }
  }

  if (!is.na(x$bold)) {
    if (x$bold) {
      out <- paste0(out, "<w:b w:val=\"true\"/>")
    } else {
      out <- paste0(out, "<w:b w:val=\"false\"/>")
    }
  }
  if (!is.na(x$underlined)) {
    if (x$underlined) {
      out <- paste0(out, "<w:u w:val=\"single\"/>")
    } else {
      out <- paste0(out, "<w:u w:val=\"none\"/>")
    }
  }

  if (x$vertical.align == "superscript") {
    out <- paste0(out, "<w:vertAlign w:val=\"superscript\"/>")
  } else if (x$vertical.align == "subscript") {
    out <- paste0(out, "<w:vertAlign w:val=\"subscript\"/>")
  }

  if (!is.na(x$font.size)) {
    out <- paste0(
      out,
      sprintf(
        "<w:sz w:val=\"%.0f\"/><w:szCs w:val=\"%.0f\"/>",
        x$font.size * 2, x$font.size * 2
      )
    )
  }

  if (!is.na(x$color)) {
    out <- paste0(
      out,
      sprintf("<w:color w:val=\"%s\"/>", hex_color(x$color))
    )
  }

  if (!is.na(x$shading.color)) {
    if (is.na(x$color)) {
      stop("shading.color must be used **with** a color.")
    }
    if (!is_transparent(x$shading.color)) {
      out <- paste0(
        out,
        sprintf("<w:shd w:val=\"clear\" w:color=\"auto\" w:fill=\"%s\"/>", hex_color(x$shading.color))
      )
    }
    if (colalpha(x$color) < 1) {
      out <- paste0(
        out,
        sprintf(
          paste0(
            "<w14:textFill><w14:solidFill><w14:srgbClr val=\"%s\">",
            "<w14:alpha val=\"%.0f\"/>",
            "</w14:srgbClr></w14:solidFill></w14:textFill>"
          ),
          hex_color(x$color),
          colalpha(x$color) * 100000
        )
      )
    }
  }

  out <- paste0(out, "</w:rPr>")
  out
}

rpr_css <- function(x) {
  out <- ""

  if (!is.na(x$font.family)) out <- paste0(out, sprintf("font-family:'%s';", x$font.family))
  if (!is.na(x$color)) out <- paste0(out, sprintf("color:%s;", css_color(x$color)))
  if (!is.na(x$font.size)) out <- paste0(out, sprintf("font-size:%0.1fpt;", x$font.size))

  if (!is.na(x$italic)) {
    if (x$italic) {
      out <- paste0(out, "font-style:italic;")
    } else {
      out <- paste0(out, "font-style:normal;")
    }
  }

  if (!is.na(x$bold)) {
    if (x$bold) {
      out <- paste0(out, "font-weight:bold;")
    } else {
      out <- paste0(out, "font-weight:normal;")
    }
  }

  if (!is.na(x$bold)) {
    if (x$underlined) {
      out <- paste0(out, "text-decoration:underline;")
    } else {
      out <- paste0(out, "text-decoration:none;")
    }
  }

  if (!is.na(x$shading.color)) {
    if (!is_transparent(x$shading.color)) {
      out <- paste0(
        out,
        sprintf("background-color:%s;", css_color(x$shading.color))
      )
    } else {
      out <- paste0(out, "background-color:transparent;")
    }
  }

  if (x$vertical.align == "superscript") {
    out <- paste0(out, "vertical-align: super;")
  } else if (x$vertical.align == "subscript") {
    out <- paste0(out, "vertical-align: sub;")
  }


  out
}
# tcpr ----

tcpr_pml <- function(x) {
  text.direction <-
    if (x$text.direction %in% "btlr") {
      " vert=\"vert270\""
    } else if (x$text.direction %in% "tbrl") {
      " vert=\"vert\""
    } else {
      ""
    }

  vertical.align <-
    if (x$vertical.align %in% "center") {
      " anchor=\"ctr\""
    } else if (x$vertical.align %in% "top") {
      " anchor=\"t\""
    } else {
      " anchor=\"b\""
    }

  margins <- sprintf(
    " marB=\"%.0f\" marT=\"%.0f\" marR=\"%.0f\" marL=\"%.0f\"",
    x$margin.bottom * 12700, x$margin.top * 12700,
    x$margin.right * 12700, x$margin.left * 12700
  )

  background.color <- paste0(
    sprintf("<a:solidFill><a:srgbClr val=\"%s\">", hex_color(x$background.color)),
    sprintf("<a:alpha val=\"%.0f\"/>", colalpha(x$background.color) * 100000),
    "</a:srgbClr></a:solidFill>"
  )

  bb <- border_pml(x$border.bottom, side = "B")
  bt <- border_pml(x$border.top, side = "T")
  bl <- border_pml(x$border.left, side = "L")
  br <- border_pml(x$border.right, side = "R")

  pml_attrs <- paste0(text.direction, vertical.align, margins)
  paste0(
    "<a:tcPr", pml_attrs, ">", bl, br, bt, bb,
    background.color, "</a:tcPr>"
  )
}

tcpr_wml <- function(x) {
  background.color <- sprintf("<w:shd w:val=\"clear\" w:color=\"auto\" w:fill=\"%s\"/>", hex_color(x$background.color))
  vertical.align <- ifelse(x$vertical.align %in% c("center", "top"), sprintf("<w:vAlign w:val=\"%s\"/>", x$vertical.align), "<w:vAlign w:val=\"bottom\"/>")
  text.direction <- ifelse(
    x$text.direction %in% "btlr", "<w:textDirection w:val=\"btLr\"/>",
    ifelse(x$text.direction %in% "tbrl", "<w:textDirection w:val=\"tbRl\"/>", "")
  )

  bb <- border_wml(x$border.bottom, side = "bottom")
  bt <- border_wml(x$border.top, side = "top")
  bl <- border_wml(x$border.left, side = "left")
  br <- border_wml(x$border.right, side = "right")

  margin.bottom <- sprintf("<w:bottom w:w=\"%.0f\" w:type=\"dxa\"/>", x$margin.bottom * 20)
  margin.top <- sprintf("<w:top w:w=\"%.0f\" w:type=\"dxa\"/>", x$margin.top * 20)
  margin.left <- sprintf("<w:left w:w=\"%.0f\" w:type=\"dxa\"/>", x$margin.left * 20)
  margin.right <- sprintf("<w:right w:w=\"%.0f\" w:type=\"dxa\"/>", x$margin.right * 20)

  rowspan <- ""
  if (x$rowspan > 1) {
    rowspan <- paste0("<w:gridSpan w:val=\"", x$rowspan, "\"/>")
  }
  colspan <- ""
  if (x$colspan > 1) {
    colspan <- "<w:vMerge w:val=\"restart\"/>"
  } else if (x$colspan < 1) {
    colspan <- "<w:vMerge/>"
  }

  paste0(
    "<w:tcPr>", rowspan, colspan,
    "<w:tcBorders>", bb, bt, bl, br, "</w:tcBorders>",
    background.color,
    "<w:tcMar>", margin.top, margin.bottom, margin.left, margin.right, "</w:tcMar>",
    text.direction, vertical.align, "</w:tcPr>"
  )
}

css_px <- function(x, format = "%.0fpx") {
  ifelse(is.na(x), "inherit",
    ifelse(x < 0.001, "0", sprintf(format, x))
  )
}

tcpr_css <- function(x) {
  background.color <- ifelse(colalpha(x$background.color) > 0,
    sprintf("background-clip: padding-box;background-color:%s;", css_color(x$background.color)),
    "background-color:transparent;"
  )

  width <- ifelse(is.null(x$width) || is.na(x$width), "", sprintf("width:%s;", css_px(x$width * 72)))
  height <- ifelse(is.null(x$height) || is.na(x$height), "", sprintf("height:%s;", css_px(x$height * 72)))
  vertical.align <- ifelse(
    x$vertical.align %in% "center", "vertical-align:middle;",
    ifelse(x$vertical.align %in% "top", "vertical-align:top;", "vertical-align:bottom;")
  )

  bb <- border_css(x$border.bottom, side = "bottom")
  bt <- border_css(x$border.top, side = "top")
  bl <- border_css(x$border.left, side = "left")
  br <- border_css(x$border.right, side = "right")

  margin.bottom <- sprintf("margin-bottom:%s;", sprintf("%.0fpt", x$margin.bottom))
  margin.top <- sprintf("margin-top:%s;", sprintf("%.0fpt", x$margin.top))
  margin.left <- sprintf("margin-left:%s;", sprintf("%.0fpt", x$margin.left))
  margin.right <- sprintf("margin-right:%s;", sprintf("%.0fpt", x$margin.right))

  paste0(
    width, height, background.color, vertical.align, bb, bt, bl, br,
    margin.bottom, margin.top, margin.left, margin.right
  )
}

Try the officer package in your browser

Any scripts or data that you put into this service are public.

officer documentation built on Oct. 10, 2024, 1:06 a.m.