[求助]一个关于WORD VBA 的问题

wensheng401

各位大虾，你们好，我有一个问题，就是我有一个word 文挡，里面有一篇文章和几条要求的操作题目，要求完成其中的操作，现在我想利用ＶＢＡ实现自动的评分，但是我现在有其中的几个问题不会判断如何评分，请大家来帮帮忙了，我基本上明白是用ＳＥＬＥＣＴ　的方法来做的，我上传了word 文挡了在附件里面． e49meefq.rar (83.04 KB, 下载次数: 19)

2007-5-27 23:10 上传

点击文件名下载附件
[求助]一个关于WORD VBA 的问题

konggs

自己动手。

我给你一个架构。在相关位置添加代码即可

Sub 主程序()
    Dim arr
    Dim astring As String
   
    Application.ScreenUpdating = False
'    On Error Resume Next '忽略错误
   
    Application.StatusBar = "程序正在运行，请稍等！......(看到这个，说明一切正常)"
   
    astring = filename1 '文件名
    astring = Mid(astring, 2, Len(astring) - 1) '去掉第一个chr(13)
    arr = Split(astring, Chr(13))
    具体 (arr)
   
    Application.StatusBar = "程序已正确运行完毕！"
    Application.ScreenUpdating = True
End Sub

'互函得到对话框中所有的文件路径＋文件名
Function filename1()  '此代码功能为列出指定文件夹中所有选取的WORD文件全路径名
    Dim MyDialog As FileDialog
    Dim vrtSelectedItem
 '   On Error Resume Next '忽略错误
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            For Each vrtSelectedItem In .SelectedItems    '在所有选取项目中循环
                filename1 = filename1 & Chr(13) & vrtSelectedItem   '列出所有文件名
            Next vrtSelectedItem
        End If
      
    End With
End Function

Function 具体(arr)
Dim lindoc As Document
Dim arr1
Dim i As Long
Dim isResult
 
    For Each arr1 In arr
        Set lindoc = Documents.Open(FileName:=arr1, Visible:=False)
        With lindoc
            '具体的过程
            '第1个条件
            isResult = isResult + isFirstGood(.Paragraphs)
            MsgBox "第一项得分为：" & isResult
            '自己加
            '第2个条件
            '第3个条件
            '第4个条件
            '第5个条件
            '第6个条件
        End With
        lindoc.Close '关闭文档
     Next

End Function

'隶书，一号，海绿色，居中，
Function isFirstGood(myPars As Paragraphs) As Integer
   
    With myPars.First.Range
        If .Font.Name = "隶书" Then isFirstGood = isFirstGood + 2
        If .Font.Size = 26 Then isFirstGood = isFirstGood + 2
        If .Font.Color = wdColorSeaGreen Then isFirstGood = isFirstGood + 2
        If .ParagraphFormat.Alignment = wdAlignParagraphCenter Then isFirstGood = isFirstGood + 2
    End With
    If myPars.Parent.Range(myPars.First.Range.End, myPars.Last.Range.End).ParagraphFormat. _
            CharacterUnitFirstLineIndent = 2 Then isFirstGood = isFirstGood + 2
           
    If myPars.Parent.Range(myPars.First.Range.End, myPars.Last.Range.End).ParagraphFormat. _
            LineSpacingRule = wdLineSpace1pt5 Then isFirstGood = isFirstGood + 2

End Function

wensheng401

有其中两个条件,我不知道怎样判断,一个是偶数页页眉为“中国山水画，最心灵化的艺术”。

另一个是将全文中所有“山水画”一词替换为蓝色、四号字。请你再帮个忙,谢谢了...

在线等待你的回复..

konggs

Sub EvenPageHeadAndFind()
'有其中两个条件,我不知道怎样判断,一个是偶数页页眉为“中国山水画，最心灵化的艺术”。
   If ActiveDocument.Sections(1).Headers(wdHeaderFooterEvenPages).Range.Text = _
      "中国山水画，最心灵化的艺术" & Chr(13) Then myResult = myResult + 2
     
''另一个是将全文中所有“山水画”一词替换为蓝色、四号字。请你再帮个忙,谢谢了...
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = "山水画"
        .Font.Color = wdColorBlue
        .Font.Size = 14
        Do While .Execute
            i = i + 1
        Loop
    End With
    If UBound(Split(ActiveDocument.Content.Text, "山水画")) - i = 1 Then myResult = myResult + 2
    MsgBox myResult
   
End Sub

[此贴子已经被作者于2007-5-28 19:01:40编辑过]

wensheng401

斑竹,真的不好意思的再问一下了,不是我不想自己做,但是我想的方法比较笨,希望你帮忙了~

如何判断是否在 在文章的页脚底端居中插入页码呢? 在线等待回复~~

[em04][em04]

[此贴子已经被作者于2007-5-29 23:10:06编辑过]