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

Excel Application not closing from MS-Project VBA

以下子未关闭 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

在应该关闭实例的最后写 Application.Quit

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


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

您的函数 GetColumnLetter(在 MS Project 中)使用 Excel Cells 对象而不引用父对象(例如 worksheet 对象)。当该代码在 Excel 中本机运行时,Excel 隐式使用活动 sheet。但是,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 property indicates whether or not the file has been saved. Setting this to True will mean that you are not prompted to save changes when the file is closed and changes won't be saved. Your code makes changes to the file which appear something you actually want to save. Consider using the SaveChanges parameter of the Workbook Close方法显式保存修改与否。