电子表格如何用代码来关闭，打开就关不了，各种方法都试过，没用

Private Sub Image2_Click()
    On Error GoTo err1
   
   
    Dim ZJStr() As String '章节列表
    Dim ZJId() As String
   
    Dim FileStr As String
     FileStr = AppStr & "试题批量导入模板.xls"
    If FileStr = "" Then
        Exit Sub
    End If
   
   
    Label1.Caption = "正在分析章节信息，请稍后！"
   
    Dim Sql As String
    Dim MsgTxt As String
    Dim Rs_Zj As ADODB.Recordset
    Dim Rs As ADODB.Recordset
   
   
    Sql = "select * from zjinfo "
    Set Rs_Zj = ExecuteSQL(Sql, MsgTxt)
   
    If InStr(MsgTxt, "错误") Then
        MsgBox MsgTxt
        Exit Sub
    End If
   
    ReDim ZJStr(0)
    ReDim ZJId(0)
    If Rs_Zj.RecordCount > 0 Then '========================获取章节信息 如果有
   
        For i = 1 To Rs_Zj.RecordCount
            ReDim Preserve ZJStr(i)
            ReDim Preserve ZJId(i)
            
            ZJStr(i) = Rs_Zj.Fields("zjname") & ""
            ZJId(i) = Rs_Zj.Fields("zjid") & ""
            Rs_Zj.MoveNext
        Next i
        
        
    End If
   
   
    Sql = "select * from tminfo"
    Set Rs = ExecuteSQL(Sql, MsgTxt)
    If InStr(MsgTxt, "错误") Then
        MsgBox MsgTxt
        Exit Sub
    End If
   
   
   
    Dim NewApp
    Dim NewSheet
    Dim NewBook
   
    Set NewApp = New Excel.Application
    Set NewBook = NewApp.Workbooks.Open(FileStr, , , , "")
    '第一位为路径，第五位为密码
    Set NewSheet = NewBook.Worksheets(1)
   
    For i = 2 To NewSheet.Cells.Count
        
        Label1.Caption = "正在读取第" & i & 项
        DoEvents
        If Trim(NewSheet.Cells(i, 1)) = "" Then
            Exit For
        End If
        
        '先判断该章节是否已经添加
        
        For j = 1 To UBound(ZJId)
            
            If ZJStr(j) = Trim(NewSheet.Cells(i, 8)) Then
                Exit For
            End If
        Next j
        
        If j > UBound(ZJId) Then '没有找到
            
            Rs_Zj.AddNew
            Rs_Zj.Fields("zjname") = Trim(NewSheet.Cells(i, 8))
            Rs_Zj.Update
            
            ReDim Preserve ZJStr(j)
            ReDim Preserve ZJId(j)
            
            ZJStr(j) = Trim(NewSheet.Cells(i, 8))
            ZJId(j) = Rs_Zj.Fields("zjid") & ""
        
        End If
        
        
        Rs.AddNew
        
        
        Text8.Text = Trim(NewSheet.Cells(i, 1))
        Rs.Fields("TMStra") = jm(Text8.Text)
        
        Dim a As String
        
        If Len(NewSheet.Cells(i, 2)) > 2 Then
            a = Left(NewSheet.Cells(i, 2), 2)
            If InStr(a, "A") Then
                NewSheet.Cells(i, 2) = Mid(NewSheet.Cells(i, 2), 2, Len(NewSheet.Cells(i, 2)))
            End If
        End If
        
        
        If Len(NewSheet.Cells(i, 3)) > 2 Then
            a = Left(NewSheet.Cells(i, 3), 2)
            If InStr(a, "B") Then
                NewSheet.Cells(i, 3) = Mid(NewSheet.Cells(i, 3), 2, Len(NewSheet.Cells(i, 3)))
            End If
        End If
        
        
        If Len(NewSheet.Cells(i, 4)) > 2 Then
            a = Left(NewSheet.Cells(i, 4), 2)
            If InStr(a, "C") Then
                NewSheet.Cells(i, 4) = Mid(NewSheet.Cells(i, 4), 2, Len(NewSheet.Cells(i, 4)))
            End If
        End If
        
        
        If Len(NewSheet.Cells(i, 5)) > 2 Then
            a = Left(NewSheet.Cells(i, 5), 2)
            If InStr(a, "D") Then
                NewSheet.Cells(i, 5) = Mid(NewSheet.Cells(i, 5), 2, Len(NewSheet.Cells(i, 5)))
            End If
        End If
        
        
        
        If Len(NewSheet.Cells(i, 6)) > 2 Then
            a = Left(NewSheet.Cells(i, 6), 2)
            If InStr(a, "E") Then
                NewSheet.Cells(i, 6) = Mid(NewSheet.Cells(i, 6), 2, Len(NewSheet.Cells(i, 6)))
            End If
        End If
        
        
        
        
        
        
        
        
        Rs.Fields("XXA") = jm(Trim(NewSheet.Cells(i, 2)))
        Rs.Fields("XXB") = jm(Trim(NewSheet.Cells(i, 3)))
        Rs.Fields("XXC") = jm(Trim(NewSheet.Cells(i, 4)))
        Rs.Fields("XXD") = jm(Trim(NewSheet.Cells(i, 5)))
        Rs.Fields("XXE") = jm(Trim(NewSheet.Cells(i, 6)))
        Rs.Fields("ZJID") = ZJId(j)
        Rs.Fields("STJX") = jm(Trim(NewSheet.Cells(i, 9)))
        Rs.Fields("TMFS") = jm(Trim(NewSheet.Cells(i, 10)))
        
        
        
        If Len(Trim(NewSheet.Cells(i, 7))) = "1" Then
                    
                If Trim(UCase(NewSheet.Cells(i, 7))) = "A" Or Trim(UCase(NewSheet.Cells(i, 7))) = "B" Or Trim(UCase(NewSheet.Cells(i, 7))) = "C" Or Trim(UCase(NewSheet.Cells(i, 7))) = "D" Or Trim(UCase(NewSheet.Cells(i, 7))) = "E" Then
                    Rs.Fields("TMtype") = "单选"
                    
                    Select Case Trim(NewSheet.Cells(i, 7))
                        Case "A"
                           Rs.Fields("TMDA") = 0
                        Case "B"
                            Rs.Fields("TMDA") = 1
                        Case "C"
                            Rs.Fields("TMDA") = 2
                        Case "D"
                            Rs.Fields("TMDA") = 3
                        Case "E"
                            Rs.Fields("TMDA") = 4
                    End Select
                    
                    
                    
                End If
               
                If Trim(NewSheet.Cells(i, 7)) = "0" Or Trim(NewSheet.Cells(i, 7)) = "1" Then
                    Rs.Fields("TMtype") = "判断"
                    Rs.Fields("TMDA") = Trim(NewSheet.Cells(i, 7))
                    
                    
                End If
               
            Else
                Rs.Fields("TMtype") = "多选"
               
                Dim DXStr As String
               
                DXStr = ""
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "A") Then
                        DXStr = DXStr & "0"
                    Else
                        DXStr = DXStr & "8"
                    End If
                    
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "B") Then
                        DXStr = DXStr & "1"
                    Else
                        DXStr = DXStr & "8"
                    End If
                    
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "C") Then
                        DXStr = DXStr & "2"
                    Else
                        DXStr = DXStr & "8"
                    End If
                    
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "D") Then
                        DXStr = DXStr & "3"
                    Else
                        DXStr = DXStr & "8"
                    End If
                    
                    If InStr(Trim(NewSheet.Cells(i, 7)), "E") Then
                        DXStr = DXStr & "4"
                    Else
                        DXStr = DXStr & "8"
                    End If
                    
               
               
                 Rs.Fields("TMDA") = jm(DXStr)
            End If
            
            Rs.MoveNext
            
        
        
    Next i
   
    Label1.Caption = "读取完毕！共读取" & i - 2 & "个记录"
   
    Rs.MoveFirst
   
    Label1.Caption = "正在重新分配题目号码！"
   
    For i = 1 To UBound(ZJId)
        DoEvents
        Sql = "select * from tminfo where zjid=" & ZJId(i)
        Set Rs = ExecuteSQL(Sql, MsgTxt)
        Label1.Caption = "正在重新分配题目号码 ID：" & ZJId(i)
        
        If Rs.RecordCount > 0 Then
            
            
            For j = 1 To Rs.RecordCount
                DoEvents
                Rs.Fields("TMNum") = j
                Rs.Update
               
                Label1.Caption = "正在重新分配题目号码 ID：" & ZJId(i) & " 题目号码：" & j
                Rs.MoveNext
            Next j
            
         
            
            
        End If
        
   
   
    Next i
   
   

         If MsgBox("题目导入完毕！请将本文件夹中的TK文件复制到【给客户使用文件夹】即可！", vbQuestion Or vbOKCancel, "消息询问") = vbOK Then
      
        End
    End If
      
   
   
    Text9.Text = ""
    Main.add_zj
    ListView2.HideSelection = False
    ListView1.HideSelection = False
   
    If ListView2.ListItems.Count > 0 Then
   
        Call ListView2_ItemClick(ListView2.ListItems.Item(1))
    End If
   
   
err1:
    If Err.Number > 0 Then
        MsgBox Err.Description, vbCritical, "错误提示"
        Exit Sub
    End If
End Sub