2017-10-12 99 views
0

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

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 

回答

1

打开Excel应用程序,你可以使用代码是这样的:


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

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

+0

谢谢,但它不起作用。 – peetman

+0

我编辑了这个问题。找到根源,现在只需要修复。 – peetman

+0

@peetman尝试编写Application.Quit并查看会发生什么。 –

0

你的功能GetColumnLetter(在MS项目),使用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参数来显式保存更改。