ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 13762|回复: 9

[转帖]MS Project 中的高级VBA

[复制链接]

TA的精华主题

TA的得分主题

发表于 2005-1-21 21:37 | 显示全部楼层 |阅读模式

MS Project 中的高级VBA

作者:Glenn Minch

Glenn Minch是关键路径技术服务公司(Critical Path Technical Services,Inc.)的总裁和创始人。作为Microsoft解决方案供应商,该公司致力于利用Microsoft Project、Microsoft Office 和Visual Basic开发用户解决方案。Glenn先生的联系地址为:CPTS, Inc., PO Box 52771, Bellevue, WA 98005. CompuServe ID: 73513,403。

概述

在Microsoft Project中加入Microsoft VBA(Visual Basic for Applications),可使开发人员利用Microsoft Project作为整体解决方案的组成部分,迅速创建功能强大的应用程序。在本部分中,我们将初步探讨用于构造Microsoft Project 的复杂添加型应用程序的一些编程技巧。

我们还将对一个用Microsoft Project、Microsoft Excel电子数据表格程序以及VBA编程系统创建的应用程序进行检测。该应用程序是“真实世界”的解决方案,它的创建给客户提供途径,来分析那些仅使用Microsoft Project 无法分析的工程管理数据。其结论信息为测定工程的进程提供了一套标准或准则。在整篇论文的其他部分,我们将这个应用程序样例视为Project Metrics应用程序。

Project Metrics应用程序将用来演示VBA编程技巧的实际运用。所包括的多数代码段都取自Project Metrics应用程序。虽然此处并未列出应用程序的完整代码,但包括了一个完整的Project Metrics应用程序模块。

本文的代码模块包含这样一些过程,可用于管理Project Metrics应用程序所需的Microsoft Excel实例。

样例文件

该进程包括几个样例文件。这些样例文件包含了用于说明本文中所讨论的编程技巧的全部代码段。具体的样例文件如下:

  • PJ301A.MPP-一个Microsoft Project 4.0文件,包含本文所用的全部代码样例。此外,它还包含Project Metrics应用程序使用的完整代码模块,这些模块可管理应用程序所需的Microsoft Excel实例。工程计划是从ROLLOUT.MPT模板中复制的,该模板是Microsoft Project 中的一个样例。
  • PJ301B.XLS-一个Microsoft Excel文件,包含GetXLPrefs()过程中所用的对话框和代码。为了运行提供的样例代码,你必须将PJ301B.XLS复制到安装有Microsoft Project 的目录下(即包含WINPROJ.EXE的目录)。
  • PJDEMO.EXE-一个Microsoft Visual Basic 3.0应用程序,可用作宏FormatGantt()的对话框。该文件也必须被复制到WINPROJ.EXE同一目录下。
  • PJDEMO.FRM、PJDEMO.MAK-PJDEMO.EXE的源代码。
  • STATUS.MPP-一个Microsoft Project 文件,用于性能演示中状态消息的显示。

编程技巧

程序结构

由于本文旨在讨论高级编程技巧,对于基础程序结构,我们将不在此探讨。然而,有必要讨论一下For Each...Next语句,这是由于在某些Microsoft Project 对象集合中使用该语句时,需要考虑一些特殊问题。

For Each...Next

For Each...Next语句用于对象集合中的迭代。For Each语句还可用于数组中的迭代。在Microsoft Project 集合中使用For Each时,特别需要记住的是一些集合包含的成员可能为空。从下面的示例中可看到这种情况:

{bmc ZCK0A.WPG}

在本示例中,任务标识符4为空。因此,下列代码会出现运行时间错误91“对象变量未设置”的问题。

Sub ForEach()

Dim t As Task

For Each t In ActiveProject.Tasks

Debug.Print t.Name

Next t

End Sub

为解决这个问题,你必须在表达式中使用集合前,对集合的每个成员进行测试,确认其有效性。虽然可用TypeName函数来测试对象是否有效,但更为快捷的方法是测试对象是否为空。下面代码说明了这个技巧:

Sub ForEach()

Dim t As Task

For Each t In ActiveProject.Tasks

If Not (t Is Nothing) Then

Debug.Print t.Name

End If

Next t

End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-1-21 21:38 | 显示全部楼层

下面三类集合可包含空成员:

  • 工程
  • 任务
  • 资源

正如上面所提到的,For Each语句还可用于数组中的迭代。下面示例对此进行了演示:

Sub ForEach_Array()

Dim v_array As Variant

Dim v As Variant

v_array = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)

For Each v In v_array

Debug.Print v

Next v

End Sub

注意Array函数的使用,它创建了一个包含Variant数据类型的数组。For Each语句可用于任何数组。

激活应用程序

你经常需要从你的VBA代码中激活另一应用程序。一般而言,你可使用AppActivate方法激活一应用程序。

要使用AppActivate方法,你必须知道你希望激活的应用程序窗口标题的确切文本(不区分大小写)。由于通常你不知道标题的确切内容,你可以利用一个应用程序对象来获取窗口的标题。下面示例演示了这项技巧:

' 激活Microsoft Excel (Excel 必须已经处于运行状态)。

Sub ActivateExcel()

Dim oExcel As Object

Set oExcel = GetObject(, "Excel.Application.5")

AppActivate oExcel.Caption

End Sub

一个更复杂的示例包含的功能是:检查Microsoft Excel的一个实例是否已经处于运行状态,如果未运行,启动Microsoft Excel。由于Microsoft Excel实例可能以“看不见”的方式运行(也就是说,Microsoft Excel没有出现在Microsoft Windows 任务列表上),我们需要一种可检查看不见的Microsoft Excel实例的方法。要实现这点,我们将使用FindWindow函数。

FindWindow函数是Microsoft Windows API 函数,其申明如下:

Declare Function FindWindow Lib "USER" (ByVal lpClassName _ As String, ByVal lpWindowName As Long) As Integer

FindWindow函数将检索那些类名和窗口名与传给FindWindow的变量值匹配的窗口的窗口句柄。如果类名参数为空,则所有类匹配;同样,如果窗口名参数为空,则所有窗口名匹配。我们可充分利用此特性,将空值传给窗口名参数,然后传递我们所要搜索的应用程序类名。注意在上面的申明中,参数1pWindowName被申明为Long数据类型。这是因为空指针是作为长整数进行传递的,其值为零(0)。

不同应用程序的类名如下。虽然为了便于阅读,此处列出的类名采用的是大小写混用,但FindWindow函数是不区分大小写的。

  • Microsoft Project - "JWinproj-WhimperMainClass"
  • Microsoft Excel - "XLMain"
  • Microsoft Word - "OpusApp"
  • Microsoft Access - "OMain"

如果FindWindow没有找到与特定窗口类名相匹配的窗口,函数的返回值为0。下列代码段(取自Project Metrics应用程序的GetXLApp()函数)使用FindWindow来检查当前的Microsoft Excel实例。

Const XL_APPCLASS = "Excel.Application.5"

Const XL_WNDCLASS = "xlmain"

Const API_NULL = 0&

'检查Excel是否处于运行状态。

hWnd_xl = FindWindow(XL_WNDCLASS, API_NULL)

If hWnd_xl <> 0 Then

'至少有一个可用的Excel实例;试图获取对象引用。

Set obj_xl_app = GetObject(, XL_APPCLASS)

Else

'Excel并未运行。启动Excel并获取对象引用。

Set obj_xl_app = CreateObject(XL_APPCLASS)

End If

 

设置鼠标指针

与Visual Basic 3.0不同的是,对于需要指明应用程序“忙”的情况,VBA并未提供一种设置鼠标指针的简便方法。Microsoft Project 在冗长的运行中会出现“挂起”现象。利用Windows API的函数LoadCursor和SetCursor,我们可以把鼠标指针改变为标准的沙漏图标。

在你的VBA模块中加入下列申明和常量:

Declare Function SetCursor Lib "USER" (ByVal hCursor As _ Integer) As Integer

Declare Function LoadCursor Lib "USER" (ByVal hInstance _ As Integer, ByVal lpCursorName As Any) As Integer

Const INT_NULL = 0

Const IDC_WAIT = 32514&

下面示例表明了如何将光标设置为沙漏图标,然后再将光标复原。

' 将光标设置为沙漏图标,然后再将光标复原

Sub SetMousePointer()

Dim hPrevCursor As Integer '为原始的光标保存句柄

'光标源

Dim lCounter As Long

Dim nRtn As Integer

' 将光标设置为沙漏,并保存原始的光标

hPrevCursor = SetCursor(LoadCursor(INT_NULL, IDC_WAIT))

' 暂停片刻,这样我们可以看到沙漏

For lCounter = 1 To 1000000

Next lCounter

' 恢复为原始光标

nRtn = SetCursor(hPrevCursor)

End Sub

 

模块

VBA代码储存在代码模块中。模块可储存在单独的工程文件(*.MPP)中或全局文件(GLOBAL.MPT)中。模块可包含过程中的变量和常量的申明。

选择一个有效的模块结构

程序设计员在组织模块的方式上有很大的发挥余地。组织模块的方式可以帮助或者妨碍开发的结果。

下面示例说明了一种有效的模块组织方法。该例取自Project Metrics应用程序。

' 本模块包含的过程的功能是为其他程序提供xl辅助函数。本模块的所有过程都不控制工程数据。

' 包含在本模块中的过程:

' Sub GoToMetrics()

' Function GetUserPref(oXL As Object, utPref As _

' utPrefStruct) As Boolean

' Function GetXLBook(oXLBook As Object, Status As _

' Integer, Optional sTemplate As Variant) As Boolean

' Function GetXLApp(oXLApp As Object) As Boolean

' Function KillXL(Optional xl_obj As Variant) As Boolean

' Sub MakeXLVisible()

各模块的前几行是对模块内容所作的简要描述。在开发大型工程时,这些描述是很重要的,它可帮助程序维护员进一步修改应用程序。

紧随模块描述之后的部分包括模块中每个程序的程序标题。程序标题与实际程序完全匹配是非常重要的。标题部分的作用包括:

  • 立即指明在给定模块中所包含的程序;
  • 允许程序设计员用鼠标右键单击过程名并选择“程序定义”的方法,快速转到给定过程;
  • 为给定过程提供了一种快速查找相应命令和变量类型的方法。

模块申明部分应紧放在注释和过程列表后。

' **** 开始模块申明 ****

Option Explicit

Option Compare Text ' 文本比较不区分大小写

Private obj_xl_app As Object ' 该对象用于存储当前Excel应用程序的一个引用

Private obj_xl_book As Object '该对象用于存储当前Excel工作簿的一个引用

' **** 结束模块申明 ****

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-1-21 21:38 | 显示全部楼层

模块的申明部分应清楚标识,将它与随后的过程分隔开。通常,在模块中或全局申明的变量应具有注释,以指明这些变量的用途。

Option Private语句

Microsoft Project 中包括的VBA_PJ.HLP文件指出“Option Private使用在模块级,用来声明整个模块都是私有的”。这种说明可能会引起误解,因为它暗示着,如果在模块申明中加入Option Private语句,则包含在模块中的所有数据和过程都是该模块私有的。

Option Private语句意味着不能从另一工程的模块中的过程调用私有模块中的过程。包含在私有模块中的过程可从该模块所在的工程文件中的其他任何模块调用。

如果用关键字Public在私有模块申明一个变量,该变量在工程中的其他所有模块中是可见的。而且,位于私有模块中的Sub过程仍将出现在“工具”菜单“宏”选项的宏列表中。

Option Private语句可在过程间存在引用时,有效防止不同工程的过程间命名的冲突。

获取用户的输入

VBA没有提供对话,因此Microsoft Project 不支持用户定义的对话框。获取用户输入的主要方法是InputBox函数。虽然InputBox可用来获取简单的用户输入,但该函数不允许使用公用控件,如Optionbutton(选项按钮)、Checkbox(复选框)和Listbox(列表框)。

针对该问题的解决方案是使用Microsoft Excel或Microsoft Visual Basic 3.0中创建的对话框,来获取用户对你编写的宏的输入。然而,这种方案会引起另一问题:怎样将对话框中的信息传回给Microsoft Project 宏?

使用Microsoft Excel,你可通过定义的应用程序的宏,将自变量传给一个宏。虽然Microsoft Project 支持宏,但它不允许你将自变量传给宏。

有几种方法可将用户的输入返回给Microsoft Project 的宏。你可使用DDE、OLE、全局存储区、剪贴板或文本文件。我们将在此处检测使用OLE的方法,虽然它并不是最快的方法,但它易于执行并且可靠。

下列流程图说明了这一基本概念。

{bmc ZCK1A.WPG}

在这个流程图中,发生的行为如下(按先后顺序):

1. 一个Microsoft Project 宏使用AppExecute方法,以启动一个Visual Basic 3.0窗体。Visual Basic窗体作为Microsoft Project宏获取用户输入的对话框。下列代码是取自本文中的示例。

Sub FormatGantt()

' 显示VB对话框以获取用户的输入。

AppExecute Command:=Application.Path & "\pjdemo.exe" _ ,Activate:=True

End Sub

2. Visual Basic窗体处理获取用户输入的任务。当用户完成输入并选择“确定”或“取消”键时,Visual Basic 窗体会建立一个到Microsoft Project 的OLE连接。

Dim oProj as Object

Set oProj = GetObject(, "msproject.application")

3. Visual Basic 窗体将获得的用户输入值赋值给某个预先确定的工程总计任务字段。在本文(PJDEMO.EXE)提供的示例中,Visual Basic 窗体赋值给Text10字段。

If index = 0 Then '按下“确定”键

oProj.Activeproject.Text10 = cboColor.List(cboColor.ListIndex)

Else '按下“取消”键

oProj.Activeproject.Text10 = "Cancel"

End If

4. Visual Basic 窗体激活Microsoft Project 。然后,Visual Basic 窗体使用Macro方法,启动处理用户输入的Microsoft Project 宏。在Microsoft Project 宏启动后,Visual Basic 自动从内存中卸载。

' 运行Microsoft Project 宏,处理用户的选择

AppActivate oProj.Caption

oProj.macro "DoFormatGantt"

End

5. Microsoft Project宏检测用户的输入,并采取相应的动作。

' VB对话框调用下面的子过程,以处理用户的选择

Sub DoFormatGantt()

Dim sMsg As String

Dim nColor As Integer

Const pjNoAction = -1

'检查Text10的工程任务属性,确定下一步应做什么

Select Case ActiveProject.Text10

Case "cancel"

sMsg = "用户按下取消键"

nColor = pjNoAction

Case "black"

sMsg = "用户选择黑"

nColor = pjBlack

Case "red"

sMsg = "用户选择红"

nColor = pjRed

Case "yellow"

sMsg = "用户选择黄"

nColor = pjYellow

Case "blue"

sMsg = "用户选择蓝"

nColor = pjBlue

Case "green"

sMsg = "用户选择绿"

nColor = pjGreen

Case Else

sMsg = "从对话框返回的值无效"

nColor = pjNoAction

End Select

If nColor <> pjNoAction Then GanttBarFormat middlecolor:=nColor

MsgBox sMsg, vbInformation + vbOKOnly, "Format Gantt Bar"

End Sub

这种一般方法可延伸到Visual Basic3.0以外的其他应用程序。PJ301A.MPP中的XL代码模块包含调用Microsoft Excel对话框、获取用户输入的过程,其过程名为GetUserPref()。

Project VBA性能问题

测定性能

为了在你的代码中突出性能问题,你需要能够精确测定你的程序速度。GetTickCount函数可为我们提供这种检测能力。

GetTickCount是Windows API函数,它返回从Windows当前进程启动开始到当前时刻为止所消耗的毫秒数。该函数可在Project代码模块中申明:

Declare Function GetTickCount Lib "USER" () As Long

计算该函数在一个程序的起始时刻与结束时刻之间的差值,可对程序的性能进行准确的测定。下面示例说明在一种简单情况下该函数的使用。

' 该子过程显示运行For...Next循环所需的毫秒数

Sub TimeLoop()

Dim lBegin As Long ' 计时的起始时间

Dim lEnd As Long ' 计时的结束时间

Dim lIndex As Long ' 循环指数

lBegin = GetTickCount()

For lIndex = 1 To 60000

Next lIndex

lEnd = GetTickCount()

MsgBox "消耗的时间为: " & (lEnd - lBegin) & "毫秒。"

End Sub

我们将在整个进程中使用该方法,以说明在不同情况下的代码性能。

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-1-21 21:39 | 显示全部楼层

屏幕更新

当你在创建Microsoft Project 宏时,遇到的主要性能障碍之一是,宏在执行时不能关闭屏幕更新。Microsoft Project Application对象与Microsoft Excel不同,它不包括ScreenUpdating属性。为此,Microsoft Project 在执行宏时,要占用大量的时间刷新其应用程序窗口。如果显示的是甘特进度图(Gantt Chart)之类的高密度图形,更新这个恒定的屏幕可能导致性能大大降低。

为说明当前视图对宏性能的影响,试试下面的示例。该示例将同一循环运行四次,并且每次都将工程中的任务的Flag1字段设为True。每次循环的活动视图不同。不同视图之间的性能差异显示在消息框中。注意,为简化代码,在测试宏中不检查任务是否为空,一个“真实”的宏通常必须对空任务进行检查。

' 本子过程将四个不同视图中所有任务的Flag1字段设为True。

Sub SetFlagTest1()

Dim tskIndex As Task ' Task集合的指数

Dim lBegin As Long ' 计时的开始时间

Dim lEnd As Long ' 计时的结束时间

Dim lGantt As Long ' 在Gantt视图中执行的时间

Dim lTSheet As Long ' 在Task Sheet视图中执行的时间

Dim lRSheet As Long ' 在Resource Sheet视图中执行的时间

Dim lEdit As Long ' 在Module Editor视图中执行的时间

ViewApply "Gantt Chart"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lGantt = lEnd - lBegin

ViewApply "Task Sheet"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lTSheet = lEnd - lBegin

ViewApply "Resource Sheet"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lRSheet = lEnd - lBegin

ViewApply "Module Editor"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lEdit = lEnd - lBegin

MsgBox "Elapsed times:" & Chr(10) & _

"Gantt - " & lGantt / 1000 & " s." & Chr(10) & _

"Task Sheet - " & lTSheet / 1000 & " s." & Chr(10) & _

"Resource Sheet - " & lRSheet / 1000 & " s." & _ Chr(10) & "Editor - " & lEdit / 1000 & " s."

End Sub

在样例Rollout工程(包含在Microsoft Project 产品中的ROLLOUT.MPT文件)中运行这个宏,可得到下列类似结果:

{bmc ZCK2A.WPG}

注意,由于只有任务数据得到更新,Microsoft Project 仅在任务视图中重画窗口,因此在Module Editor和Resource Sheet视图中的执行时间实际上是相等的。

作为应用不同视图的备用方法,你可以只将应用程序窗口最小化。当最小化窗口时,Microsoft Project 就不需要重画其窗口,这样你的代码执行速度几乎与代码在Module Editor视图中运行的速度相同。

试试以下对上一示例的修改:

' 本子过程将四个不同视图中的所有任务的Flag1字段设为True。

Sub SetFlagTest2()

Dim tskIndex As Task ' Task集合的指数

Dim lBegin As Long ' 计时的开始时间

Dim lEnd As Long ' 计时的结束时间

Dim lGantt As Long ' 在Gantt视图中执行的时间

Dim lTSheet As Long ' 在Task Sheet视图中执行的时间

Dim lRSheet As Long ' 在Resource Sheet视图中执行的时间

Dim lEdit As Long ' 在Module Editor视图中执行的时间

' 最小化Project应用程序窗口

Application.WindowState = pjMinimized

ViewApply "Gantt Chart"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lGantt = lEnd - lBegin

ViewApply "Task Sheet"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lTSheet = lEnd - lBegin

ViewApply "Resource Sheet"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lRSheet = lEnd - lBegin

ViewApply "Module Editor"

lBegin = GetTickCount()

For Each tskIndex In ActiveProject.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lEdit = lEnd - lBegin

' 恢复Project应用程序窗口

Application.WindowState = pjNormal

MsgBox "消耗的时间为:" & Chr(10) & _

"Gantt - " & lGantt / 1000 & " s." & Chr(10) & _

"Task Sheet - " & lTSheet / 1000 & " s." & Chr(10) & _

"Resource Sheet - " & lRSheet / 1000 & " s." & _ Chr(10) & "Editor - " & lEdit / 1000 & " s."

End Sub

在同一Rollout工程中运行该过程,得出下列结果:

{bmc ZCK3A.WPG}

注意,对于这种最小化情况,所有情况的代码实际执行速度相同。

TA的精华主题

TA的得分主题

 楼主| 发表于 2005-1-21 21:39 | 显示全部楼层

在执行你的代码时,最小化Microsoft Project的主要缺陷是几乎不能给用户提供宏进程的目视反馈。至少在任务视图可见时,屏幕闪烁可表明宏仍在运行。对于宏的时间消耗,用户通常愿意多占用一些时间来换取更好的目视反馈。一种折衷的好方法是创造性地使用伪工程。

创建一个你可用来填充应用程序窗口的伪工程,这样做的好处有两点:一是消除了大量的屏幕重绘;二是提供了显示状态消息的良好中介。为了有效地利用这种方法,你必须先创建一个用来提供状态消息的工程。参考一下提供的STATUS.MPP文件,这个工程中包含一个单任务,并在自定义的名为“Macor Status(宏状态)”的PERT视图处于活动时得以保存。当我们的宏运行时,我们打开这个文件,并利用显示的单任务框来为用户提供状态消息。

为说明这个过程,下面的宏在活动的工程的每个任务中运行两次,先将Flag1字段的值赋为True,再将Flag2字段的值也赋为True。

Sub SetFlagTest3()

Dim tskIndex As Task ' Tasks集合的指数

Dim tskStatus As Task ' 用来显示进程的任务

Dim prjStatus As Project ' 用来显示进程的工程

Dim prjCurrent As Project ' 当前的工程

Set prjCurrent = ActiveProject

FileOpen "status.mpp"

Set prjStatus = ActiveProject

Set tskStatus = prjStatus.Tasks(1)

ActiveWindow.Caption = "Macro Status"

tskStatus.Name = "Now setting task Flag1 fields..."

DoEvents ' 允许刷新视图

For Each tskIndex In prjCurrent.Tasks

tskIndex.Flag1 = True

tskStatus.Name = "Now processing task " & tskIndex.ID

Next tskIndex

tskStatus.Name = "Now setting task Flag2 fields..."

DoEvents ' 允许刷新视图

For Each tskIndex In prjCurrent.Tasks

tskIndex.Flag2 = True

tskStatus.Name = "Now processing task " & tskIndex.ID

Next tskIndex

FileClose pjDoNotSave

End Sub

注意,通过利用Microsoft Project延迟刷新显示的任务框的方法 ,宏可以实现在任务框中显示一条消息,同时在进入栏(entry bar)中显示另一消息。

为确定这些状态消息对宏的性能的实际影响,我们可使用下面的代码:

Sub SetFlagtest4()

Dim tskIndex As Task ' Tasks集合的指数

Dim lBegin As Long ' 计时的开始时间

Dim lEnd As Long '计时的结束时间

Dim lMsgFlag1 As Long ' 在状态消息下,赋值Flag1所用时间

Dim lMinFlag1 As Long ' 在应用程序窗口最小化下,赋值Flag1所用时间

Dim lMsgFlag2 As Long ' 在状态消息下,赋值Flag2所用时间

Dim lMinFlag2 As Long ' 在应用程序窗口最小化下,赋值Flag2所用时间

Dim tskStatus As Task ' 用于显示进程的任务

Dim prjStatus As Project ' 用于显示进程的工程

Dim prjCurrent As Project ' 当前的工程

Set prjCurrent = ActiveProject

FileOpen "status.mpp"

Set prjStatus = ActiveProject

Set tskStatus = prjStatus.Tasks(1)

ActiveWindow.Caption = "Macro Status"

lBegin = GetTickCount()

tskStatus.Name = "Now setting task Flag1 fields..."

DoEvents ' Allows view to refresh

For Each tskIndex In prjCurrent.Tasks

tskIndex.Flag1 = True

tskStatus.Name = "Now processing task " & tskIndex.ID

Next tskIndex

lEnd = GetTickCount()

lMsgFlag1 = lEnd - lBegin

lBegin = GetTickCount()

tskStatus.Name = "Now setting task Flag2 fields..."

DoEvents ' Allows view to refresh

For Each tskIndex In prjCurrent.Tasks

tskIndex.Flag2 = True

tskStatus.Name = "Now processing task " & tskIndex.ID

Next tskIndex

lEnd = GetTickCount()

lMsgFlag2 = lEnd - lBegin

FileClose pjDoNotSave

Application.WindowState = pjMinimized

lBegin = GetTickCount()

For Each tskIndex In prjCurrent.Tasks

tskIndex.Flag1 = True

Next tskIndex

lEnd = GetTickCount()

lMinFlag1 = lEnd - lBegin

lBegin = GetTickCount()

For Each tskIndex In prjCurrent.Tasks

tskIndex.Flag2 = True

Next tskIndex

lEnd = GetTickCount()

lMinFlag2 = lEnd - lBegin

Application.WindowState = pjNormal

MsgBox "Elapsed times with messages:" & Chr(10) & _

"Flag1 - " & lMsgFlag1 / 1000 & " s." & Chr(10) & _

"Flag2 - " & lMsgFlag2 / 1000 & " s." & Chr(10) & _

Chr(10) & "While minimized:" & Chr(10) & _

"Flag1 - " & lMinFlag1 / 1000 & " s." & Chr(10) & _

"Flag2 - " & lMinFlag2 / 1000 & " s."

End Sub

在一个有200个任务的工程中运行这个宏,你可得到下列类似结果:

{bmc ZCK4A.WPG}

注意,在这种情况下提供状态消息大约要增加30%的执行时间。虽然它会大大增加某些工程的执行时间,但用户通常还是愿意接受性能下降来换取持续的目视反馈。

最小直接对象处理

改善Microsoft Project 宏的性能的另一种方法是在可能的地方,使对代码中的对象的直接处理最小化。虽然在执行一些动作时,通常采用整个对象集合中进行迭代的简便方法,但如果使用Microsoft Project 的一些固有特征,将必须检测的对象数量最小化,则比迭代法快得多。下面是这项技巧的示例。

在本示例中(取自Project Metrics 应用程序),为确定是否有资源分配给任务,必须检测工程中的每个任务。下列代码段是通过检查分配给当前工程的任务集合中每个任务的资源数量来实现的:

' 给每个尚未分配任何资源的任务分配伪资源

tassign = 0

For Each t In ActiveProject.Tasks

If Not (t Is Nothing) Then

If t.Resources.Count < 1 Then

If tassign > 1000 Then Error err_assign_limit

t.Assignments.Add ResourceID:=oNewRes.ID

tassign = tassign + 1 'keeps track of the 'number of assignments made

End If

End If

Next t

前面的代码是有效的,但下面的示例会运行得更快。这两个示例的区别在于,后一个示例设置了一个任务过滤器,它可筛选出分配了资源的任务。这个筛选操作非常快,并可改善程序的性能达300%以上。

将常量cpts_nores_filter定义为任务过滤器,方法如下:

Field Name Test Value(s) And/Or

Resource Names Equals And

Milestone Equals No And

Summary Equals No

tassign = 0

FilterApply cpts_nores_filter

SelectAll

If Not ActiveSelection.Tasks Is Nothing Then

For Each t In ActiveSelection.Tasks

With t

If tassign > 1000 Then Error err_assign_limit

.Assignments.Add ResourceID:=oNewRes.ID

tassign = tassign + 1 'keeps track of the number of 'assignments made

End With

Next t

End If

1995 Microsoft 公司。

这些材料是仅为信息用途而提供的“原样”,微软公司和微软的供应商都不对这些材料的内容或此处包含的任何信息的正确性作出明确的或隐含的保证,包括不对某些特殊目的的商业性和适用性作出不加限制的隐含保证。上述限制不适用于某些不允许排除隐含保证的州/管辖区。

无论是微软公司还是微软的供应商都不对任何后续的、偶然的、直接的、间接的、特殊的损害或利益损失负任何责任。上述限制不适用某些不允许排除后续或偶然损害的州/管辖区。在任何情况下,微软及其供应商对由于这些材料引起的全部责任(不管是以侵权的、合同性的还是以任何其他方式引起)不得超过这些材料的建议零售价。

[此贴子已经被作者于2005-1-21 21:41:45编辑过]

TA的精华主题

TA的得分主题

发表于 2005-3-11 00:58 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2005-3-30 20:07 | 显示全部楼层

新手看不懂啊,虽然粗知VBA。

但能不能讲解一些应用和提高的PROJECT方法,二次开发是不是遥远了些。

TA的精华主题

TA的得分主题

发表于 2006-2-15 13:17 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2011-7-16 17:20 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

给MS project添加新功能:“秒”及可随意设置数值的小数点位数

给MS project添加时间单位“秒”及可随意设置数值的小数点位数!
在现在分秒必争的时代,project显得过时了,竟然没有时间单位“秒”,只有:年、月、周、日、时、
分。现在很多自动化生产线企业都要求任务“工期”时间精确到毫秒(1ms=0.001s),实际上就是自动化
设备、生产线所讲的“节拍”,因此project不能帮上忙。但它的确很好用,有没有办法呢?有!只要用
VBA编个小程序(或外挂或宏)就可以搞定:
1.往MS Project添加时间单位“秒”或更小一级“秒”和“毫秒”;
2.允许用户设置各列“数值”型的域的小数点位数。
    请编程高手努力!加油,你们一定行的。有好消息请第一个通知我:huntmay@126.com

TA的精华主题

TA的得分主题

发表于 2013-3-13 11:46 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-22 11:48 , Processed in 0.043032 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表