Question

我在word visual basic上运行以下工作宏。每次运行它时，宏都会成功生成我想要的报告;但后来我查看了任务管理器，我发现excel的一个实例仍在运行。我在代码上运行调试器，调试器通过最后一行：

oExcel.quit

然而它仍然没有终止申请！

Sub WriteExtension()
'
' WriteExtension Macro
'
'
        copyFile

        Dim nWord As New Document
        word.Application.ScreenUpdating = False
        Set nWord = Documents.Open("c:\output\report\here\report", Visible:=False)

        'initialize excel variables
        Dim oExcel As Excel.Application
        Dim oWorkbook As workbook
        Dim oWorksheet As worksheet

        'initialize excel object
        Set oExcel = New Excel.Application
        oExcel.ScreenUpdating = False
        Set oWorkbook = oExcel.Workbooks.Open("c:\spreadsheet\here\spreadsheet.xlsx")
        Set oWorksheet = oWorkbook.Worksheets(Sheets("Extensions").Index)
        'setup loop variables

        Dim tempString As String
        Dim delim As String

        Dim i As Long
        Dim bkMark As Bookmark
        Dim questions(13) As String

        questions(0) = 13
        questions(1) = 15
        questions(2) = 17
        questions(3) = 19
        questions(4) = 29
        questions(5) = 31
        questions(6) = 33
        questions(7) = 36
        questions(8) = 38
        questions(9) = 40
        questions(10) = 42
        questions(11) = 46
        questions(12) = 48

        delim = "#"

        tempString = delim & Join(questions, delim)

        Dim bmrange As Range

        For i = 1 To 78

            If (InStr(1, tempString, delim & i & delim, vbTextCompare)) Then
                Set bmrange = nWord.Bookmarks("BM" & (i)).Range
                If (Cells(4, i + 6) = 1) Then
                    nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = True
                Else
                    nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = False
                End If

            ElseIf (InStr(1, tempString, delim & (i - 1) & delim, vbTextCompare)) Then

                Set bmrange = nWord.Bookmarks("BM" & (i)).Range
                If (Cells(4, i + 6) = 1) Then
                    nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = True
                Else
                    nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = False
                End If
            Else
                nWord.Bookmarks.Item("BM" & i).Range.InsertAfter (Cells(4, i + 6))

            End If

        Next i

        Dim filePath As String
        Dim fileName As String
        Dim newName As String

     '   save the file as a PDF and close the PDF
        filePath = "c:\output\report\here\report"
        fileName = Cells(4, 13) & Cells(4, 12) & Cells(4, 79) & ".pdf"
        newName = filePath & fileName
        nWord.SaveAs2 fileName:=newName, FileFormat:=wdFormatPDF

    '   Close things
        nWord.Close False
        oWorkbook.Close False
        oExcel.Quit

End Sub

Answer 1

我怀疑您的问题与您的不合格Sheets和Cells引用相关。

Set oWorksheet = oWorkbook.Worksheets(Sheets("Extensions").Index)应该只是Set oWorksheet = oWorkbook.Worksheets("Extensions")（当你只能通过名称索引时，不需要通过使用其名称获取工作表的索引来获取工作表的索引） Cells(4, i + 6)应该是oWorksheet.Cells(4, i + 6)。

我可以在进行这些更改之前复制您的问题（尽管有时候代码会崩溃），但是一旦我修复了它们，Excel正确地关闭了End Sub。（oExcel.Quit之后它没有消失，因为oExcel还没有Nothing。）

Sub WriteExtension()
'
' WriteExtension Macro
'
'
    copyFile

    Dim nWord As New Document
    word.Application.ScreenUpdating = False
    Set nWord = Documents.Open("c:\output\report\here\report", Visible:=False)

    'initialize excel variables
    Dim oExcel As Excel.Application
    Dim oWorkbook As workbook
    Dim oWorksheet As worksheet

    'initialize excel object
    Set oExcel = New Excel.Application
    oExcel.ScreenUpdating = False
    Set oWorkbook = oExcel.Workbooks.Open("c:\spreadsheet\here\spreadsheet.xlsx")
    Set oWorksheet = oWorkbook.Worksheets("Extensions")
    'setup loop variables

    Dim tempString As String
    Dim delim As String

    Dim i As Long
    Dim bkMark As Bookmark
    Dim questions(13) As String

    questions(0) = 13
    questions(1) = 15
    questions(2) = 17
    questions(3) = 19
    questions(4) = 29
    questions(5) = 31
    questions(6) = 33
    questions(7) = 36
    questions(8) = 38
    questions(9) = 40
    questions(10) = 42
    questions(11) = 46
    questions(12) = 48

    delim = "#"

    tempString = delim & Join(questions, delim)

    Dim bmrange As Range

    For i = 1 To 78

        If (InStr(1, tempString, delim & i & delim, vbTextCompare)) Then
            Set bmrange = nWord.Bookmarks("BM" & (i)).Range
            If oWorksheet.Cells(4, i + 6) = 1 Then
                nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = True
            Else
                nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = False
            End If

        ElseIf InStr(1, tempString, delim & (i - 1) & delim, vbTextCompare) Then

            Set bmrange = nWord.Bookmarks("BM" & (i)).Range
            If oWorksheet.Cells(4, i + 6) = 1 Then
                nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = True
            Else
                nWord.ContentControls.Add(wdContentControlCheckBox, bmrange).Checked = False
            End If
        Else
            nWord.Bookmarks.Item("BM" & i).Range.InsertAfter (oWorksheet.Cells(4, i + 6))

        End If

    Next i

    Dim filePath As String
    Dim fileName As String
    Dim newName As String

 '   save the file as a PDF and close the PDF
    filePath = "c:\output\report\here\report"
    fileName = oWorksheet.Cells(4, 13) & oWorksheet.Cells(4, 12) & oWorksheet.Cells(4, 79) & ".pdf"
    newName = filePath & fileName
    nWord.SaveAs2 fileName:=newName, FileFormat:=wdFormatPDF

'   Close things
    nWord.Close False
    oWorkbook.Close False
    oExcel.Quit

    'Optional: Set Excel objects to Nothing so that Excel closes now instead of at End Sub
    Set oWorkbook = Nothing
    Set oExcel = Nothing

End Sub

Excel没有关闭

1 个答案: