背景
在上次给郑老师用stata挑出最长的句子之后，
又有一天，郑老师给我发了一张图片过来，“夫人，这个功能可否实现？”
想法.jpg
我一脸懵逼，然后有了以下对话：
我：看不清
郑：我需要把Excel表格中非空白区域的单元格的横坐标、纵坐标和该单元格内部内容打印出来。我再给你写一下。
我：哪样的横纵坐标？
郑：（发来一张图片）
数据.jpg
我：你的纵坐标就是行名称；横坐标就是列名称；单元格内容就是数据内容呗；你要打印出来的样子是什么样的？
郑：对，一个单元格一页，总体流程我已经想好了，我写下来你看看哈
需求.jpg
思路.jpg
我：应该可以，你发我看看，你不用管流程，你说最后的需求就行。
需求
跟郑老师沟通了一轮之后，他想把自己整理的表，批量整理成文档，每个文档包括：
通用故事：（即横坐标）
通用理由：（即纵坐标）
历年真题：（即单元格内容）
思路
本来是用VBA也是可以实现的，但是，前段时间刚学了下R和Rmarkdown批量写报告，就顺便练习了。
- 确定word模板；
- 循环批量语法——R；
- 单份报告语法——Rmarkdown;
过程
①确定word模板
根据郑老师要求，把word模板的页眉页脚水印啥的确定好，以及报告的样式设定好。
报告模板.png
②循环批量语法——R（tiku.R）
思路依然是先将宽数据转为长数据，便于循环读取
#调用包
library(readxl)
library(vcd)
library(dplyr)
library(ggplot2)
library(plyr)
library(scales)
library(tidyr)
library(rmarkdown)
library(reshape2)
#将现有内存中的对象清除，感觉上会比较清爽
rm(list=ls())
#设定工作目录
setwd("C:\\Users\\Ressia\\Documents\\百度云下载文档\\R\\tiku")
#读取数据
data=read_excel("data.xlsx",sheet = "data")
#将没有用的第一列删除
data[,1]=NULL
数据处理前：
数据转换前.png
#将从第2列到最后一列（之后再增加列也无所谓）的名称存到colvars中
colvars=colnames(data[2:dim(data)[2]])
#进行数据转换，宽数据转长数据，并存到newdata中
newdata=melt(data,
id.vars = colnames(data[1]),
measure.vars = colvars,
variable.name = "通用故事",
value.name = "历年真题")
#将newdata中的第一列字段的名称改为“通用故事”
colnames(newdata)[1]="通用理由"
#在newdata中新生成一列，字段名为story,这列用于word文件名称，即是将通用故事中的括号内内容删除，且注意不要出现中文符号，比如空格，不然之后生成报告时会出错
newdata$story=gsub("（","(",newdata[,2])
newdata$story=gsub("）",")",newdata$story)
newdata$story=gsub("\\(.*\\)","",newdata$story)
数据转换后：
数据转换后.png
#针对每个通用故事和通用理由进行循环处理
for (i in 1:length(unique(newdata[,4]))){ #对 story 的值进行循环处理
for(j in 1:length(unique(newdata[,1]))){ #对 通用理由 的值进行循环处理
cname=unique(newdata[,4])[i] #获取列名称(story)
rname=unique(newdata[,1])[j] #获取行名称（通用理由）
subnewdata=subset(newdata,newdata[,4]==cname&newdata[,1]==rname) #将筛选出的每条数据存至subnewdata
if (is.na(subnewdata[1,3])==F) { #设定条件，当第3列（历年真题）不为NA时，进行下面的处理
file=paste("通用故事","_",cname,"_",j,"_","v1",".docx",sep="") #文件名为“通用故事_story的值_j_v1”
render("C:\\Users\\Ressia\\Documents\\百度云下载文档\\R\\tiku\\report\\tiku.Rmd",output_format = "word_document",output_file = file) #执行tiku.Rmd文件，生成word报告，文件名为“通用故事_story的值_j_v1”
}
}
}
subnewdata举例：
subnewdata.png
③单份报告语法——Rmarkdown（tiku.Rmd）
#报告标题是“通用故事”，作者“郑舜Joshua-学为贵”，导出word，模板为第一步中设定好的word模板，注意，tiku.Rmd和muban.docx需要在同一工作目录下
---
title: "通用故事"
author: "郑舜Joshua-学为贵"
output:
word_document:
reference_docx: muban.docx
---
#设定报告输出情况，不要代码，也不要警告信息
```{r,warning=F,message=F,echo = F}
knitr::opts_chunk$set(warning=F,message=F,echo = F)
setwd("C:\\Users\\Ressia\\Documents\\百度云下载文档\\R\\tiku\\report")
```
#二级标题分别是通用故事，通用理由，历年真题；将subnewdata中的第2列，第1列和第3列单元格内容分别放置上述各个二级标题下
## 通用故事
`r subnewdata[1,2]`
## 通用理由
`r subnewdata[1,1]`
## 历年真题
`r subnewdata[1,3]`
结果
运行tiku.R后，生成批量报告：
批量报告.png
单个报告内容为：
单个报告.png
最后
这样，就能达到郑老师希望的“以后如果往里面添加新题的话，也可以用同样的程序不断打印新的分类题库了”
另外，郑老师也希望能把word转为不可复制的pdf，目前先用VBA统一将word转为pdf，这里也附上VBA批量将word转pdf吧~
Sub docx2other()
On Error Resume Next
Dim sEveryFile As String, sSourcePath As String, sNewSavePath As String
Dim CurDoc As Object
sSourcePath = "C:\Users\Ressia\Documents\百度云下载文档\R\tiku\report\"
'假定待转换的docx文件全部在"E:\DOCX文件\"下，你需要按实际情况修改。
sEveryFile = Dir(sSourcePath & "*.docx")
Do While sEveryFile <> ""
Set CurDoc = Documents.Open(sSourcePath & sEveryFile, , , , , , , , , , , msoFalse)
sNewSavePath = VBA.Strings.Replace(sSourcePath & sEveryFile, ".docx", ".pdf")
'如果想导出doc/rtf/txt等，就把上一行行尾的pdf换成doc/rtf/txt
'转化后的文件也在"E:\DOCX文件\"下，当然你可以按需修改。
CurDoc.SaveAs2 sNewSavePath, wdFormatPDF
'pdf对应wdFormatPDF,doc对应wdFormatDocument,rtf对应wdFormatRTF,txt对应wdFormatText
'更多格式可参见文末的截图WdSaveFormat Enumeration
CurDoc.Close SaveChanges:=False
sEveryFile = Dir
Loop
Set CurDoc = Nothing
End Sub
至于如何批量转成不可复制的pdf，还待琢磨……
网友评论