Question

我一直想尝试在VBA中使用一个列出所有可能的TableFields（？）的组合框来创建UserForm。

更新的代码： 使用@dbmitch提供的代码和一些自由样式。这将列出一个具有原始和自定义字段名称（如果存在）的两列组合框。它仅列出Activeproject中使用的字段。并非所有可能的字段。但是，如果该字段在Activeproject中没有使用，那可能是最好的选择！

Public strResult2 As String ' Used for custom field names

Private Sub UserForm_Initialize()
    Dim objProject      As MSProject.Project
    Dim tskTable        As MSProject.Table
    Dim tskTables       As MSProject.Tables
    Dim tskTableField   As MSProject.TableField
    Dim strFieldName    As String


'ComboBoxColA.ListWidth = "180" 'Uncomment for wider dropdown list, without wider box

Set objProject = Application.ActiveProject
Set tskTables = objProject.TaskTables


With ComboBox1 'Adds one blank line at the top
  .ColumnCount = 2
  .AddItem ""
  .Column(1, 0) = "BLANK"
End With

' Loop through all tables
For Each tskTable In tskTables
    ' Loop through each field in each table
    For Each tskTableField In tskTable.TableFields
        strFieldName = GetFieldName(tskTableField)
        If Len(strFieldName) = 0 Then GoTo SKIPHERE
         With ComboBox1
            .Value = strFieldName
            ' Check if allready exists
            If .ListIndex = -1 Then
            ' Then sort alphabetically
                For x = 0 To .ListCount - 1
                    .ListIndex = x
                If strFieldName < .Value Then
                .AddItem strFieldName, x
                .Column(1, x) = strResult2
                    GoTo SKIPHERE
                End If    
              Next x
             .AddItem strFieldName
            End If
        End With
SKIPHERE:
        Next
    Next

Set objProject = Nothing
Set tskTable = Nothing
Set tskTables = Nothing
Set tskTableField = Nothing
End Sub

功能

Private Function GetFieldName(ByVal objField As MSProject.TableField) As String
  ' find the field name and column header for a field (column) in a data table
       'strResult is placed in column 0 in ComboBox
       'strResult2 is placed in column 1 in ComboBox

  Dim lngFieldID As Long
  Dim strResult As String

  lngFieldID = objField.Field

  With objField.Application
    strResult = Trim(.FieldConstantToFieldName(lngFieldID))
    On Error GoTo ErrorIfMinus1 ' CustomField does not handle lngFieldID= -1
    If Len(Trim(CustomFieldGetName(lngFieldID))) > 0 Then strResult2 = " (" & Trim(CustomFieldGetName(lngFieldID)) & ")" Else strResult2 = ""
  End With

  GetFieldName = strResult
Exit Function

ErrorIfMinus1:
  strResult2 = ""
  Resume Next
End Function

@dbmitch帮助我使此代码正常工作。谢谢！

Answer 1

该链接很有用，因为它显示了可通过MS Project对象模型使用的属性和方法。您应该可以通过稍微更改将其修改为VBA格式。

更有用的是显示您在...中提到的代码

我发现了可以让我列出当前表中所有字段的代码

在任何情况下，请查看此代码是否按照问题中的说明进行操作

Sub LoadFieldNames()
    Dim objProject      As MSProject.Project

    Dim tskTable        AS MSProject.Table 
    Dim tskTables       AS MSProject.Tables
    Dim tskTableField   AS MSProject.TableField 

    Dim strFieldName    AS String

    Set objProject = Application.ActiveProject
    Set tskTables  = objProject.TaskTables

    ' Loop thru all tables
    For Each tskTable In tskTables

        ' Loop through each field in each table
        For Each tskTableField in tskTable.TableFields
            strFieldName = GetFieldName(tskTableField)
            ComboBox1.AddItem strFieldName
        Next
    Next

    Set objProject = Nothing
    Set tskTable = Nothing
    Set tskTables = Nothing
    Set tskTableField = Nothing

 End Sub

尝试添加function from this post以创建函数GetFieldName ...，它应该可以编译

Private Function GetFieldName(ByVal objField As MSProject.TableField) As String
  ' find the field name (actually colmn heading) for a field (column) in a data table

  Dim lngFieldID As Long
  Dim strResult As String

  lngFieldID = objField.Field

  With objField.Application
    strResult = Trim(objField.Title) ' first choice is to use the title specified for the column in the table

    If Len(strResult) = 0 Then
      ' try to get the custom field name- this will come back blank if it's not a custom field
      strResult = Trim((CustomFieldGetName(lngFieldID)))
    End If

    If Len(strResult) = 0 Then
      strResult = Trim(.FieldConstantToFieldName(lngFieldID)) ' use the field name
    End If
  End With

  GetFieldName = strResult
End Function

遍历Microsoft Project中的所有TableField添加到组合框

1 个答案: