使用 If/Then 和 Loop 设置大纲级别

Question

我正在尝试使用 VBA 代码在 MS Project 中设置大纲级别。

我在 MSProject 中拥有所有信息，并想根据“文本 1”列中的值设置列“大纲级别”列>

我无法设置列的类型，因为这些是由项目预设的。

我曾尝试将文本 1 中的值手动复制并粘贴到大纲级别，但项目不允许这样做，所以我想做一个 If/Then 语句来输入值。如果文本 1 是 1，那么大纲级别是 1，等等。我想在大纲级别中输入每个值，然后转到下一行并执行相同操作，直到每个大纲级别都已输入。

Sub OutLineLevel()

Set projApp = ActiveProject

Dim OutlineLevel As Long
Dim Text1 As Long
Dim i As Long

For i = 1 To 4

    
    If projApp.Text1(i, 0) = 1 Then
        projApp.OutlineLevel(i, 0) = 1
    ElseIf projApp.Text1(i, 0) = 2 Then
        projApp.OutlineLevel(i, 0) = 2
    ElseIf projApp.Text1(i, 0) = 3 Then
        projApp.OutlineLevel(i, 0) = 3
    ElseIf projApp.Text1(i, 0) = 4 Then
        projApp.OutlineLevel(i, 0) = 4
    Else: projApp.Text1(i, 0) = 5
    End If
Next i

End Sub

我在第一个“If”语句中得到“Property Not Defined”

Answer 1

这里是将任务的大纲级别设置为其 Text1 字段中的值的代码：

Sub SetOutlineLevel()

    Dim tsk As Task
    For Each tsk In ActiveProject.Tasks
        tsk.OutlineLevel = tsk.Text1
    Next tsk
    
End Sub

注意：Text1中的值必须有效（例如，第一个任务必须是级别1，大纲级别不能一次增加超过一个等）。

Answer 2

我不明白你为什么要从文本字段创建层次结构，但这里有一个非常简单的宏，可以做你想做的事。

顺便说一句，你得到错误的原因是因为你试图将 Text1 用作数组但它从未声明为数组。

Sub SetOutline()
Dim t As Task
For Each t In ActiveProject.Tasks
    If Not t Is Nothing Then
        t.OutlineLevel = t.Text1
    End If
Next t
End Sub

Answer 3

所以这是一个有趣的线程 - 我没有成功地搜索找到相反的解决方案。从 MS Project 中复制列并粘贴到 Excel 中会保持大纲级别的缩进（在粘贴过程中会神奇地插入空格）。但是使用 VBA 将 MS Proj 任务复制到 Excel 中时，缩进会丢失（使用 xlPasteSpecial 的 xlPasteValues 枚举）。是否有使用 VB 代码复制/粘贴以在 Excel 中保留大纲的不同方法，或者您是否必须遍历 Excel 中的所有行并根据大纲级别或 WBS 缩进？