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方法显式保存修改与否。
以下子未关闭 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方法显式保存修改与否。