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

Ответ 2 · рейтинг 3 · Warren Parks

Я попытался просто отредактировать ответ 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

Ответ 3 · zumalifeguard

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

Ответ 4 · рейтинг -1 · LevaR

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

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