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

Question

我正在尝试使 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", "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")

注意：我刚开始使用 readPNG 包，所以我不知道如何让我的可重现示例包含 2 个 PNG 文件。如果您可以从网上使用另一个，或者只有关于我如何将其调整为 2 个图像的框架，那将非常有帮助。此外，出于某种原因，officer 添加了很多我无法删除的空格，即使使用 trimws() 也是如此。如果你不能把它拿走，那就不用担心

编辑：

这是我尝试使用的图标之一：

Answer 1

自定义函数 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", "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>

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

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

powerpoint

r

alignment

r-markdown

officer