如何通过代码将词汇表批量生成单词（中文、英文、音标）测试？

tangqingfu · 发表于 2021-1-20 12:27

413191246se 发表于 2021-1-20 11:43
唐兄：第 30 行代码“NumColumns:=4”把 4 改为 3 即可；但同时，43行代码“j=4.7”要改为更大值才行，至于 ...

好的，谢谢！

413191246se · 发表于 2021-1-20 13:47

唐兄：这是最新代码，你不必改了，我全改了。建议：中文先设定为宋体/英文：Times New Roman 较好。
怕你等不及审核，先上代码压缩包，下载后自行拷贝即可。

tangqingfu-new-code.rar (1.31 KB, 下载次数: 22)

413191246se · 发表于 2021-1-20 13:48

Sub aaaa提取单词音标中文()
Dim r As Range, p&, t As Table, i As Paragraph, n&, k&, j!, myRange As Range, m&, h$
h = InputBox("", "请输入分栏数：", "3")
If h = "" Then End
With Selection
If .Type = wdSelectionIP Then .WholeStory
Set r = .Range
.EndKey 6
With .Paragraphs(1).Range
Do While .Paragraphs(1).Range.Text = vbCr
.Delete
Loop
End With
.EndKey 6
.TypeParagraph
p = r.Paragraphs.Count
.InsertAfter Text:=r
If .Next.Text = vbCr Then .Next.Delete
If .Characters.Last.Text = vbCr Then .Characters.Last.Delete
.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, AutoFitBehavior:=wdAutoFitFixed
.Tables(1).Style = "网格型"
End With
With Selection
For k = 1 To 3
Set t = ActiveDocument.Tables(1)
t.Columns(k).Select
With Selection
.Copy
.EndKey 6
.InsertBreak
.Paste
End With
ActiveDocument.Tables(2).Select
With Selection
.Rows.ConvertToText Separator:=wdSeparateByParagraphs, NestedTables:=False
For Each i In .Paragraphs
n = n + 1
i.Range.InsertBefore Text:=n & "."
Next
End With
With Selection
.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=h, AutoFitBehavior:=wdAutoFitFixed
.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
For Each i In .Paragraphs
i.Range.Characters.Last.InsertBefore Text:=vbTab
Next
Do While .Text Like "*" & vbTab & vbTab & "?"
.Characters.Last.Previous.Delete
Loop
With .Range.Find
.Replacement.Font.Underline = wdUnderlineSingle
.Execute "^9", , , 0, , , , , 1, "", 2
.Execute "^9", , , 0, , , , , , "^& ", 2
End With
End With
Set myRange = Selection.Range
With ActiveDocument.Sections(1).PageSetup
j = ((.PageWidth - .LeftMargin - .RightMargin) / 28.35 - 0.25) / h
End With
With myRange
For Each i In .Paragraphs
i.Range.Select
With Selection
With .ParagraphFormat.TabStops
.ClearAll
For m = 1 To h
.Add Position:=CentimetersToPoints(j * m), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
Next m
End With
.ParagraphFormat.LeftIndent = CentimetersToPoints(0)
End With
Next
With .Find
.Font.Underline = wdUnderlineSingle
.Replacement.Font.Underline = wdUnderlineNone
.Execute " ", , , 0, , , , , 1, "", 2
End With
End With
Selection.EndKey 6
n = 0
Next k
End With
ActiveDocument.Tables(1).Delete
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
Selection.HomeKey Unit:=wdStory
MsgBox "Congratulations! Complete!", 0 + 48
End Sub

复制代码

tangqingfu · 发表于 2021-1-22 10:23

413191246se 发表于 2021-1-20 13:48

感谢413191246se兄的代码，代码更显示智能化，可以自行分栏。
在运行后会弹出提示：
对象变量或With块变量未设置

413191246se · 发表于 2021-1-22 13:38

唐兄：第 13 楼代码，在我的 Windows10-64bit + Office2019Word 中运行 OK！没毛病。请自行查找原因。
另外：请注意你的示例文档是否正确。比如：前面以单词开头，后面以”初中“结尾。

tangqingfu · 发表于 2021-1-22 16:17

413191246se 发表于 2021-1-22 13:38
唐兄：第 13 楼代码，在我的 Windows10-64bit + Office2019Word 中运行 OK！没毛病。请自行查找原因。
另 ...

按一楼的文档进行测试，都出现上述提示，三台电脑都会弹出提示，但不影响生成结果

413191246se · 发表于 2021-1-22 19:09

本帖最后由 413191246se 于 2021-1-22 19:11 编辑

唐兄：你提供的文档，在测试时，要将分页符及后面的文本删除后保存，然后再测试。
即：以“twelve”为首，以“初中”为尾，保存起来后运行。
*
* 唐兄：请将示例文档调整为：首词为“twelve”，尾词为“初中”，没有空白段落，然后试用下面的宏

tangqingfu · 发表于 2021-1-22 21:39

413191246se 发表于 2021-1-22 19:09
唐兄：你提供的文档，在测试时，要将分页符及后面的文本删除后保存，然后再测试。
即：以“twelve”为首， ...

保存后运行果然可以，再次感谢413191246se兄！

		自动登录	找回密码
密码			免费注册

[求助] 如何通过代码将词汇表批量生成单词（中文、英文、音标）测试？

评分