时间戳

首页 > 解决方案 > 使用 R 的官员包将图标添加到依赖于列值的 powerpoint 项目符号

r - 使用 R 的官员包将图标添加到依赖于列值的 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", "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 个图像的框架，那将非常有帮助。此外，由于某种原因，官员添加了很多我无法删除的空格，即使使用 trimws()。如果你不能让它消失，那么不用担心在此处输入图像描述

编辑：

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

在此处输入图像描述

标签： ralignmentr-markdownpowerpointofficer

解决方案

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

在此处输入图像描述

推荐阅读