[1]第一步加载包
代码语言：javascript复制 #*~*#数据处理包#*~*#
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数据读取
代码语言：javascript复制 a1<-read.csv(Rdata) #由于有些数据比较敏感，所以只展示读取方法2.2绘图
代码语言：javascript复制 #*~*#全自动画折线图 #*~*#
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
代码语言：javascript复制 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份或者更多，写脚本显然更节省时间，也可以避免人工处理数据过程中出现的计算错误。
