Переберите все поля таблиц в Microsoft Project и добавьте в выпадающий список - PullRequest
Новая
       32

Переберите все поля таблиц в Microsoft Project и добавьте в выпадающий список

0 голосов
/ 03 июля 2018

Я застрял, пытаясь создать пользовательскую форму в VBA с помощью комбинированного списка, в котором перечислены все возможные поля таблицы (?).

Обновленный код: Используя код, предоставленный @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 помог мне получить этот код для работы. Спасибо!

1 Ответ

0 голосов
/ 03 июля 2018

Эта ссылка полезна тем, что показывает свойства и методы, доступные вам через объектную модель 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

Попробуйте добавить функцию из этого поста , чтобы создать функцию 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
...