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