自动更正的导入导出

ldl---

网上搜索有很多守柔老师的代码，但都是限制收费的，谁有可共享出来吗？

zpy2

想多了，别人收费，你要共享，恐怕比较难。

wdpfox

另人有付出，收费很正常。

We meet by chance like patches of drifting duckweed,  
May everything be fine with you everyday !
  （你我萍水相逢，愿君一切安好！）

ldl---

问题是发表的人不是守老师本人

sylun

可试试如下代码：

1. Sub test1()
   
2.     '将自动更正词条导出到新文档
   
3.     Dim i As Integer
   
4.     Dim aACentry As AutoCorrectEntry
   
5.    
   
6.     Documents.Add.Content.Text = "序号" & vbTab & "名称" & vbTab & "更正内容" & vbTab & "是否带格式" & vbCrLf
   
7.     For Each aACentry In AutoCorrect.Entries
   
8.         With aACentry
   
9.             ActiveDocument.Content.InsertAfter i + 1 & vbTab & .Name & vbTab
   
10.             If .RichText = False Then ActiveDocument.Content.InsertAfter .Value _
    
11.                 Else .Apply ActiveDocument.Bookmarks("\endofdoc").Range
    
12.             ActiveDocument.Content.InsertAfter vbTab & Format(.RichText, "否;是") & vbCrLf
    
13.             i = i + 1
    
14.         End With
    
15.     Next
    
16.     ActiveDocument.Content.ConvertToTable(wdSeparateByTabs).Borders.Enable = True
    
17.     MsgBox "共有" & i & "条自动更正词条。"
    
18. End Sub
    
19. 
    
20. Sub test2()
    
21.     '批量添加自动更正词条
    
22.     '将带有自动更正条目的文档作为当前文档
    
23.     '将自动更正词条放在至少有三列的表格中，前三列分别为更正词条名、更正内容和是否带格式（只填是或否，否时可不填）
    
24.     '表格第一行为标题行
    
25.     Dim i As Integer
    
26.     Dim info As String
    
27.     Dim aRow As Row
    
28.     With ActiveDocument.Content
    
29.         If .Tables.Count = 0 Then Exit Sub
    
30.         If .Tables(1).Rows.Count < 3 Then Exit Sub
    
31.         For Each aRow In .Tables(1).Rows
    
32.             With aRow
    
33.                 If .Index > 1 And Len(.Cells(1).Range.Text) > 2 Then
    
34.                     If Left(.Cells(3).Range.Text, 1) = "是" Then
    
35.                         AutoCorrect.Entries.AddRichText Name:=Replace(.Cells(1).Range.Text, Chr(13) & Chr(7), ""), _
    
36.                             Range:=ActiveDocument.Range(.Cells(2).Range.Start, .Cells(2).Range.End - 1)
    
37.                     Else
    
38.                         AutoCorrect.Entries.Add Name:=Replace(.Cells(1).Range.Text, Chr(13) & Chr(7), ""), _
    
39.                             Value:=Replace(.Cells(2).Range.Text, Chr(13) & Chr(7), "")
    
40.                     End If
    
41.                     i = i + 1
    
42.                 End If
    
43.             End With
    
44.         Next
    
45.     End With
    
46.     MsgBox "共添加了" & i & "条自动更正词条。"
    
47. End Sub

复制代码

wdpfox

ldl--- 发表于 2020-12-22 16:07
问题是发表的人不是守老师本人

那人就卑鄙、可耻了。

We meet by chance like patches of drifting duckweed,  
May everything be fine with you everyday !
  （你我萍水相逢，愿君一切安好！）