我们使用 Microsoft 提供的默认 MSF Agile 5.0 流程模板来运行我们的项目。具体来说，Iteration Backlog Excel 表对于进行项目管理非常有用。
然而，我们遇到了第 1 表上的迭代积压不是最新的情况。打开 Excel 工作簿后，用户必须明确地单击“团队”选项卡上的“刷新”按钮以查看最新数据。
问题：我们如何强制 Excel (2007) 在打开工作簿时刷新 Iteration Backlog 并与它所连接的 TFS 2010 工作项查询同步？
其他人提供的记录宏以单击刷新按钮的建议不起作用，因为记录的宏无法刷新具有树层次结构的查询（至少，执行宏时会发生错误告诉我） .录制的宏执行其他操作，只需单击按钮 :-)
【问题讨论】：
标签： excel excel-2007 vba
MSDN 库中关于列表类型的一些入门
Types of lists
Converting a Input list to Query list
现在谈谈手头的问题。
正如前面的回答者所说，您需要从工作簿打开事件运行的代码。我相信你已经知道的那部分。
refreshall 方法是通用的，仅适用于数据连接、公式和常规共享点列表。
您需要使用功能区中的团队菜单。
下面的代码 sn-p 显示了如何以及获取表示保存工作项数据的表的列表对象的方法。
Synchronize TFS and Excel via VBA
如果链接中断了代码的部分复制（只需激活团队菜单）。他们文章中的 MSDN 链接已经损坏（或者可能没有......）
Private Function FindTeamControl(tagName As String) As CommandBarControl
Dim commandBar As commandBar
Dim teamCommandBar As commandBar
Dim control As CommandBarControl
For Each commandBar In Application.CommandBars
If commandBar.Name = "Team" Then
Set teamCommandBar = commandBar
Exit For
End If
Next
If Not teamCommandBar Is Nothing Then
For Each control In teamCommandBar.Controls
If InStr(1, control.Tag, tagName) Then
Set FindTeamControl = control
Exit Function
End If
Next
End If
End Function
Sub RefreshTeamQuery(shtTFSExcel_Name As String) '(rangeName As String)
Dim activeSheet As Worksheet
Dim teamQueryRange As Range
Dim refreshControl As CommandBarControl
Set refreshControl = FindTeamControl("IDC_REFRESH")
If refreshControl Is Nothing Then
MsgBox "Could not find Team Foundation commands in Ribbon. Please make sure that the Team Foundation Excel plugin is installed.", vbCritical
Exit Sub
End If
End Sub
【讨论】：
我试图只编辑匿名类型的答案，但我的编辑被拒绝了，所以提出了新的答案。如链接文章所示，他缺少 RefreshTeamQuery 方法中的部分代码（here 是原始代码的更直接链接）。
我仍然在从工作簿打开事件中调用它时遇到问题，因为我不认为这些按钮是在工具栏中创建的，或者在打开 wookbook 时以某种方式链接到工作表。不过，在按钮上使用代码效果很好。
Private Function FindTeamControl(tagName As String) As CommandBarControl
Dim commandBar As commandBar
Dim teamCommandBar As commandBar
Dim control As CommandBarControl
For Each commandBar In Application.CommandBars
If commandBar.Name = "Team" Then
Set teamCommandBar = commandBar
Exit For
End If
Next
If Not teamCommandBar Is Nothing Then
For Each control In teamCommandBar.Controls
If InStr(1, control.Tag, tagName) Then
Set FindTeamControl = control
Exit Function
End If
Next
End If
End Function
Sub RefreshTeamQuery(shtTFSExcel_Name As String) '(rangeName As String)
Dim activeSheet As Worksheet
Dim teamQueryRange As Range
Dim refreshControl As CommandBarControl
Set refreshControl = FindTeamControl("IDC_REFRESH")
If refreshControl Is Nothing Then
MsgBox "Could not find Team Foundation commands in Ribbon. Please make sure that the Team Foundation Excel plugin is installed.", vbCritical
Exit Sub
End If
'Disable screen updating temporarily so that the user doesn’t see us selecting a range
Application.ScreenUpdating = False
'Capture the currently active sheet, we will need it later
Set activeSheet = ActiveWorkbook.activeSheet
Set teamQueryRange = Worksheets(shtTFSExcel_Name).ListObjects(1).Range
teamQueryRange.Worksheet.Select
teamQueryRange.Select
refreshControl.Execute
activeSheet.Select
Application.ScreenUpdating = True
End Sub
【讨论】：
这个版本类似，但它有一个选项，您不必传入范围，而只是假设 TFS 表已被用户单击（选择）。
原来的功能也在那里：
Sub RefreshTeamQuery()
Dim sel As Range: Set sel = Application.Selection: If sel Is Nothing Then Exit Sub
Dim lo As ListObject: Set lo = sel.ListObject: If lo Is Nothing Then Exit Sub
RefreshTeamQueryWithList lo
End Sub
Sub RefreshTeamQueryWithList(lo As ListObject)
Dim activeSheet As Worksheet
Dim teamQueryRange As Range
Dim refreshControl As CommandBarControl
Set refreshControl = FindTeamControl("IDC_REFRESH")
If refreshControl Is Nothing Then
MsgBox "Could not find Team Foundation commands in Ribbon. Please make sure that the Team Foundation Excel plugin is installed.", vbCritical
Exit Sub
End If
On Error GoTo errorHandler
'Disable screen updating temporarily so that the user doesn’t see us selecting a range
Application.ScreenUpdating = False
'Capture the currently active sheet, we will need it later
Set activeSheet = ActiveWorkbook.activeSheet
Set teamQueryRange = lo.Range
teamQueryRange.Worksheet.Select
teamQueryRange.Select
refreshControl.Execute
activeSheet.Select
Application.ScreenUpdating = True
errorHandler:
If Not activeSheet Is Nothing Then activeSheet.Select
Application.ScreenUpdating = True
End Sub
Private Function FindTeamControl(tagName As String) As CommandBarControl
Dim commandBar As commandBar
Dim teamCommandBar As commandBar
Dim control As CommandBarControl
For Each commandBar In Application.CommandBars
If commandBar.Name = "Team" Then
Set teamCommandBar = commandBar
Exit For
End If
Next
If Not teamCommandBar Is Nothing Then
For Each control In teamCommandBar.Controls
If InStr(1, control.Tag, tagName) Then
Set FindTeamControl = control
Exit Function
End If
Next
End If
End Function
【讨论】：
据我所知，有一个刷新所有 xls 文件数据源的 VB 函数：ActiveWorkbook.RefreshAll
您只需将其连接到打开工作簿事件。
【讨论】：