使用R's Officer包向依赖于列值的powerpoint项目符号添加图标

问题描述

我正在尝试自动执行PowerPoint报告。在此报告中，我将提供一个值列表，然后是一个二分指标（好与坏）。生成报告时，我希望每个值在状态为“良好”时都表示高兴，而在状态为“不良”时则皱着眉头，并与各自的文本对齐（请参见下图）。

但是，我不知道如何告诉R如何做到这一点。我尝试使数据框具有图像列，但无法使其正常工作。现在，我尝试使用官页面直接将png导入到幻灯片中，但是我不确定如何使它们与我的文本对齐。

我已经提供了一张我想要幻灯片外观的图像。下面的代码重现了所有内容，除了将图像添加到绘图中。

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","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")

注意：我是使用readPNG包的新手，所以我不知道如何使我的可复制示例包括2个PNG文件。如果您可以在线使用其他文件，或者仅提供有关如何将其用于2张图像的框架，那将非常有帮助。另外，由于某种原因，即使使用trimws（），高级管理人员也会添加很多我无法删除的空格。如果无法解决，那就不用担心

编辑：

这是我要使用的图标之一：

解决方法

自定义功能AddTextWithImage使用ph_location相对于其关联文本放置一个图标。

lapply创建此类功能的列表，将mock_data每行的顶部位置向下移，并根据status选择图标。

最后，使用freduce缩小了此列表，该列表将列表中的每个功能应用于幻灯片：

    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","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,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>