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



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

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 & "ProjectPróxima Actualização - Apenas PP pode modificarVBAModulesCoreTeam_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

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


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

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

您的函数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 对象并将其设置为"无"。

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

注意: 属性指示文件是否已保存。如果将其设置为 True,则意味着在关闭文件时不会提示您保存更改,并且不会保存更改。您的代码对文件进行了更改,这些更改似乎是您实际想要保存的内容。请考虑使用工作簿关闭方法的 SaveChanges 参数显式保存或不保存更改。

相关内容

  • 没有找到相关文章

最新更新