Как сделать так, чтобы Excel автоматически обновлялся из запроса рабочего элемента TFS 2010

Question

Мы используем предоставленный по умолчанию шаблон процесса MSF Agile 5.0 от Microsoft для запуска наших проектов.В частности, лист Excel с журналом итераций очень полезен для управления проектами.

Однако мы столкнулись с ситуациями, когда журнал «Итерация» на листе 1 не обновлялся.После открытия книги Excel пользователь должен явно нажать кнопку Обновить на вкладке «Команда», чтобы получить самые последние данные.

Вопрос: как мы можем заставить Excel(2007), чтобы обновить журнал итераций при открытии рабочей книги и выполнить синхронизацию с запросом рабочего элемента TFS 2010, к которому она подключена?

Предложение других пользователей записать макрос для нажатия кнопки «Обновить» неработать, потому что записанный макрос не способен обновить запрос с иерархией дерева (по крайней мере, происходит ошибка при выполнении макроса, говорящего мне об этом).Записанный макрос делает что-то еще, просто нажимая кнопку: -)

Answer 1

Некоторые праймеры из библиотеки MSDN для типов списков
Типы списков
Преобразование списка ввода в список запросов

Теперь перейдем к вопросу.
Как сказал предыдущий автор, вам нужен код, который запускается из события открытия книги. Я верю той части, которую вы уже знали.
Метод refreshall является универсальным и работает только для соединений данных, формул и обычных списков общих точек.
Вам нужно использовать меню команды с ленты.
В следующем фрагменте кода показано, как, а также метод, с помощью которого можно получить объект списка, представляющий таблицу, содержащую данные рабочего элемента.
Синхронизация TFS и Excel через VBA

В случае разрыва ссылки следует частичное воспроизведение кода (только активация меню Team). Уже ссылка на 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

Answer 2

Я пытался просто отредактировать ответ Anonymous Type, но мое редактирование было отклонено, поэтому я получил новый ответ.Ему не хватало части кода из метода RefreshTeamQuery, как показано в связанной статье ( здесь - более прямая ссылка на оригинальный код).

У меня также по-прежнему возникают проблемы с вызовом этого изсобытие открытия рабочей книги, потому что я не думаю, что эти кнопки создаются на панели инструментов или как-то связаны с рабочей таблицей при открытии рабочей книги.Хотя использование кода на кнопке работает нормально.

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

Answer 3

Эта версия похожа, но в ней есть опция, при которой вам не нужно передавать диапазон, а просто предположить, что пользователь щелкнул (выбрал) таблицу 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

Answer 4

Как я знаю, есть функция VB, которая обновляет все источники данных xls-файла: ActiveWorkbook.RefreshAll

Вам нужно только подключить его, чтобы открыть событие в книге.