#include <IE.au3>
#include <word.au3>
$Doc= ObjGet("","word.Application")
$acdoc = $doc.documents(2)
MsgBox(4096, "自动录入系统", $acdoc.range(1,10).text)
$newdoc=$doc.documents(1)
$acdoc.Tables.Add Range:=$acdoc.Range(0,0), NumRows:=6, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed ;新建收文表格
With $newdoc.Tables(1)
.Columns(1).PreferredWidth = CentimetersToPoints(2.2) ;第一列宽
.Rows.Height = CentimetersToPoints(1.5) ;行高
.Cell(2, 2).Split NumRows:=1, NumColumns:=5 ;拆分第二行单元格
.Cell(2, 2).PreferredWidth = CentimetersToPoints(5) ;第二行各单元格宽度
.Cell(2, 3).PreferredWidth = CentimetersToPoints(2.2)
.Cell(2, 4).PreferredWidth = CentimetersToPoints(3.4)
.Cell(2, 5).PreferredWidth = CentimetersToPoints(2.2)
.Cell(2, 6).PreferredWidth = CentimetersToPoints(2.2)
.Cell(1, 1).Range = "文件题目" ;以下写入项目文本
.Cell(2, 1).Range = "来文机关"
.Cell(2, 3).Range = "来文字号"
.Cell(2, 5).Range = "收文时间"
.Cell(3, 1).Range = "党委主要领导批示"
.Cell(4, 1).Range = "政府主要领导意见"
.Cell(5, 1).Range = "分管领导阅处意见"
.Cell(6, 1).Range = "承办部门办理意见"
;写入来文字号
r = 0
Do
r = r + 1
Loop While $acdoc.Range(r, r + 1).Text <> "〔" And $acdoc.Range(r, r + 1).Text <> "[" ;计算六角或方括号位置
lw = $acdoc.Range(0, r).Paragraphs.Count ;来文段数
s = $acdoc.Range($acdoc.Paragraphs(lw).Range.Start, $acdoc.Paragraphs(lw).Range.End - 1) ;来文字号文本
.Cell(2, 4).Range = Replace(s, $acdoc.Range(r, r + 1), Chr(13) & $acdoc.Range(r, r + 1)) ;括号前加回车
;写入文件标题
i = InStr(1, $acdoc.Range, "关于") ;查找关于位置
bt = $acdoc.Range(0, i).Paragraphs.Count ;标题段数
Do
bt = bt + 1
Loop While Len(Replace($acdoc.Paragraphs(bt).Range, " ", "")) > 2 ;计算清除空格后的字符数
st = $acdoc.Paragraphs($acdoc.Range(0, i + 2).Paragraphs.Count).Range.Start ;标题起点
en = $acdoc.Paragraphs(bt - 1).Range.End ;标题终点
$acdoc.Range(st, en).Copy ;复制标题
.Cell(1, 2).Range.PasteSpecial DataType:=wdPasteText ;粘贴到表格,因图片会影响I值,故不使用I值
.Cell(1, 2).Range = Replace(Replace(.Cell(1, 2).Range, " ", ""), Chr(13), "") ;清除标题中间空格和回车
;写入来文机关
If Len(Replace($acdoc.Paragraphs($acdoc.Range(0, i + 2).Paragraphs.Count - 1).Range, " ", "")) > 3 Then ;关于前是否有文字作单位
Do
n = n + 1
Loop While Len(Replace($acdoc.Paragraphs(lw + n).Range, " ", "")) < 2
$acdoc.Range($acdoc.Paragraphs(lw + n).Range.Start, $acdoc.Paragraphs(lw + n).Range.End).Copy
.Cell(2, 2).Range.PasteSpecial DataType:=wdPasteText
ElseIf $acdoc.Content.InlineShapes.Count = 1 Then ;否则同时艺术字为一个时,则使用艺术字内容作单位
t = $acdoc.Content.InlineShapes(1).TextEffect.Text
t = Replace(Replace(Replace(Replace(t, "文件", ""), "通知", ""), "(", ""), ")", "") ;去掉通知文件括号等字样
.Cell(2, 2).Range = t
Else
.Cell(2, 2).Range = $acdoc.Range($acdoc.Paragraphs(lw).Range.Start, r)
End If
;写入收文时间
.Cell(2, 6).Range = Now
.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter ;垂直居中
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter ;水平居中
End With
; $newdoc.PrintOut ;打印收文单
; $newdoc.Close wdDoNotSaveChanges ;关闭收文单
上面代码要达到的目的: