墨问非名-汉化教程5——自动分页填字

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

Sub 缩行()  
With Selection.Find  
.Text = "^p" '查找  
.Replacement.Text = "の" '替换  
.Wrap = wdFindContinue  
.MatchByte = True  
.MatchWildcards = False '不使用通配符  
End With  
Selection.Find.Execute Replace:=wdReplaceAll '全部替换  
End Sub  

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17

Sub 填字转分页()  
With Selection.Find  
.Text = "^p" '查找硬换行  
.Replacement.Text = "^l" '替换为软换行  
.Wrap = wdFindContinue  
.MatchByte = True  
.MatchWildcards = False '不使用通配符  
End With  
Selection.Find.Execute Replace:=wdReplaceAll '全部替换  
With Selection.Find  
.Text = "^11^11([0-9])([0-9])^11^11" '查找[软换行*2][两位数字][软换行*2]格式的页码  
.Replacement.Text = "^p^l" '替换为[硬换行][软换行]  
.Wrap = wdFindContinue  
.MatchWildcards = True '不使用通配符  
End With  
Selection.Find.Execute Replace:=wdReplaceAll '全部替换  
End Sub  

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

;==================Word快捷键==================  
#IfWinActive, ahk_class OpusApp, 填  
Esc::Exit  
^+#!K:: ;Word填字  
{  
WinGetTitle, Title ;获取窗口名  
FormatTime, TimeStringStart, yyyy/MM/dd hh:mm:ss tt R  
SetKeyDelay, 100  
Loop, 22  
{  
Send ^+{Down} ;选择下一段落  
Send ^c ;复制  
Send {Down} ;下  
Send #3 ;切换到记事本  
Sleep 1000 ;延时1秒  
Send ^a ;全选  
Send ^v ;粘贴  
Send ^s ;保存  
Send #4 ;切换到PS  
Sleep 1000 ;延时1秒  
Send {f10} ;运行脚本  
Sleep 1000 ;延时1秒  
Loop ;判断脚本是否执行完  
{  
Sleep, 1000  
IfExist, \\Mac\Host\Volumes\Mack\汉化\-.txt  
break  
}  
FileDelete, \\Mac\Host\Volumes\Mack\汉化\-.txt ;删除小文档  
Sleep 1000 ;延时1秒  
Send ^{Tab} ;切换到下一页  
Sleep 1000 ;延时1秒  
Send #2 ;切换到WORD  
Sleep 1000 ;延时1秒  
}  
FileDelete, \\Mac\Home\Documents\填字完成.txt ;删除填字完成文档  
Sleep 1000 ;延时1秒  
SoundBeep, 750, 500 ;以较高的音高进行发音并持续半秒.  
Sleep 1000 ;延时1秒  
FormatTime, TimeStringEnd, yyyy/MM/dd hh:mm:ss tt R  
FileAppend,  
(  
  
填字项目：%Title%  
开始时间：%TimeStringStart%  
完成时间：%TimeStringEnd%  
  
), \\Mac\Home\Documents\填字完成.txt  
return  
}