循环遍历 Microsoft Project 中的所有 TableFields 添加到组合框
Loop through all TableFields in Microsoft Project add to combobox
我一直在尝试在 VBA 中使用列出所有可能的 TableFields(?) 的组合框创建用户窗体。
更新代码:
使用@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 帮助我使这段代码工作。谢谢!
link 的用处在于它显示了您可以通过 MS Project 对象模型使用的属性和方法。您应该可以通过稍微更改它来将其修改为 VBA 格式。
展示您在...中提到的代码会更有用
I have found code that let me list all fields in the current table
无论如何,请查看此代码是否按照您的问题所述执行您想要的操作
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
我一直在尝试在 VBA 中使用列出所有可能的 TableFields(?) 的组合框创建用户窗体。
更新代码: 使用@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 帮助我使这段代码工作。谢谢!
link 的用处在于它显示了您可以通过 MS Project 对象模型使用的属性和方法。您应该可以通过稍微更改它来将其修改为 VBA 格式。
展示您在...中提到的代码会更有用
I have found code that let me list all fields in the current table
无论如何,请查看此代码是否按照您的问题所述执行您想要的操作
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