如何解决使用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>
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。