【发布时间】：2021-10-27 01:25:56
【问题描述】：
我使用了上一个问题中的代码 sn-p（见下文）。
Open an existing Excel file and run a macro in that file through MS Project
当我自己运行它时，它可以正常工作，但是，当我将它放入我的代码中时，它就停止工作了。
为清楚起见进行了编辑 - 当我单步执行宏并到达应该触发宏的行时： xlApp.Run("'本周报告 - BLANK.xlsm'!apply_conditional_formatting") 代码只是越过顶部。此宏包含在 excel 文件中，并设置一些条件格式并输入一些文本以提供视觉确认它已被触发。这不会发生。 不会产生错误，代码只是表现得好像该特定行不存在。 当我进入excel文件并手动触发宏时，宏是有效的，所以宏不会引起问题，它似乎没有被触发。 在原始代码 sn-p 中使用时，可以从 MS Project 文件中触发宏。
谁能告诉我我做错了什么？ 我的代码如下。我将打开 excel 文件的代码块移到更靠近宏触发器的位置，以防中间代码中的某些东西阻止它工作，但这不起作用。
Sub use_excel_based_on_simple()
Dim xlApp As Object
Dim MyXL As Object
Dim Resource As Resource
Dim Version As String
Dim MSP_name As String
Dim finish As Date
Dim Res_name As String
Dim Res_email As String
Dim FileName As String
Dim rows As Integer
Dim xlWkb As Object
Dim myFilePath As String
Dim myfilename As String
Dim xlrange As Variant
On Error Resume Next
OutlineShowAllTasks
SelectBeginning ' restart from the beginning
finish = InputBox("Please enter the date for next Friday", "Date entry", Int(Now() + 8)) 'assumes that we will be running this on Thursday
For Each Resource In ActiveProject.Resources
If Not (Resource Is Nothing) Then
If Resource.Work > 0 Then
'setup and apply filter for each resource
FilterEdit name:="filter4people", TaskFilter:=True, Create:=True, OverwriteExisting:=True, FieldName:="Start", Test:="is less than or equal to", Value:=finish, ShowInMenu:=True, ShowSummaryTasks:=True
FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="% Complete", Test:="is less than", Value:="100%", Operation:="And", ShowSummaryTasks:=True
FilterEdit name:="filter4people", TaskFilter:=True, FieldName:="", NewFieldName:="Resource names", Test:="contains", Value:=Resource.name, Operation:="And", ShowSummaryTasks:=True
FilterApply "filter4people" ' apply the filter
Debug.Print "Resource: " & Resource.ID & "-" & Resource.name & "Error: " & Err.Number
If Not (Err.Number = 91 Or Err.Number = 0) Then ' saw an error applying filter
'MsgBox "ERROR: " & Err.Description
Debug.Print Resource.name & " ERROR: " & Err.Number & " " & Err.Description
Debug.Print "resource ID: " & Resource.ID
Err.Clear ' clear out the error
GoTo NextResource ' jump to the next resource
End If
Application.SelectSheet 'need to select the sheet so that ActiveSelection works properly
rows = CStr(ActiveSelection.Tasks.Count)
If Err.Number = 424 Then rows = 0 'traps the error which is caused when there is nothing to display in the filter and sets rows so that the file will not be saved.
Res_name = Resource.name
Res_email = Resource.EMailAddress
Version = Format(Now, "yyyy-mmm-dd hh-mm-ss")
myFilePath = ActiveProject.Path
myfilename = myFilePath & "\" & "Weekly Look ahead report - " & Res_name & " " & Version & ".xlsm"
' Set MyXL = CreateObject("Excel.Application")
' Set xlWkb = MyXL.Workbooks.Open("C:\Users\miles\OneDrive\Survitec\testing space\This week report - BLANK.xlsm")
' MyXL.Visible = True
' MyXL.ActiveWorkbook.Worksheets("Sheet1").Activate
' Set xlrange = MyXL.ActiveSheet.Range("A1")
'Put data to be transfered into array
Dim data() As String
Dim T As Task
Dim Ts As Tasks
Dim r As Integer
If rows > 0 Then
r = 1
Set Ts = ActiveSelection.Tasks
ReDim Preserve data(rows, 7)
For Each T In Ts
If Not (T Is Nothing) Then
data(r, 1) = T.Project
data(r, 2) = T.name
data(r, 3) = T.Start
data(r, 4) = T.finish
data(r, 5) = T.PercentComplete
data(r, 6) = T.ResourceInitials
data(r, 7) = T.Summary
r = r + 1
End If
Next T
Else
GoTo NextResource
End If
Application.SelectBeginning 'remove selection of MS Projct sheet to avoid issues if the user hits delete by accident
'setup excel file
Set MyXL = CreateObject("Excel.Application")
Set xlWkb = MyXL.Workbooks.Open("C:\Users\miles\OneDrive\Survitec\testing space\This week report - BLANK.xlsm")
MyXL.Visible = True
' MyXL.ActiveWorkbook.Worksheets("Sheet1").Activate
Set xlrange = MyXL.ActiveSheet.Range("A1")
'enter data into excel
xlrange.Range("A2:g" & rows + 1).Value = data()
Set Rng = xlrange.Range("c2:d" & rows + 1)
For Each Cell In Rng.Cells
Cell.Value = DateValue(Cell.Value)
Next Cell
For Each Cell In xlrange.Range("e2:e" & rows + 1).Cells
Cell.Value = Cell.Value * 0.01
Cell.NumberFormat = "0%"
Next Cell
'run macro to apply conditional formatting
xlApp.Run ("'This week report - BLANK.xlsm'!apply_conditional_formatting")
'save file if it contains data
If rows > 0 Then
MyXL.ActiveWorkbook.SaveAs myfilename
MyXL.ActiveWorkbook.Close
Else
MyXL.ActiveWorkbook.Close SaveChanges:=False
End If
MyXL.Quit
' Set MyXL = Nothing
'email file out to name and email.
End If ' - for work = 0
End If ' - for resource is blank
NextResource:
Next Resource
MyXL.Quit
Set MyXL = Nothing
FilterApply name:="All Tasks" ' apply the filter
MsgBox ("all done")
End Sub
【问题讨论】：
-
请解释您的确切问题，您期望什么，发生了什么或没有发生什么 - “代码停止工作”不足以让我们为您提供帮助。请阅读It's not working，然后改进您的问题。
-
@Ike，感谢您的回复，并为不够清晰深表歉意。希望我的编辑有助于澄清问题？
-
删除
On Error Resume Next- 这就是您没有收到任何错误的原因。然后再次运行代码。作为对未来代码的提醒：（几乎）永远不要使用On Error Resume Next- 实际上只有极少数情况下它是有意义的 - 如果是这样，总是评论你为什么使用它 -
第二：检查引用Excel应用程序、工作簿和工作表的不同变量的使用情况。老实说，看起来如果您不了解它们的用法。例如。您不需要像
Set xlWkb = MyXL.Workbooks.Open(那样写MyXL.ActiveWorkbook- 仅使用xlWkb因为这明确是您想要使用的 - 而不是隐含的 Excel 对象的 ActiveWorkbook。 -
@ike 感谢您的反馈，我将在明天进行这些更改，看看会发生什么。我不是一个训练有素的程序员，我倾向于通过结合思想和技术并通过实践来建立我的理解来进行 magpie 编程。考虑到这一点，我明白重新使用 xlWkb 与编写我们所有的 open(....) 表达式相同，这将试图重新打开一本已经打开的书。这是错的吗？它实际上只是打开书的简写吗？
标签： excel vba project office-automation