WORD题库转换成电子表式（选择题和判断题）

wj710000

想把WORD题库转换成电子表式，原word题库就是单选、多选和判断题，有上千条，要转成excel表式的，求助于各位

题库.zip (12.87 KB, 下载次数: 34)

2023-1-19 21:56 上传

点击文件名下载附件

zldccmx

附件错误，WORD文档无法打开

pc087

代码如下：

。。。。。。

gwjkkkkk

Sub TEST()
    Dim wdApp As Object, wdDoc As Object, ar, i&, r&, strParTxt$
    Dim Items As FileDialogSelectedItems, vItem, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    With Application.FileDialog(1)
        With .Filters
            .Clear
            .Add "Word文档(doc?)", "*.doc?"
        End With
        .AllowMultiSelect = True
        .InitialFileName = strPath
        If .Show Then Set Items = .SelectedItems Else Exit Sub
    End With
   
    Application.ScreenUpdating = False
    ReDim ar(1 To 10 ^ 3, 1 To 1)
    Set wdApp = CreateObject("Word.Application")
    For Each vItem In Items
       Set wdDoc = wdApp.documents.Open(vItem)
          With wdDoc
              For i = 1 To .Paragraphs.Count
                strParTxt = .Paragraphs(i).Range.Text
                If Len(strParTxt) <> 1 And Right(strParTxt, 1) = Chr(13) Then
                    r = r + 1
                    ar(r, 1) = Left(strParTxt, Len(strParTxt) - 1)
                End If
             Next
          End With
          MsgBox wdDoc.Name
       wdDoc.Close False
    Next
      
    Cells.Clear
    [A1].Resize(r, 1) = ar
    With [A1].Resize(r)
        .Value = ar
        .WrapText = True
        .ColumnWidth = 100
        .EntireRow.AutoFit
    End With
    wdApp.Quit
    Set wdApp = Nothing: Set wdDoc = Nothing: Set Items = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请楼主参考附件。。。

wj710000

gwjkkkkk 发表于 2023-1-20 19:58
请楼主参考附件。。。

你这个只是简单的将原word内容复制到电子表中，不是我需要的格式。PC087大侠代码转换完全符合目标格式

wj710000

pc087 发表于 2023-1-20 11:32
代码如下：

。。。。。。

大侠，代码运行结果完全符合目标模式，但我在原题库后加了几条题目，再运行就提示出错了，麻烦再帮看下是什么原因，谢谢了！

0120B.zip (37.83 KB, 下载次数: 9)

2023-1-20 21:43 上传

点击文件名下载附件

x-xx-xx

https://club.excelhome.net//forum.php?mod=viewthread&tid=1629699&extra=

pc087

wj710000 发表于 2023-1-20 21:43
大侠，代码运行结果完全符合目标模式，但我在原题库后加了几条题目，再运行就提示出错了，麻烦再帮看下是 ...

只能再精细一下正则表达式了

wj710000

非常感谢！
祝春节快乐！！！