R/ppt.R
In andrie/braidppt: An extension of braid to deal with PowerPoint output
# Functions to create PowerPoint slides, based on package R2PPT
#
# Author: Andrie
#----------------------------------------------------------------------------------
#' Tests whether R architecture is 32-bit Windows.
#'
#' rcom is only available on 32-bit windows.
#' @return TRUE if architecture is \code{i386} else FALSE
#' @param ppt A pointer to a ppt object
#' @param method Character string indicating connection method to COM. Currently supported options are "rcom" and "RDCOMClient"
#' @keywords Internal
#' @examples
#' isCOMsupported(method="rcom")
#' isCOMsupported(method="RDCOMClient")
#' @export
isCOMsupported <- function(ppt=NULL, method=ppt$method){
supported <- ""
supported <- switch(method,
RDCOMClient = c("i386", "x64"),
rcom = "i386"
)
.Platform$r_arch %in% supported
}
stopIfNoCOM <- function(ppt, method=ppt$method){
if(!isCOMsupported(ppt, method)) stop("The connection to COM is only available on 32-bit windows")
}
#' Guess where template file is found in user path.
#'
#' If \code{file} is a valid file, then does nothing. Otherwise attempts to find the file in the Microsoft template folder - typically somehting like \code{C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Templates\\}
#' @param file Character string: file name (with or without full path)
#' @param path Character string: path
#' @keywords internal
#' @export
msTemplatePath <- function(file, path=NULL){
if(file.exists(file)) return(normalizePath(file))
if(!is.null(path)) file <- file.path(path, file)
if(file.exists(file)) return(normalizePath(file))
if(is.null(path)) file <- basename(file)
file <- file.path(Sys.getenv("HOMEPATH"), "AppData", "Roaming", "Microsoft", "Templates", file)
if(file.exists(file)) return(normalizePath(file))
message("Unable to locate template file")
return(NULL)
}
#' Determines indentation level of text, based on tab characters (\\t) at start of line.
#'
#' Splits the input text at paragraph boundaries (determined by \\t or \\n), counts the number of leading tabs in each paragraph, removes the tab stops, and returns text with \\r as collapsed string.
#'
#' @param text Character string, with paragraph breaks indicated by \\r or \\n
#' @param sep Character Separator to indicated paragraph breaks. Defaults to \\r, the PowerPoint standard
#' @return a list consisting of two elements: text and levels
#' @keywords internal
tabIndentLevels <- function(text, sep="\r"){
text <- strsplit(text, "[\n\r]")[[1]]
levels <- sapply(
text,
function(zz)which(strsplit(zz[1], "")[[1]] != "\t")[1],
USE.NAMES=FALSE)
list(
text = paste(substring(text, levels), collapse=sep),
levels = levels
)
}
#' Create new PowerPoint presentation and applies template.
#'
#' @param template Character string: File location and template name. If not a full file path, searches for the file in the default path for Microsoft templates. See \code{\link{msTemplatePath}} for details
#' @inheritParams isCOMsupported
#' @param ... passed to \code{\link[R2PPT]{PPT.Init}}
#' @return A pointer to a ppt object
#' @examples
#' if(isCOMsupported(method="RDCOMClient")){
#' library("RDCOMClient")
#' ppt <- pptNew()
#' }
#' @family PowerPoint
#' @export
pptNew <- function(template=NULL, method=c("RDCOMClient", "rcom"), ...){
method <- match.arg(method)
switch(method,
RDCOMClient = stopifnot(require(RDCOMClient)),
com = stopifnot(require(rcom))
)
if(!is.null(template)) template <- msTemplatePath(template)
stopIfNoCOM(method=method)
ppt <- suppressWarnings(PPT.Init(method=method, ...))
if(!is.null(template)) ppt <- PPT.ApplyTemplate(ppt, file=template)
return(invisible(ppt))
}
#' Opens existing PowerPoint presentations.
#'
#' @inheritParams pptNew
#' @inheritParams isCOMsupported
#' @param file Character string: Name of a file
#' @return A pointer to a ppt object
#' @family PowerPoint
#' @export
pptOpen <- function(file, method=c("RDCOMClient", "rcom")){
method <- match.arg(method)
switch(method,
RDCOMClient = stopifnot(require(RDCOMClient)),
com = stopifnot(require(rcom))
)
if(!file.exists(file)) stop("In pptOpen file does not exist")
ppt <- PPT.Open(file=file, method=method)
return(invisible(ppt))
}
#' Saves PowerPoint presentation.
#'
#' @param ppt Pointer to ppt object, generated by \code{\link{pptNew}}
#' @param file Name of file
#' @family PowerPoint
#' @export
pptSave <- function(ppt, file){
stopIfNoCOM(ppt)
PPT.SaveAs(ppt, file)
}
#' Closes open PowerPoint presentation.
#'
#' @inheritParams pptSave
#' @family PowerPoint
#' @export
pptClose <- function(ppt){
stopIfNoCOM(ppt)
PPT.Close(ppt)
}
#------------------------------------------------------------------------------
#' Adds new slide to existing PowerPoint object and adds text and plot.
#'
#' @param ppt Pointer to ppt object, generated by \code{\link{pptNew}}
#' @param title Slide title
#' @param text Slide text
#' @param subtitle Slide subtitle - only added to Title slide
#' @return A pointer to a ppt object
#' @inheritParams pptInsertImage
#' @family PowerPoint
#' @examples
#' if(isCOMsupported(method="RDCOMClient")){
#' ppt <- pptNew()
#' ppt <- pptNewSlide(ppt) # This should be blank
#' ppt <- pptNewSlide(ppt, "Title", subtitle="Subtitle")
#' ppt <- pptNewSlide(ppt, "Title only")
#' ppt <- pptNewSlide(ppt, "Title with text", "Level1\n\tLevel 2 item 1\n\tLevel 2 item 2\n\t\tLevel 3\nBack to level 1")
#' rm(ppt)
#' }
#' @export
pptNewSlide <- function(ppt, title=NULL, text=NULL, subtitle=NULL, file=NULL,
size=c(0.1, 0.1, 0.9, 0.9)){
stopIfNoCOM(ppt)
sldBlank <- sldTitle <- sldTitleOnly <- sldText <- FALSE
if( missing(title) & missing(subtitle) & missing(text)) sldBlank <- TRUE
if(!missing(title) & !missing(subtitle) & missing(text)) sldTitle <- TRUE
if(!missing(title) & missing(subtitle) & missing(text)) sldTitleOnly <- TRUE
if(!missing(title) & missing(subtitle) & !missing(text)) sldText <- TRUE
if(sldBlank){
ppt <- PPT.AddBlankSlide(ppt)
} else {
if(sldTitle){
ppt <- PPT.AddTitleSlide(ppt, title=title, subtitle=subtitle)
} else {
if(sldTitleOnly){
ppt <- PPT.AddTextSlide(ppt, title=title)
} else {
if(sldText){
# Creates text slide, then modify indent levels
tl <- tabIndentLevels(text)
ppt <- PPT.AddTextSlide(ppt, title=title, text=tl$text)
for (i in seq_along(tl$levels)){
tmp <- ppt$Current.Slide[["Shapes"]]$Item(2)[["TextFrame"]][["TextRange"]]$Paragraphs(i)
tmp[["IndentLevel"]] <- as.numeric(tl$levels[i])
}
}
}
}
}
if(!missing(file))
ppt <- pptInsertImage(ppt, file=file)
# ppt <- PPT.AddGraphicstoSlide(ppt, file=plot,
# size=(size-c(0, 0, size[1:2]))*c(720, 540, 720, 540))
return(invisible(ppt))
}
#------------------------------------------------------------------------------
#pthPlot <- "F:/My Dropbox/PentaLibra/Clients/Wolfson/CSC/R/11H1/Report/_Topline/graphics"
#filePlt <- "company_language.wmf"
#
#plotIs <- function(file, path=pthPlot){
# file.path(path, file)
#}
#------------------------------------------------------------------------------
#' Add picture (image file) to slide.
#'
#' The default position is in the middle of the slide, at the size of the original image.
#' @param ppt A ppt object, see \code{\link{pptNew}}
#' @param file Location and file name of a plot
#' @param size A numeric vector of size 4, indicating c(x1, y1, x2, y2) expressed as percentage of page size
#' @family PowerPoint
## #' @examples
## #' if(isRcomSupported()){
## #' ppt <- newSlide(ppt, "Slide with graphic", "This is really interesting",
## #' plot=plotIs("company_language.wmf"), size=c(0.5, 0.25, 1, 0.75))
## #' }
#' @export
pptInsertImage <- function (ppt, file = NULL, size=c(0.1, 0.1, 0.9, 0.9))
{
stopIfNoCOM(ppt)
msoTRUE <- -1
msoFALSE <- 0
if (ppt$method == "rcom") {
if (!comIsValidHandle(ppt$ppt))
stop("Invalid handle for powerpoint application")
if (!comIsValidHandle(ppt$pres))
stop("Invalid handle for powerpoint presentation")
if (!comIsValidHandle(ppt$Current.Slide))
stop("Invalid handle for presentation slide. Make sure you add a slide before adding graphic.")
}
if (length(size) != 4)
stop("Graphic size to export to PowerPoint must be a vector of length 4")
#imgFile <- file.path(path, basename(file[1]))
imgFile <- file[1]
if(is.null(imgFile)) return(invisible(ppt))
#browser()
imgFile <- path.expand(imgFile)
imgFile <- normalizePath(imgFile, mustWork=FALSE)
#imgFile <- gsub("/", "\\\\", as.character(imgFile))
#imgFile <- PPT.getAbsolutePath(imgFile)
if(!file.exists(imgFile)) stop(paste(imgFile, "does not exist"))
if (file.exists(imgFile)) {
#imgFile <- gsub("/", "\\\\", as.character(imgFile))
#imgFile <- normalizePath(imgFile, mustWork=FALSE)
shp <- ppt$Current.Slide[["Shapes"]]
# Insert picture at arbitrary location
pct <- shp$AddPicture(imgFile, msoFALSE, msoTRUE, 1, 1, 1, 1)
# Scale picture to 100% of its own relative size
pct$ScaleHeight(1, msoTRUE)
pct$ScaleWidth(1, msoTRUE)
# Position picture in centre of slide
ps <- ppt$pres[["PageSetup"]]
pct[["Left"]] <- (ps[["SlideWidth"]] %/% 2) - (pct[["Width"]] %/% 2)
pct[["Top"]] <- (ps[["SlideHeight"]] %/% 2) - (pct[["Height"]] %/% 2)
}
return(invisible(ppt))
}
#' Insert textbox on current slide.
#'
#' @inheritParams pptNewSlide
#' @param position Numeric vector of length 4 indicating c(top, left, width, height)
#' @param fontControl List of Properties and values that controls the font. Passed to \code{ppt.Current.Slide.Shapes.Item(n).TextFrame.Tex}
#' @param paraControl List of Properties and values that controls ParagraphFormat. The alignment property takes integer values (e.g. 1=left, 2=centre, 3=right).
pptInsertTextbox <- function(
ppt,
text,
position=c(100, 100, 150, 50),
fontControl=list(Color=1, Bold=FALSE, Italic=FALSE, Underline=FALSE),
paraControl = list(Alignment=2)
){
p <- position
tb <- ppt$Current.Slide[["Shapes"]]$AddTextbox(1, p[1], p[2], p[3], p[4])
#tb <- ppt$Current.Slide[["Shapes"]]$Item(1)[["TextFrame"]][["TextRange"]]
#browser()
tb <- tb[["TextFrame"]][["TextRange"]]
tb[["Text"]] <- text
font <- tb[["Font"]]
# browser()
for(i in seq_along(fontControl)){
res <- tryCatch(
font[[names(fontControl[i])]] <- unname(fontControl[[i]]),
error = function(e) e
)
if(inherits(res, "error")){
msg <- paste("Unable to set property", names(fontControl[i]), "of Font")
warning(msg)
}
}
par <- tb[["ParagraphFormat"]]
for(i in seq_along(paraControl)){
tryCatch(
par[[names(paraControl[i])]] <- unname(paraControl[[i]]),
error = function(e) e
)
if(inherits(res, "error")){
msg <- paste("Unable to set property", names(fontControl[i]), "of ParagraphFormat")
warning(msg)
}
}
tb
}
andrie/braidppt documentation built on May 10, 2019, 11:18 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Functions to create PowerPoint slides, based on package R2PPT
#
# Author: Andrie
#----------------------------------------------------------------------------------
#' Tests whether R architecture is 32-bit Windows.
#'
#' rcom is only available on 32-bit windows.
#' @return TRUE if architecture is \code{i386} else FALSE
#' @param ppt A pointer to a ppt object
#' @param method Character string indicating connection method to COM. Currently supported options are "rcom" and "RDCOMClient"
#' @keywords Internal
#' @examples
#' isCOMsupported(method="rcom")
#' isCOMsupported(method="RDCOMClient")
#' @export
isCOMsupported <- function(ppt=NULL, method=ppt$method){
supported <- ""
supported <- switch(method,
RDCOMClient = c("i386", "x64"),
rcom = "i386"
)
.Platform$r_arch %in% supported
}
stopIfNoCOM <- function(ppt, method=ppt$method){
if(!isCOMsupported(ppt, method)) stop("The connection to COM is only available on 32-bit windows")
}
#' Guess where template file is found in user path.
#'
#' If \code{file} is a valid file, then does nothing. Otherwise attempts to find the file in the Microsoft template folder - typically somehting like \code{C:\\Users\\...\\AppData\\Roaming\\Microsoft\\Templates\\}
#' @param file Character string: file name (with or without full path)
#' @param path Character string: path
#' @keywords internal
#' @export
msTemplatePath <- function(file, path=NULL){
if(file.exists(file)) return(normalizePath(file))
if(!is.null(path)) file <- file.path(path, file)
if(file.exists(file)) return(normalizePath(file))
if(is.null(path)) file <- basename(file)
file <- file.path(Sys.getenv("HOMEPATH"), "AppData", "Roaming", "Microsoft", "Templates", file)
if(file.exists(file)) return(normalizePath(file))
message("Unable to locate template file")
return(NULL)
}
#' Determines indentation level of text, based on tab characters (\\t) at start of line.
#'
#' Splits the input text at paragraph boundaries (determined by \\t or \\n), counts the number of leading tabs in each paragraph, removes the tab stops, and returns text with \\r as collapsed string.
#'
#' @param text Character string, with paragraph breaks indicated by \\r or \\n
#' @param sep Character Separator to indicated paragraph breaks. Defaults to \\r, the PowerPoint standard
#' @return a list consisting of two elements: text and levels
#' @keywords internal
tabIndentLevels <- function(text, sep="\r"){
text <- strsplit(text, "[\n\r]")[[1]]
levels <- sapply(
text,
function(zz)which(strsplit(zz[1], "")[[1]] != "\t")[1],
USE.NAMES=FALSE)
list(
text = paste(substring(text, levels), collapse=sep),
levels = levels
)
}
#' Create new PowerPoint presentation and applies template.
#'
#' @param template Character string: File location and template name. If not a full file path, searches for the file in the default path for Microsoft templates. See \code{\link{msTemplatePath}} for details
#' @inheritParams isCOMsupported
#' @param ... passed to \code{\link[R2PPT]{PPT.Init}}
#' @return A pointer to a ppt object
#' @examples
#' if(isCOMsupported(method="RDCOMClient")){
#' library("RDCOMClient")
#' ppt <- pptNew()
#' }
#' @family PowerPoint
#' @export
pptNew <- function(template=NULL, method=c("RDCOMClient", "rcom"), ...){
method <- match.arg(method)
switch(method,
RDCOMClient = stopifnot(require(RDCOMClient)),
com = stopifnot(require(rcom))
)
if(!is.null(template)) template <- msTemplatePath(template)
stopIfNoCOM(method=method)
ppt <- suppressWarnings(PPT.Init(method=method, ...))
if(!is.null(template)) ppt <- PPT.ApplyTemplate(ppt, file=template)
return(invisible(ppt))
}
#' Opens existing PowerPoint presentations.
#'
#' @inheritParams pptNew
#' @inheritParams isCOMsupported
#' @param file Character string: Name of a file
#' @return A pointer to a ppt object
#' @family PowerPoint
#' @export
pptOpen <- function(file, method=c("RDCOMClient", "rcom")){
method <- match.arg(method)
switch(method,
RDCOMClient = stopifnot(require(RDCOMClient)),
com = stopifnot(require(rcom))
)
if(!file.exists(file)) stop("In pptOpen file does not exist")
ppt <- PPT.Open(file=file, method=method)
return(invisible(ppt))
}
#' Saves PowerPoint presentation.
#'
#' @param ppt Pointer to ppt object, generated by \code{\link{pptNew}}
#' @param file Name of file
#' @family PowerPoint
#' @export
pptSave <- function(ppt, file){
stopIfNoCOM(ppt)
PPT.SaveAs(ppt, file)
}
#' Closes open PowerPoint presentation.
#'
#' @inheritParams pptSave
#' @family PowerPoint
#' @export
pptClose <- function(ppt){
stopIfNoCOM(ppt)
PPT.Close(ppt)
}
#------------------------------------------------------------------------------
#' Adds new slide to existing PowerPoint object and adds text and plot.
#'
#' @param ppt Pointer to ppt object, generated by \code{\link{pptNew}}
#' @param title Slide title
#' @param text Slide text
#' @param subtitle Slide subtitle - only added to Title slide
#' @return A pointer to a ppt object
#' @inheritParams pptInsertImage
#' @family PowerPoint
#' @examples
#' if(isCOMsupported(method="RDCOMClient")){
#' ppt <- pptNew()
#' ppt <- pptNewSlide(ppt) # This should be blank
#' ppt <- pptNewSlide(ppt, "Title", subtitle="Subtitle")
#' ppt <- pptNewSlide(ppt, "Title only")
#' ppt <- pptNewSlide(ppt, "Title with text", "Level1\n\tLevel 2 item 1\n\tLevel 2 item 2\n\t\tLevel 3\nBack to level 1")
#' rm(ppt)
#' }
#' @export
pptNewSlide <- function(ppt, title=NULL, text=NULL, subtitle=NULL, file=NULL,
size=c(0.1, 0.1, 0.9, 0.9)){
stopIfNoCOM(ppt)
sldBlank <- sldTitle <- sldTitleOnly <- sldText <- FALSE
if( missing(title) & missing(subtitle) & missing(text)) sldBlank <- TRUE
if(!missing(title) & !missing(subtitle) & missing(text)) sldTitle <- TRUE
if(!missing(title) & missing(subtitle) & missing(text)) sldTitleOnly <- TRUE
if(!missing(title) & missing(subtitle) & !missing(text)) sldText <- TRUE
if(sldBlank){
ppt <- PPT.AddBlankSlide(ppt)
} else {
if(sldTitle){
ppt <- PPT.AddTitleSlide(ppt, title=title, subtitle=subtitle)
} else {
if(sldTitleOnly){
ppt <- PPT.AddTextSlide(ppt, title=title)
} else {
if(sldText){
# Creates text slide, then modify indent levels
tl <- tabIndentLevels(text)
ppt <- PPT.AddTextSlide(ppt, title=title, text=tl$text)
for (i in seq_along(tl$levels)){
tmp <- ppt$Current.Slide[["Shapes"]]$Item(2)[["TextFrame"]][["TextRange"]]$Paragraphs(i)
tmp[["IndentLevel"]] <- as.numeric(tl$levels[i])
}
}
}
}
}
if(!missing(file))
ppt <- pptInsertImage(ppt, file=file)
# ppt <- PPT.AddGraphicstoSlide(ppt, file=plot,
# size=(size-c(0, 0, size[1:2]))*c(720, 540, 720, 540))
return(invisible(ppt))
}
#------------------------------------------------------------------------------
#pthPlot <- "F:/My Dropbox/PentaLibra/Clients/Wolfson/CSC/R/11H1/Report/_Topline/graphics"
#filePlt <- "company_language.wmf"
#
#plotIs <- function(file, path=pthPlot){
# file.path(path, file)
#}
#------------------------------------------------------------------------------
#' Add picture (image file) to slide.
#'
#' The default position is in the middle of the slide, at the size of the original image.
#' @param ppt A ppt object, see \code{\link{pptNew}}
#' @param file Location and file name of a plot
#' @param size A numeric vector of size 4, indicating c(x1, y1, x2, y2) expressed as percentage of page size
#' @family PowerPoint
## #' @examples
## #' if(isRcomSupported()){
## #' ppt <- newSlide(ppt, "Slide with graphic", "This is really interesting",
## #' plot=plotIs("company_language.wmf"), size=c(0.5, 0.25, 1, 0.75))
## #' }
#' @export
pptInsertImage <- function (ppt, file = NULL, size=c(0.1, 0.1, 0.9, 0.9))
{
stopIfNoCOM(ppt)
msoTRUE <- -1
msoFALSE <- 0
if (ppt$method == "rcom") {
if (!comIsValidHandle(ppt$ppt))
stop("Invalid handle for powerpoint application")
if (!comIsValidHandle(ppt$pres))
stop("Invalid handle for powerpoint presentation")
if (!comIsValidHandle(ppt$Current.Slide))
stop("Invalid handle for presentation slide. Make sure you add a slide before adding graphic.")
}
if (length(size) != 4)
stop("Graphic size to export to PowerPoint must be a vector of length 4")
#imgFile <- file.path(path, basename(file[1]))
imgFile <- file[1]
if(is.null(imgFile)) return(invisible(ppt))
#browser()
imgFile <- path.expand(imgFile)
imgFile <- normalizePath(imgFile, mustWork=FALSE)
#imgFile <- gsub("/", "\\\\", as.character(imgFile))
#imgFile <- PPT.getAbsolutePath(imgFile)
if(!file.exists(imgFile)) stop(paste(imgFile, "does not exist"))
if (file.exists(imgFile)) {
#imgFile <- gsub("/", "\\\\", as.character(imgFile))
#imgFile <- normalizePath(imgFile, mustWork=FALSE)
shp <- ppt$Current.Slide[["Shapes"]]
# Insert picture at arbitrary location
pct <- shp$AddPicture(imgFile, msoFALSE, msoTRUE, 1, 1, 1, 1)
# Scale picture to 100% of its own relative size
pct$ScaleHeight(1, msoTRUE)
pct$ScaleWidth(1, msoTRUE)
# Position picture in centre of slide
ps <- ppt$pres[["PageSetup"]]
pct[["Left"]] <- (ps[["SlideWidth"]] %/% 2) - (pct[["Width"]] %/% 2)
pct[["Top"]] <- (ps[["SlideHeight"]] %/% 2) - (pct[["Height"]] %/% 2)
}
return(invisible(ppt))
}
#' Insert textbox on current slide.
#'
#' @inheritParams pptNewSlide
#' @param position Numeric vector of length 4 indicating c(top, left, width, height)
#' @param fontControl List of Properties and values that controls the font. Passed to \code{ppt.Current.Slide.Shapes.Item(n).TextFrame.Tex}
#' @param paraControl List of Properties and values that controls ParagraphFormat. The alignment property takes integer values (e.g. 1=left, 2=centre, 3=right).
pptInsertTextbox <- function(
ppt,
text,
position=c(100, 100, 150, 50),
fontControl=list(Color=1, Bold=FALSE, Italic=FALSE, Underline=FALSE),
paraControl = list(Alignment=2)
){
p <- position
tb <- ppt$Current.Slide[["Shapes"]]$AddTextbox(1, p[1], p[2], p[3], p[4])
#tb <- ppt$Current.Slide[["Shapes"]]$Item(1)[["TextFrame"]][["TextRange"]]
#browser()
tb <- tb[["TextFrame"]][["TextRange"]]
tb[["Text"]] <- text
font <- tb[["Font"]]
# browser()
for(i in seq_along(fontControl)){
res <- tryCatch(
font[[names(fontControl[i])]] <- unname(fontControl[[i]]),
error = function(e) e
)
if(inherits(res, "error")){
msg <- paste("Unable to set property", names(fontControl[i]), "of Font")
warning(msg)
}
}
par <- tb[["ParagraphFormat"]]
for(i in seq_along(paraControl)){
tryCatch(
par[[names(paraControl[i])]] <- unname(paraControl[[i]]),
error = function(e) e
)
if(inherits(res, "error")){
msg <- paste("Unable to set property", names(fontControl[i]), "of ParagraphFormat")
warning(msg)
}
}
tb
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.