Sub GetZeroName()
Dim Dic As Object
Const SUBJECT = "科目名称"
Dim Key As String
Dim OneKey
Dim Wb As Workbook
Dim Sht As Worksheet
Dim FolderPath As String
Dim FileName As String
Dim FilePath As String
Dim wdApp As Object
Dim wdDoc As Object
Const StartCol = "G"
Const EndCol = "X"
Set Dic = CreateObject("Scripting.Dictionary")
Set Wb = Application.ThisWorkbook
FolderPath = Wb.Path & "\"
Set Sht = Wb.Worksheets(1)
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
With Sht
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
For i = 2 To EndRow
Key = .Cells(i, 3).Text
Dic(Key) = ""
Next
For Each OneKey In Dic.Keys
FileName = OneKey & "班" & SUBJECT & "小题零分名单.docx"
On Error Resume Next
wdApp.documents(FileName).Close
On Error GoTo 0
FilePath = FolderPath & FileName
On Error Resume Next
Kill FilePath
On Error GoTo 0
report = OneKey & "班" & SUBJECT & "小题零分名单" & vbCrLf
For j = .Cells(1, StartCol).Column To .Cells(1, EndCol).Column
'Key = OneKey & ";" & .Cells(1, j).Text
report = report & vbCrLf & "【" & .Cells(1, j).Text & "】--------------------------------------------------------------------------------------------------------------" & vbCrLf & " "
For i = 2 To EndRow
If .Cells(i, 3).Text = OneKey Then
If .Cells(i, j).Value = 0 Then
report = report & .Cells(i, 2).Value & "；"
End If
End If
Next i
Next j
'Debug.Print "__________________________________________________________________________________"
'Debug.Print report
Set wdDoc = wdApp.documents.Add
wdDoc.SaveAs FilePath
wdApp.Selection.typetext report
wdDoc.Save
wdDoc.Close
Next OneKey
End With
wdApp.Quit
Set Wb = Nothing
Set Sht = Nothing
Set wdApp = Nothing
Set wdDoc = Nothing
End Sub
