求助，如何按表格新建word文档

yqszwxb5

如何按表格新建word文档，就是像A1的名字新建一个word文档，按B1的数字从另一个word文档中找相应的题，复制在新建文档中，然年按C1的的数字从刚才word文档中找相应的题，复制在新建文档中。依此类推。谢谢。 测验.zip (93.32 KB, 下载次数: 5)

2018-6-26 06:24 上传

点击文件名下载附件

182197315

Sub 生成试题()
Dim t%, j%, k%, arr, wdApp, reg, mat
Set wdApp = CreateObject("Word.Application")
Dim wdD As Word.Document, aDoc As Word.Document
Set reg = CreateObject("VBScript.RegExp")
Set wdD = wdApp.Documents.Open(ThisWorkbook.Path & "\测验.doc")
arr = Range("A1").CurrentRegion
For i = 1 To UBound(arr, 1)
    Set aDoc = wdApp.Documents.Add
    For j = 2 To UBound(arr, 2)
        If arr(i, j) = "" Then Exit For
        With reg
            .Global = True
            .MultiLine = True
            .Pattern = "^" & arr(i, j) & "(?:(?!\d+\.\d+).)+"
            If .Test(wdD.Content) Then Set mat = .Execute(wdD.Content)
        End With
        wdD.Range(mat(0).FirstIndex, mat(0).FirstIndex + mat(0).Length).Copy
        With aDoc.Range
            If j > 2 Then
                .Collapse wdCollapseEnd
'                .InsertAfter (vbCrLf)
            End If
            .Paste
        End With
    Next
    aDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & arr(i, 1) & ".doc"
    aDoc.Close
Next
wdD.Close
wdApp.Quit
Set wdD = Nothing
Set aDoc = Nothing
Set reg = Nothing
End Sub

182197315

楼主试试以上代码

tfeng_no1

182197315 发表于 2018-6-26 22:02
楼主试试以上代码

Dim wdD As Word.Document, aDoc As Word.Document，这句代码运行错误。

182197315

用office，不要用WPS