用R代码自动批量生成PPT

时间:2022-07-24
本文章向大家介绍用R代码自动批量生成PPT,主要内容包括其使用实例、应用技巧、基本知识点总结和需要注意事项,具有一定的参考价值,需要的朋友可以参考一下。

[1]第一步加载包

  #*~*#数据处理包#*~*#
  library(ggplot2) #作图包
  library(dplyr) #数据转换包
  library(tidyr) #数据转换包
  library(jpeg)#加载图片
  library(scales)
  library(plyr)
  library(tibble)
  library(gridExtra)
  library(splines2) #数据差值包
  library(reshape2)#数据重塑包
  library(stringr)#字符串工具集
  library(showtext)#作图使用中文包
  library(xlsx)#excel处理
  #*~*#制作ppt包#*~*#
  library(ReporteRs)
  library(R2PPT)
  library(ggplot2)

[2]第二步数据处理、绘制要放进PPT的图形

2.1数据读取

 a1<-read.csv(Rdata)  #由于有些数据比较敏感,所以只展示读取方法

2.2绘图

  #*~*#全自动画折线图 #*~*#
  line_chart<-function(shuju,F)
  {
    test1<-shuju
    test1<-test1[F]
    N=ncol(test1)
    for (i in 2:N)
    {
      test1[,i]<-round(test1[,i], 3)
      test1[,i]<-round(test1[,i], 3)
    }
    name<-names(test1)
    xname<-name[1]
    test1[,1]<-factor(test1[,1])
    test1<-melt(test1, id = xname)
    p<-ggplot(test1, aes(x =test1[,1], y =value,colour=                      variable,group=variable)) 
    p<-p+geom_line(size=1)
    p<-p+geom_point(size=1.5)
    p<-p+labs(x="" ,y="",title="")
    p<-p+geom_text(aes(label=paste(test1$value*100,'%',sep = ''),            fill=variable),vjust = -0.5, colour = "black", position =                  position_dodge(0.5), size =4, face= "bold")
    p<-p+theme_bw()
    p<-p+theme_light()
    pp=seq(0.1,1,by=0.1)
    p<-p+scale_y_continuous(labels = percent,breaks =pp)#把纵坐标轴变为百分比
    p<-p+theme(legend.title=element_blank())
    p<-p+theme(axis.text.y= element_text(size=10,color="black", face= "bold", vjust=0.5, hjust=0.5))
   p<-p+theme(axis.text.x= element_text(size=10, color="black", face= "bold", vjust=0.5, hjust=0.5))
    #legend_position<-theme(legend.position="top")
    #p<-p+legend_position
  }
  #*~*#全自动画折线图#*~*#
  #*~*#画折线图具体代码#*~*#
  p1=line_chart(shuju=c1,F=PF1[[1]])
  p2=line_chart(shuju=c1,F=PF1[[2]])
  p3=line_chart(shuju=c1,F=PF1[[3]])
  p4=line_chart(shuju=c2,F=PF1[[1]])
  p5=line_chart(shuju=c2,F=PF1[[2]])
  p6=line_chart(shuju=c2,F=PF1[[3]])
  #*~*#画折线图具体代码#*~*#
  #*~*#全自动画横向条形线图#*~*#
  H_bar_chart_fun<-function(shuju,F)
  {
    shuju<-shuju
    shuju<-shuju[F]
    N=ncol(shuju)
    for (i in 2:N)
    {
      shuju[,i]<-round(shuju[,i], 3)
      shuju[,i]<-round(shuju[,i], 3)
    }
    name<-names(shuju)
    xname<-name[1]
    shuju[,1]<-factor(shuju[,1])
    shuju<-melt(shuju,id=xname)
    shujusum<-tapply(shuju
    shuju[,1]<-reorder(shuju[,1],shuju$sum)
    shuju<- shuju[order(-shuju$sum),]#降序排列
    p<-ggplot(shuju, aes(x =shuju[,1], y =value)) 
    p<-p+theme_bw()
    p<-p+theme_light()
 p<-p+geom_bar(aes(fill=variable),stat = "identity",position = "dodge",width=0.8)
    p<-p+labs(x="" ,y="",title="")
    p<-p+coord_flip()
    p<-p+geom_text(aes(label=paste(shuju$value*100,'%',sep = ''),fill=variable),vjust =0.3,hjust=-0.1,colour = "black", position = position_dodge(0.7), size =4)
    p<-p+theme(legend.title=element_blank())
    p<-p+theme(
      legend.position = c(0.95, .05),
      legend.justification = c("right", "bottom"),
      legend.box.just="right",
      legend.margin=margin(6, 6, 6, 6)
    )
    p<-p+theme(axis.text.y= element_text(size=10,color="black", face= "bold", vjust=0.5, hjust=0.5))
    p<-p+theme(axis.text.x= element_text(size=15, color="black", vjust=0.5, hjust=0.5))
    pp=seq(0.1,1,by=0.1)
    p<-p+scale_y_continuous(labels = percent,breaks =pp)#把纵坐标轴变为百分比
  }
  #*~*#全自动画横向条形线图#*~*#
  #*~*#画横向条形线图具体代码#*~*#
  p7=H_bar_chart_fun(shuju=c3,F=PF3[[1]])
  p8=H_bar_chart_fun(shuju=c3,F=PF3[[2]])
  p9=H_bar_chart_fun(shuju=c3,F=PF3[[3]])

[3]第三步制作ppt

  ppt<-pptx(template = "cga_template.pptx")  #自己想要的母版
  slide.layouts(ppt,'Comparison')
  #第一张PPT
  ppt<-addSlide(ppt,slide.layout="Title Slide")
  options("ReporteRs-fontsize"=26)#设置默认大小
  ppt<-addTitle(ppt,value = c(name))
  #第二张PPT
  ppt<-addSlide(ppt,slide.layout="Title and Content")
  options("ReporteRs-fontsize"=8)#设置默认大小
  x21<-paste(cn,"30+逾期",sep="")
  ppt<-addTitle(ppt,x21)
  x22<-paste(cn,t,"至",t1,"共放款",fangkuan,"台,","逾期",yuqi,"台,","逾期率为",yuqilv,sep="")
  x23<-paste("新车放款",xcfangkuan,"台,","逾期",xcyuqi,"台,","逾期率为",xcyuqilv)
  x24<-paste("二手车放款",escfangkuan,"台,","逾期",escyuqi,"台,","逾期率为",escyuqilv)
  ppt<-addParagraph(ppt,value = c("",x22,x23,x24))
  #第三张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x3<-paste(cn,"各月拒绝与全国对比(其中",t,"起申请",sqliang,"单,","拒绝",jujueliang,"单)",sep="")
  #ppt<-addTitle(ppt,"长沙各月拒绝与全国对比(其中2017年1月起申请2776单,拒绝523单)")
  #####
  #time="2017年1月"
  #a=2776
  #b=523
  #x3<-paste(cn,"各月拒绝率与全国对比(其中","time","起申请",a,"单)",sep="")
  ppt<-addTitle(ppt,x3)
  ###
  ppt<-addPlot(ppt,print,x=p1,width=13,height=6)
  #第四张ppt
  ppt<-addSlide(ppt,"Title and Content")
  x4<-paste(cn,"新车各月拒绝与全国对比",sep="")
  ppt<-addTitle(ppt,x4)
  #ppt<-addTitle(ppt,"长沙新车各月拒绝与全国对比")
  ppt<-addPlot(ppt,print,x=p2,width=13,height=6)
  #第五张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x5<-paste(cn,"二手车各月拒绝与全国对比",sep="")
  ppt<-addTitle(ppt,x5) 
  #ppt<-addTitle(ppt,"长沙二手车各月拒绝与全国对比")
  ppt<-addPlot(ppt,print,x=p3,width=13,height=6)
  writeDoc(ppt,file="ppt.pptx")
  #第六张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x6<-paste(cn,"各月伪冒率与全国对比",sep="")
  ppt<-addTitle(ppt,x6)
  #ppt<-addTitle(ppt,"长沙各月伪冒率与全国对比")
  ppt<-addPlot(ppt,print,x=p4,width=13,height=6)
  writeDoc(ppt,file="ppt.pptx")
  #第七张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x7<-paste(cn,"新车各月伪冒率与全国对比",sep="")
  ppt<-addTitle(ppt,x7)
  #ppt<-addTitle(ppt,"长沙新车各月伪冒率与全国对比")
  ppt<-addPlot(ppt,print,x=p5,width=13,height=6)
  writeDoc(ppt,file="ppt.pptx")
  #第八张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x8<-paste(cn,"二手车各月伪冒率与全国对比",sep="")
  ppt<-addTitle(ppt,x8)
  #ppt<-addTitle(ppt,"长沙二手车各月伪冒率与全国对比")
  ppt<-addPlot(ppt,print,x=p6,width=13,height=6)
  #第九张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x9<-paste(cn,"拒绝原因与全国对比",sep="")
  ppt<-addTitle(ppt,x9)
  ppt<-addPlot(ppt,print,x=p7,width=13,height=6)
  #第十张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x10<-paste(cn,"新车拒绝原因与全国对比",sep="")
  ppt<-addTitle(ppt,x10)
  ppt<-addPlot(ppt,print,x=p8,width=13,height=6)
  #第十一张PPT
  ppt<-addSlide(ppt,"Title and Content")
  x11<-paste(cn,"二手车拒绝原因与全国对比",sep="")
  ppt<-addTitle(ppt,x11)
  #ppt<-addTitle(ppt,"长沙二手车各月伪冒率与全国对比")
  ppt<-addPlot(ppt,print,x=p9,width=13,height=6)
  #第十二张PPT
  ppt<-addSlide(ppt,slide.layout="Title Slide")
  options("ReporteRs-fontsize"=26)#设置默认大小
  ppt<-addTitle(ppt,value = c("谢谢"))
  writeDoc(ppt,file=output)
[4]第四步把制作ppt的代码做成函数,写循环调用批量生成PPT
setwd("D:/工作文件夹/全自动化出PPT")
Rdata="D:/工作文件夹/全自动化出PPT/201701-201907.csv"#原始大表数据
for (i in 1:100)
{
  cn<-sub('........$','',aa2[i])#从字符串里删除特定字符串
  name=as.character(aa2[i])#店面名称
 output=paste("D:/工作文件夹/全自动化出PPT/自动做出的PPT6/",name,"(第",i,"个地区)ppt.pptx",sep="")
  dianmian_ppt(Rdata,name,output)
}
#Rdata是原始数据,name是经销商名称,output是ppt输出的地址

[5]总结

通过以上四步可以一次生成所需PPT。如果数据的表头不变,每周要出报表的话,一次写好脚本,可以每周自动执行,原来做一份PPT需要半个小时的话现在只需1分钟左右或者更短,如果一次要做100份或者更多,写脚本显然更节省时间,也可以避免人工处理数据过程中出现的计算错误。