Search code examples
ralignmentr-markdownpowerpointofficer

add icons to powerpoint bullets that are dependent upon a column's value using R's officer package

I'm trying to automate a PowerPoint report. In this report, I'll have a list of values and then a dichotomous indicator (good vs bad). When the report is generated, I want each value to have a happy face when the status is "good" and a frowning face when the status is "bad" and to be aligned with their respective text (see below image).

However, I can't figure out how to tell R how to do this. I tried making the data frame have an image column, but I couldn't get that to work. Now, I'm trying to just import the pngs directly into my slides using the officer page, but I'm not sure how to get them to line up with my text.

I've included an image of what I want the slide to look like. The code below reproduces everything except for adding the images to the plot.


library(png)
library(officer)
library(tidyverse)

#These line breaks are important for the spacing on the slide; please do not remove
mock_data <- tibble(status = c("Bad R Day", "Bad R Day", "Good R Day", "Bad R Day", "Good R Day"),
                    my_feelings = c("Ughh \n \n", "Why R?? \n \n", "R, you can do it all! \n \n", "Not again.. \n \n", "EUREKA! \n \n"))

#I don't know how to use readPNG to get web files, so I only have this one to show for this example.
img <- readPNG(system.file("img", "Rlogo.png", package="png"))

#Make an empty slide
slide <- read_pptx()
slide <- add_slide(slide, layout = "Title and Content", master = "Office Theme")

#Add in text properties and create specific text for slide
text_properties <- fp_text(color = "black", font.size = 14, font.family = "Arial")
text_content <- ftext(mock_data$my_feelings, text_properties)

#Make slide that has text in correct position
new_slide <- mock_data %>%
  ph_with(x = slide, value = fpar(text_content),
          location = ph_location(left = 6.45, top = 2.45))

#Print slide; adjust file path
print(new_slide, target = "your/filepath/here.pptx")

Note: I'm new to using the readPNG package, so I don't know how to make my reproducible example include 2 PNG files. If you can use another either from online or that just has the framework on how I would adapt it for 2 images, that would be really helpful. Also, for some reason, officer adds in a lot of whitespace that I cannot remove, even with trimws(). If you can't get that gone, then no worriesenter image description here

EDIT:

This is one of the icons I'm trying to use:

enter image description here

Solution

  • The custom function AddTextWithImage positions one icon relatively to its associated text using ph_location.

    lapply creates a list of such functions, shifting down the top position for each row of mock_data, and chosing the icon according to status.

    Finally this list is reduced using freduce which applies each function in the list to the slide:

        library(png)
    library(officer)
    library(tidyverse)

    #These line breaks are important for the spacing on the slide; please do not remove
    mock_data <- tibble(status = c("Bad R Day", "Bad R Day", "Good R Day", "Bad R Day", "Good R Day"),
                        my_feelings = c("Ughh \n \n", "Why R?? \n \n", "R, you can do it all! \n \n", "Not again.. \n \n", "EUREKA! \n \n"))

    #Make an empty slide
    slide <- read_pptx()
    slide <- add_slide(slide, layout = "Title and Content", master = "Office Theme")
    img.logo <- file.path( R.home("doc"), "html", "logo.jpg" )

    download.file("https://openmoji.org/php/download_from_github.php?emoji_hexcode=1F61E&emoji_variant=color","smiley.png",mode="wb")
    smiley <- "smiley.png"

    # Draw icon and associated text
    AddTextWithImage <- function(slide,
                                 position_left,
                                 position_top,
                                 text,
                                 img,
                                 tabwidth=0.5, # distance between icon and text
                                 textcolor = "black",
                                 font.size=14,
                                 font.family="Arial",
                                 height=0.3 # height of each row
                                 ) {
      text_properties <- fp_text(color = textcolor, font.size = font.size, font.family = font.family)
      text_content = ftext(text,text_properties)
      slide <- ph_with(slide,value = fpar(text_content), location = ph_location(left = position_left + tabwidth, top = position_top,height=height))
      ph_with(x = slide, external_img(img, width = height, height = height),
              location = ph_location(left = position_left, top = position_top,width =height,height=height), use_loc_size = FALSE )
    }

    height <- 0.3
    position_left <- 3
    position_top <- 1

    # Create a list of functions (one for each row of mock_data)
    l <- lapply(seq_len(nrow(mock_data)),function(l) {
      function(slide) {AddTextWithImage(slide,
                                        text = trimws(mock_data$my_feelings[l],'right'),
                                        img = ifelse(mock_data$status[l]=='Good R Day',img.logo,smiley),
                                        position_left = position_left,
                                        position_top = position_top + l * height,
                                        height = height)} }
      )

    # Apply the list of functions to the slide
    slide <- magrittr::freduce(slide,l)

    print(slide, target = "here.pptx")

<sup>Created on 2020-08-16 by the [reprex package](https://reprex.tidyverse.org) (v0.3.0)</sup>

    enter image description here