Excel应用程序未从MS-Project VBA关闭

时间:2017-10-12 09:35:36

标签: excel vba excel-vba ms-project

以下子项未关闭Excel应用程序。它仍然在任务管理器中。这有点奇怪,因为我使用相同的方法来打开和关闭其他模块中的工作簿,它的工作原理。此代码位于MS-Project中。

Sub updateModules()

    'TESTE INICIAL PARA SABER SE AS INFORMAÇÕES BÁSICAS ESTÃO INSERIDAS
    If sanity_test = 0 Then
        Exit Sub
    End If
    '--------------------------------//--------------------------------

    Dim xlapp As Object
    Dim xlbook As Object
    Dim sHostName As String

    ' Get Host Name / Get Computer Name
    sHostName = Environ$("username")

    Set xlapp = CreateObject("Excel.Application")
    'xlapp.Visible = True
    Set xlbook = xlapp.Workbooks.Open(modulesVBA_loc)

    'ENCONTRAR CÓDIGO NA TABELA DO FICHEIRO MASTER
    Dim rng_modules As Range
    Dim rng_usernames As Range
    Dim username As Range
    Dim atualizado As Range
    Dim lastcol As Long


    With xlbook.Worksheets(1)
        'Última coluna
        lastcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
        lastcol_letter = Functions_mod.GetColumnLetter(lastcol)
    End With

    'Range com os usernames
    Set rng_usernames = xlbook.Worksheets(1).Range("E2:" & lastcol_letter & "2")
    'Encontra o username correto
    Set username = rng_usernames.Find(sHostName)

    Set rng_modules = xlbook.Worksheets(1).Range("A3")  'Primeiro módulo
    Do While rng_modules.Value <> Empty
        linha = rng_modules.Row
        Set atualizado = username.Offset(linha - 2)
        If atualizado.Value = "Not Updated" Then
            With ThisProject.VBProject
                .VBComponents.Remove .VBComponents("CoreTeam_mod")
                .VBComponents.Import supportDoc_loc & "Project\Próxima Actualização - Apenas PP pode modificar\VBA\Modules\CoreTeam_mod.bas"
            End With
            atualizado.Value = "Updated"
        End If
        Set rng_modules = rng_modules.Offset(1)
    Loop

    xlbook.Saved = True
    xlbook.Close

End Sub

修改: 似乎错误来自获取列字母的函数。我用字母“G”替换了lastcol_letter,代码运行正常并正确关闭Excel应用程序。我该怎么写这个函数呢?

Function GetColumnLetter(colNum As Long) As String
    Dim vArr
    vArr = Split(Cells(1, colNum).Address(True, False), "$")
    GetColumnLetter = vArr(0)
End Function

3 个答案:

答案 0 :(得分:1)

要打开excel应用程序,您可以使用以下代码:

Dim xlapp as Excel.application
Set xlapp = GetObject("", "Excel.Application")
' your other code goes here
xlapp.quit
End sub

答案 1 :(得分:0)

Write Application.Quit at the very end that should close the instance.

答案 2 :(得分:0)

您的函数GetColumnLetter(在MS Project中)使用Excel Cells对象而不引用父对象(例如工作表对象)。当该代码在Excel中本机运行时,Excel会隐式使用活动工作表。但是,MS Project不会对不合格的Excel引用执行此操作。

获取所需Range对象的更好方法是执行此操作:

Dim rng_usernames As Range
Dim lastcell As Range

    With xlbook.Worksheets(1)
        'Última coluna
        Set lastcell = .Cells(2, .Columns.Count).End(xlToLeft)
        'Range com os usernames
        Set rng_usernames = .Range("E2", lastcell)
    End With

End Sub

如果在宏完成后Excel仍在运行,请显式关闭并在宏的末尾将Excel对象设置为Nothing。

' close out
xlbook.Close SaveChanges:=True
xlapp.Quit 
Set xlbook = Nothing
Set xlapp = Nothing

注意:Workbook Saved属性指示文件是否已保存。将此设置为True意味着在文件关闭且未保存更改时,系统不会提示您保存更改。您的代码会对文件进行更改,这些更改会显示您实际要保存的内容。请考虑使用Workbook Close方法的SaveChanges参数明确保存更改。