Dim bContinue As Boolean :*vSC: q
?pdN!zOeL
Dim regEX As New RegExp [x%8l,O
#l
Dim paraCounter As Long '全局段落计数,仅在主程序中可读写,其它过程函数应为只读 SBaTbY0
cS
BS38>
Dim LastTitle0String As String, LastTitle0No As Long y(*5qa<>
Dim LastTitle1String As String, LastTitle1No As Long cj4o[l
Dim LastTitle2String As String, LastTitle2No As Long cm8co
Dim LastTitle3String As String, LastTitle3No As Long HqI[]T@
Dim LastTitle4String As String, LastTitle4No As Long hltUf5m'b
Dim LastTitle5String As String, LastTitle5No As Long |2GrOM&S
Dim LastTabelString As String, LastTableNo As Long KGf@d*ZOMz
Dim LastFigureString As String, LastFigureNo As Long uF ;8B]"
6FX]b4
Dim strSeperator As String 4
}Y? :R
qYPgn_
Sub ConvertWidth(fTEXT As String, rText As String) L'$({
Selection.Find.ClearFormatting P_P~c~o
Selection.Find.Replacement.ClearFormatting 8.&P4u i
Selection.Find.Wrap = wdFindContinue tiy#b
8
Me.txtStatus.Text = "转换全角数字字母" & fTEXT & "形式为半角" & rText iOk`_LG#
DoEvents &k`/jl;u
Selection.Find.Execute findtext:=fTEXT, replacewith:=rText, Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue, MatchCase:=True /g1;`F(MS/
End Sub
O))j
cpPS8V
Sub ClearDomain() o{' JO3
With Selection.Find b)>l7nOc
.ClearFormatting 9&HaEAme
.Replacement.ClearFormatting ? <w[ZWytm
.Wrap = wdFindContinue #<@_mbQ@|K
Me.txtStatus.Text = "清除所有域代码"
)afH:
DoEvents lmIphOUoIw
.Execute findtext:="^d", replacewith:="", Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue, MatchWildcards:=False <'
jygZ(
End With 1]W8A.ZS
End Sub gk}.LE
J[UTn'M8]
Private Sub cmdCheck_Click()
]D^zTl3=q
bContinue = True S#0C^
Dim NoSeries1(1 To 16) As String
F ~e}=Nb
Dim NoSeries2(1 To 16) As String 3*F|`js"
Dim NoSeries5(1 To 16) As String M=fhRCUB
Dim NoSeriesRM(1 To 16) As String Odm1;\=Eg+
Dim paraTotal As Long, ParaText As String ~iIFe+6
Dim ttString As String, ttNo As String ~(L&*/c
*o6QBb
Dim ShapeCounter As Long, ShapeHeight As Long, ShapeWidth As Long ZftucD|ZY/
s]HJcgI
Me.txtStatus.Visible = True 'X\C/8\
Me.lbParaType.Visible = True P
V9q=
Me.cmdCheck.Enabled = False U ZL-mF:)&
-j^G4J
c],Zw
@7sHFwtar?
V0bKtg1f?-
Dim ParaType As String, rText As String a~k*Gd(
2h)*
Selection.WholeStory >J,IxRGi
Selection.NoProofing = True {M23a
_t\
j'XND`3
tm1 = Now A&d_!u>
F)50 6
ActiveWindow.View.Type = wdNormalView uZP(-}
CHdYY7\{
NoSeries1(1) = "一" Wt=%.Y(x
NoSeries1(2) = "二" #UnGU,J
NoSeries1(3) = "三" <^+&A7Q-_
NoSeries1(4) = "四" J=H8^4M
NoSeries1(5) = "五" FC4hvO(/m
NoSeries1(6) = "六" AY]rQ:I
NoSeries1(7) = "七" ?QcS$i
NoSeries1(8) = "八" >`n)-8
NoSeries1(9) = "九" ;`Sn66&
NoSeries1(10) = "十" 'h>l_A
NoSeries1(11) = "十一" e63io0g>
NoSeries1(12) = "十二" yn2k!2]&T<
NoSeries1(13) = "十三" 4)9Pgp:
NoSeries1(14) = "十四" pW&8 =Ew
NoSeries1(15) = "十五" G&yF9s)Lvs
NoSeries1(16) = "十六" OYOczb]
C?rb}(m
NoSeries2(1) = "㈠" ;?gR ,AKZ
NoSeries2(2) = "㈡" ^C8f(
NoSeries2(3) = "㈢" "77
l~3
NoSeries2(4) = "㈣" '<wZe.Q!
NoSeries2(5) = "㈤" 0
d2to5 (
NoSeries2(6) = "㈥" Ut(BQM>U+$
NoSeries2(7) = "㈦" m.U&O=]5
NoSeries2(8) = "㈧" rY"EW"y
NoSeries2(9) = "㈨"
>BjZ{7?Ok
NoSeries2(10) = "㈩" ?aZ\Dg{
InG<B,/W?
NoSeries5(1) = "①" 3ZAzv en
NoSeries5(1) = "②" K&&YxX~3
NoSeries5(3) = "③" ^.[+)0I
NoSeries5(4) = "④" c-[IgX e
NoSeries5(5) = "⑤" NV^n}]ci
NoSeries5(6) = "⑥" WhL"-f
NoSeries5(7) = "⑦" )IuwI #pm
NoSeries5(8) = "⑧" 1!R:}r3t
NoSeries5(9) = "⑨" 3UcOpq2i\
NoSeries5(10) = "⑩" LfsOGC
VKr
oikz@]
CasFj9,
NoSeriesRM(1) = "I" MENrP5AL
NoSeriesRM(2) = "II" 6 w0r)
NoSeriesRM(3) = "III" 2yV{y#\
NoSeriesRM(4) = "IV" /j:-GJb*!u
NoSeriesRM(5) = "V" )7F$:*e
NoSeriesRM(6) = "VI" UQ
2;Dg G%
NoSeriesRM(7) = "VII" Y2>*' nU
NoSeriesRM(8) = "VIII" Ucj>gc=
NoSeriesRM(9) = "IX" \U?{m)N
NoSeriesRM(10) = "X" )1&,khd/u
NoSeriesRM(11) = "XI" z.:IUm{z
NoSeriesRM(12) = "XII" ^p~ 3H
NoSeriesRM(13) = "XIII" AH
]L C6-
NoSeriesRM(14) = "XIV" C2?p>S/q
NoSeriesRM(15) = "XV" =YR+`[bfI
NoSeriesRM(16) = "XVI" -<5H8P-
a{iG0T.{Yh
i = MsgBox("为了你的数据安全,请使用单独保存的文件副本进行本操作。" & vbCrLf & "确定继续进行吗?", vbYesNo) &^ =Y76
6
wD
If i = vbNo Then e pAC%a
Exit Sub >&|/4`HSB
End If +B
OuU#
2J7JEv|
If Me.chkSuper.Value Then {Yti
Me.txtStatus.Text = "检查修改所有的上标格式" kJ0otr2P
W0Q;1${
CheckSuperScript 1c $iW>0K
L;'v,s
End If <gSZ<T
=!2(7Nr
If Me.chkStyle.Value Then .7H*F9
Me.txtStatus.Text = "设置样式,请稍候...." }}v28"\TA
DoEvents -axmfE?g0
CeateOrModifyStyle ="[6Z$R
End If cs)z!
E"%G@,|3*
Va\?"dH>M
oSoU9_W
ClearDomain ACH!Gw~
j`"cU$NRM
SVT'fPm1M
RTYhgq
If Me.chkLIST.Value Then Il#9t?/
Me.txtStatus.Text = "将所有自动列表标题转化为人工标题形式" wk6tdY{&s
r)Iq47Uiw
ConvertListToOrdinary zj'uKBDl
End If _lG\_6oJ,
av!~B,
jF%l\$)/
Dim pType As String, trimpTEXT As String ,:3Di (
If Me.chkNum.Value = True Then H{*R(S<I
Me.txtStatus.Text = "转换全角数字形式为半角" G6j9,#2@
ConvertWidth "1", "1" ZQDw|*a@
DoEvents 0Yc#f
D
ConvertWidth "2", "2" v:Z.8m8D
DoEvents t-w4rXvF
ConvertWidth "3", "3" ]m
""ga
DoEvents j*1O(p+
ConvertWidth "4", "4" QLyBP!X-
DoEvents iLkP@OYgQ
ConvertWidth "5", "5" f@J-6uQ7w
DoEvents
2ZFp(e^%
ConvertWidth "6", "6" d#nKTqSg
DoEvents 96CC5
ConvertWidth "7", "7" &M+fb4:_
DoEvents nL*
SNQ_
ConvertWidth "8", "8" 4 Yl:1rz
DoEvents +DP{ _x)t
ConvertWidth "9", "9" Edav }z
DoEvents rxAb]~MMp
ConvertWidth "0", "0" .Ue1}'v*,
DoEvents "ZFK-jn/
ConvertWidth "a", "a" y:8Oc?
DoEvents GwZ(3
ConvertWidth "b", "b" ESv&x6H
DoEvents mdIa`OZr
ConvertWidth "c", "c" @c{
b\is2
DoEvents 0t}&32lL&
ConvertWidth "d", "d" @&]%%o+
DoEvents U*Pi%J
ConvertWidth "e", "e" (B;rjpK
DoEvents 2aO.t
ConvertWidth "f", "f" <o\I C?A
DoEvents MQGR-W
V=5
ConvertWidth "g", "g" XDq*nA8#5B
DoEvents ZIM 5$JdCv
ConvertWidth "h", "h" W RVm^
DoEvents $Z^HI
ConvertWidth "i", "i" [
f`V_1d3
DoEvents $F86Dwd
ConvertWidth "j", "j" j*N:Kdzvl
DoEvents . xdSUe
ConvertWidth "k", "k" S%m$LM]NCg
DoEvents $v+t~b
ConvertWidth "l", "l" 626!6E;T
DoEvents ~@bh[o~rF
ConvertWidth "m", "m" !`#xFRHe
DoEvents <f`G@
ConvertWidth "n", "n" HWT^u$a"
ConvertWidth "o", "o" 421ol
ConvertWidth "p", "p" [O(8izv
ConvertWidth "q", "q" |0/~7l
ConvertWidth "r", "r" DU-&bm
ConvertWidth "s", "s" @I|gA
ConvertWidth "t", "t" _8"%nV
ConvertWidth "u", "u" +eD+Z.{
ConvertWidth "v", "v" F]~>qt<ia
ConvertWidth "w", "w" 3.s.&^
ConvertWidth "x", "x" &\GB_UA
ConvertWidth "y", "y" uvf}7
ConvertWidth "z", "z" [D%5
Fh\0
ConvertWidth "A", "A" Q#rj>+?
ConvertWidth "B", "B" yPza
ConvertWidth "C", "C" S-k:+ 4
ConvertWidth "D", "D" eo&nAr
ConvertWidth "E", "E" QGQ>shIeZ
ConvertWidth "F", "F" 4q\bnt
ConvertWidth "G", "G" S&YC"
ConvertWidth "H", "H" {
z/Y~rf
ConvertWidth "I", "I" r+%}XS%;h
ConvertWidth "J", "J" ];1Mg
ConvertWidth "K", "K" ')>&
:~
ConvertWidth "L", "L" 8z
h{?0
ConvertWidth "M", "M" _}-Ed,.=
ConvertWidth "N", "N" BSB;0O M
ConvertWidth "O", "O" vmZyvJSE
ConvertWidth "P", "P" J
M,ndl
ConvertWidth "Q", "Q" ~1v5
H]T{
ConvertWidth "R", "R" nB1[OB{
ConvertWidth "S", "S" m|w-}s,
ConvertWidth "T", "T" Sq,x57-
ConvertWidth "U", "U" \P|PAU@,
ConvertWidth "V", "V" -(]s!,
ConvertWidth "W", "W"
&I$MV5)u
ConvertWidth "X", "X" B#K{Y$!v
ConvertWidth "Y", "Y" %Cz&7 qf"
ConvertWidth "Z", "Z" h|j$Jy
ConvertWidth "^l", "^p" 5L4{8X0X8
ConvertWidth "(", "(" I
;Sm<P7*
ConvertWidth ")", ")" 0xYPK7a=L\
gK8{ =A0c
End If <wZ2S3RNA
Q-}yZ
With ActiveDocument xMu[#\Vc
Dim tbl As Table |B;tv
#mKD
For Each tbl In .Tables %nfaU~IqK
tbl.Rows.Alignment = wdAlignRowCenter hf~'EdU
tbl.Range.Font.NameFarEast = "楷体"
9I;d>%
tbl.Range.Font.NameAscii = "Times New Roman" V>&WZY
tbl.Range.Font.Size = 10.5 P[E5e+A)
Next t$lO~~atr
Set tbl = Nothing k*3F7']8
End With '=2/0-;Jf
?@i_\<A2
3,<$z1Jm
With ActiveDocument 2=PX1kI
sox0:9Oqnf
For i = 1 To .TablesOfContents.Count $ RDwy)9
.TablesOfContents(i).Delete 54%@q[-
Next j!:^+F/
J
XIxk"m
x4C}AyR
lef,-{X-
paraTotal = .Paragraphs.Count cn$o$:tW
paraCounter = 1 plRBfw>]N
=k\V~8X
Z
LastTitle0No = 0 V94eUmx>?+
LastTitle1No = 0 sV))Z2sq
LastTitle2No = 0 j:;[Y `2
LastTitle3No = 0 kgV_*0^
LastTitle4No = 0 xQ=sZv^M
LastTableNo = 0 $R2iSu{kO
LastFigureNo = 0 rv\m0*\<
B~RVFc +
Dim Sec As Long S_VZ^1X]
MM*B.y~TxZ
Sec = InputBox("正文从第一节开始?", "节设置", 6) +
q/ j
If Sec = 0 Then %|:Gn) 8
Exit Sub y7quKv7L}
End If 5QR=$?K
~<?+(V^D
k = 0 Pu=,L#+F N
Do While (paraCounter < paraTotal) And bContinue M ;\iL?,
k = k + 1 D!-
78h
If .Paragraphs(paraCounter).Range.Information(wdActiveEndSectionNumber) >= Sec Then 3S~Gi,
Exit Do ;ctJ9"_g
End If #ONad0T;
paraCounter = paraCounter + 1 Y
nzhvE
If k Mod 20 = 0 Then <n)J~B^
Me.lbCounter.Caption = paraCounter Oist>A$Z
DoEvents j[Y$)HF
End If 69{BJ]q
Loop VM1`:1Z:$
1@)kNg)*$
oK5"RW
Do While (paraCounter < paraTotal) And bContinue TM1isZ
Wz~=JvRHh
ParaText = Trim(.Paragraphs(paraCounter).Range.Text) 8tR(i[L
ShapeHeight = 0 \L"Vx9xT
ShapeWidth = 0 .I"Qu:``
%)$^_4.g
CheckPara .Paragraphs(paraCounter).Range, ParaType, rText, ttString, ttNo, ShapeCounter, ShapeHeight, ShapeWidth +M"Fv9
SCCBTpmf2B
Select Case ParaType -r6cK,WVU
Case "【】表格内容" em+dQ15
.Paragraphs(paraCounter).Style = "QLNU表格内容" 4Y)rgLFj
Case "章" NT6OGBl&
LastTitle0No = LastTitle0No + 1 [
!ghI%VK
'新一章开始,复位其下属标题编号 q*|H*sS
LastTitle1No = 0 Be=J*D!E=>
LastTitle2No = 0 &G)I|mv
LastTitle3No = 0 G>/Gw90E
LastTitle4No = 0 .S l{m[nV8
Stkyz:,(
k = Val(ttNo) WPmH4L>T
If k = 0 Then '非数字编号章节 McRAy%{z
If ttNo <> NoSeries1(LastTitle0No) Then qW1d;pt
rText = "第" & NoSeries1(LastTitle0No) & ttString =o@CCUKpj
Me.ErrMsg.AddItem "章节编号错误:" & ParaText arR9uxP
End If f.%mp$~T
Else L"|~,SVF
If Val(ttNo) <> LastTitle0No Then !y&uK&1
rText = "第" & LastTitle0No & ttString M?iU$qI
Me.ErrMsg.AddItem "章节编号错误:" & ParaText 6 K+DgNK
End If ^]&uMkPN
*ydkx\pT
End If sO,%Ok1
kPm{ tc
'章段落设置 mUmU_L u8
'字体大小:三号16磅小三号15磅四号14磅小四号12磅五号10.5磅小五号9磅 OO Hw-MW
.Paragraphs(paraCounter).Style = "QLNU章节" 3++}4%w
.Paragraphs(paraCounter).Range.Select F3XB};
Selection.EndKey unit:=wdLine yM*-em
tc = Replace(rText, vbCr, "") hmRnr=2N
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="TC """ & tc & """ \l 1 ", PreserveFormatting:=False !\
IgT
t,
Case "一级标题" ADTx _tE
LastTitle1No = LastTitle1No + 1 0UJ%tPS
'新一级标题开始,复位其下属标题编号 7*9a`p3w
LastTitle2No = 0 J|9kWjOf+i
LastTitle3No = 0 []'gIF
LastTitle4No = 0 #mI{D\UR
G% |$3
If ttNo <> NoSeries1(LastTitle1No) Then ! z^%$;p
rText = NoSeries1(LastTitle1No) & "、" & ttString b'!t\m
Me.ErrMsg.AddItem "一级标题编号错误:" & ParaText ^usZ&9"@P
End If _.9):i2<SF
''{REFjK7
b) k\?'j
'一级标题段落设置 格式:一、标题内容 -VqZw&"
.Paragraphs(paraCounter).Range.Text = rText 9w^lRbn
.Paragraphs(paraCounter).Style = "QLNU一级标题" NtuO&{}i
.Paragraphs(paraCounter).Range.Select f4JmY1)@
Selection.EndKey unit:=wdLine #Sxk[[KwH*
tc = Replace(rText, vbCr, "") B}PT-S1l
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="TC """ & tc & """ \l 1 ", PreserveFormatting:=False )U?
Tmh
Case "二级标题" ^Pn
XnH?
LastTitle2No = LastTitle2No + 1 u3"0K['3
'新二级标题开始,复位其下属标题编号 WF)(Q~op0U
LastTitle3No = 0 iYqZBLf{S
LastTitle4No = 0 Vq'\`$_
gn2*'_V~3
If ttNo <> NoSeries1(LastTitle2No) Then L\cd=&b`
rText = "(" & NoSeries1(LastTitle2No) & ")" & ttString
:!SVpCt3
ErrMsg.AddItem "二级标题编号错误:" & ParaText [g bYIwL.
End If S'Hb5C2u
5s=ZA*(sY
'二级标题段落设置 格式:(一)、标题内容 yqEX0|V%
.Paragraphs(paraCounter).Range.Text = rText KT 3W>/#E
.Paragraphs(paraCounter).Style = "QLNU二级标题" M bj{C
B-oQ 9[~
.Paragraphs(paraCounter).Range.Select emhI1
*}
Selection.EndKey unit:=wdLine P=.yXirm?
tc = Replace(rText, vbCr, "") i++a^f
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="TC """ & tc & """ \l 2 ", PreserveFormatting:=False DqfWu*
!Ez5@
Case "三级标题" ?ztI8I/
LastTitle3No = LastTitle3No + 1 ,buSU~c_Q
'新三级标题开始,复位其下属标题编号
PTU_<\
LastTitle4No = 0 a.n;ika]-
F/ZB%;O9
If Val(ttNo) <> LastTitle3No Then 7$;#-
l
rText = LastTitle3No & ". " & ttString y9K U&