[求助]WORD中查找固定格式的文字

dbzmc

最近在做问卷调查，有位同事没有打印直接把调查问卷以电子稿（WORD）的格式发到学生的电脑上，要求学生把自己认为正确的答案字体颜色设为红色。共有500多份问卷啊，现在要把每份问卷的每个答案统计出来，累死人啊。我的思路是能不能编写一个简单的VBA或者一个小程序对这些文档批量处理，自动统计出没份问卷中红色显示的字符（答案）然后自动存到一个指定的文件中去（每份问卷的答案一行），这样可以省点力气。

因为本人是个菜鸟，对这个一窍不通，只有恳请高手出手相救了。最好提供源码，万分感激啊。

上传问卷样本

uhQNiZs8.rar (9.14 KB, 下载次数: 30)

2007-5-17 22:24 上传

点击文件名下载附件
[求助]WORD中查找固定格式的文字

[此贴子已经被作者于2007-5-17 22:24:17编辑过]

c81

是单选还是多选呀？学生有没有不选的题目或颜色设错的可能？原题干有没有序号？自动还是手动的？.......... 

做问卷调查应该是inforpath的干活（very cool！），当初那个同事是怎么想的？“胆子”怎么这么大？设计一个方案不能光想头不考虑尾呀，收上这些Word文档怎么处理？还不如纸质的了，这种计算机应用方式真是帮了倒忙。

dbzmc

是啊，真是郁闷啊，我们就按照理想的的状态来想：在表格中，第一列是题目，第二列是答案，所有的答案都做了，所做的答案都是红色的，该怎么操作。万分感谢，在线等

c81

这个调查是不记名的么？如果比较理想的话，

可以这样做

插入→文件，全选500个那些文档变成一个文档，这个文档页数是单个文档页数*500，因内容全是文字没有图表之类的，Word应该不会死掉的；

删除所有红色答案以外的内容，但要保留序号，让它们能对应起来。

然后它们全选或分几部分来选，然后转换成表格，复制到Excel中去

然后在Excel中得到一个纵列，将它们处理成原单Word文档题数为一列的表，最后处理统计分析一水平行的选择情况。

dbzmc

兄弟，你不是说手工删除红色以外的所有内容吧？？能不能有自动执行的代码？我是菜鸟，对编程一窍不通

硌五

inforpath是什么，还没用过，先查了了解一下，回家一趟不容易，找个由头说说话，嘿嘿

sylun

看看如下代码是否可行
Sub test()
'请将所有问卷文档保存于指定的文件夹（暂定为E:\ddd）
    Dim ndoc As String, odoc As Document
    Dim mytext As String, mycount As String, i As Integer, n As Integer
    ChDrive "E" '设置当前驱动器
    ChDir "E:\ddd" '确定目录路径
    ndoc = Dir("*.doc")
    Application.ScreenUpdating = False
    Do While ndoc <> ""  '在指定目录内各文档循环操作
        n = n + 1
        Set odoc = Documents.Open(ndoc)
        With odoc.Content.Find '查找红色数字
            .ClearFormatting
            .Font.Color = wdColorRed
            .Format = True
            .MatchWildcards = True
            '如果找到，则记录其题号及数字选项
            Do While .Execute(findtext:="[1-3]", Forward:=True) = True
                With .Parent
                    mytext = mytext & Replace(odoc.Name, "doc", "") _
                        & ":no" & .Cells(1).RowIndex - 1 & vbTab & .Text & vbCr
                    .Move Unit:=wdRow, Count:=1
                End With
            Loop
        End With
        odoc.Close False
        ndoc = Dir()
    Loop
    '分问题统计答卷情况
    For i = 1 To 32
        mycount = mycount & "No." & i & vbTab & UBound(Split(mytext, "no" & i & vbTab & "1")) & vbTab _
        & UBound(Split(mytext, "no" & i & vbTab & "2")) & vbTab _
        & UBound(Split(mytext, "no" & i & vbTab & "3")) & vbCr
    Next i
    '创建新文档并插入统计表格
    Documents.Add
    Selection.InsertAfter "题号" & vbTab & "是" & vbTab & "否" & vbTab & "不确定" & vbCr & mycount
    Selection.ConvertToTable Separator:=vbTab, numcolumns:=4
    With ActiveDocument.Tables(1)
        .Style = "网格型"
        .Borders.Enable = True
        .PreferredWidthType = wdPreferredWidthPercent
        .PreferredWidth = 75
        .Rows.Alignment = wdAlignRowCenter
    End With
    Application.ScreenUpdating = True
    MsgBox "共统计了" & n & "个文档。", vbInformation
End Sub

[此贴子已经被作者于2007-5-18 13:15:47编辑过]

dbzmc

万分感谢,非常好用.祝愿你好人有好报