基于VBA自动成批批改word格式作业

1方法：利用word VBA编程，选择文件夹中的批量word版本的作业，自动在作业开头加上作业批改信息，方便教师批改大批量作业。

 

图1 程序运行界面，设置等级和评语

图2 选择要批改的作业

 

图3 作业批改成功

图4 作业批改效果图

 

2程序设计

 

（1）界面设计

设计有一个窗体和一个模块

（2）窗体代码

 

（3）模块代码

 

Sub 插入批改文字(oDocAs Document, 评语 As String, 等级 As String)

   

    With oDoc

        .Words(1).Select  '选择文档的第一个词

        .Range.Words(1).InsertBefore(vbCrLf)   '在文档第一个词前插入换行符

    End With

  

    Dim oTable As Table

   

    With oDoc

        Set oTable =.Tables.Add(Range:=.Paragraphs(1).Range, numrows:=1, NumColumns:=1)

                  '加入一个1行1列的表格

    End With

    With oTable '设置表格格式

        .Borders.InsideLineStyle =wdLineStyleSingle

        For i = 1 To 4

            .Borders(i).LineStyle =Options.DefaultBorderLineStyle

            .Borders(i).LineWidth = wdLineWidth050pt

            .Borders(i).Color = wdColorRed

        Next

    End With

   

    Dim r As Range

    Set r = oTable.Rows(1).Cells(1).Range

   

    With r

        .InsertAfter Text:="已阅"

        .InsertParagraphAfter

        .InsertAfter Text:="成绩：" + 等级

        .InsertParagraphAfter

        .InsertAfter Text:="评语：" + 评语

        .InsertParagraphAfter

        .InsertAfter Text:="批改人：周竹荣"

        .InsertParagraphAfter

        With .Font

            .Size = 16

           

            .Color = wdColorRed

           .Bold = True

        End With

    End With

   oDoc.Range(oTable.Rows(1).Cells(1).Range.Start,oTable.Rows(1).Cells(1).Range.End).Select

    Selection.ParagraphFormat.Alignment =wdAlignParagraphLeft      '左对齐

   

  

   

   

End Sub

 

 

Function 批改作业(评语 As String,等级 As String) As Integer

  Dim myDialog As FileDialog, oFile As Variant,oDoc As Document

  Set myDialog =Application.FileDialog(msoFileDialogFilePicker)

  With myDialog

    .Filters.Clear

    .Filters.Add "所有 WORD 文件","*.doc,*.docx", 1

    .AllowMultiSelect = True

    If .Show <> -1 Then Exit Function

    Dim count As Integer

    count = .SelectedItems.count

    For Each oFile In .SelectedItems

        Set oDoc =Documents.Open(FileName:=oFile, Visible:=False)

        Call 插入批改文字(oDoc, 评语, 等级)

        oDoc.Close True '关闭文档

    Next oFile

  End With

  批改作业 = count

EndFunction