zoukankan      html  css  js  c++  java
  • 20181014xlVBA获取小题零分名单

    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
    

      

  • 相关阅读:
    JAVA RMI调用实战学习
    linux下关于压缩、解压相关的操作
    关于hessian接口类方法顺序及对象序列化的实战研究
    Java对象引用传递探索
    mysql 语句or效率问题
    树莓派做下载服务器 aria2 篇
    免费 cdn
    搞定迅雷固件在TP-LINK WR720N,127.0.0.1 9000 获取不到激活码
    Mware vCenter Server 识别固态硬盘为(非SSD)是什么原因?
    XXX esx.problem.syslog.nonpersistent.formatOnHost not found XXX
  • 原文地址:https://www.cnblogs.com/nextseven/p/9785566.html
Copyright © 2011-2022 走看看