VSTO制作任务窗格源码分享

Excelhome112233

由于Excel2010以上版本的加载项，一个工作簿一个进程，制作任务窗格需要多个事件相互配合。Excel2010（

含2010

）版本所有工作簿是公用进程！

Excelhome112233

Excelhome112233

Excelhome112233

依次添加两个列表框（ListView1和ListView2）还有一个分割线（Splitter），还有图标（ImageList）

Excelhome112233

添加ListView1，Dock属性改为Top；添加Splitter，Dock属性改为Top，添加ListView2，Dock属性改为Fill
添加ImageList。所有属性改好如下图：

Excelhome112233

准备两个图标。

鼠标右键

选择图像

添加

Excelhome112233

Imports System.Windows.Forms
Public Class UserControl1
    Public Sub Wb()
        REM 知识点:工作簿变量(Excel.Workbook)/For next 循环/
        REM 让选中的工作簿跟着滚动条滚动(ListView1.EnsureVisible);ListView1.Items(i).Selected = True
        REM 1.依次把打开所有的工作簿添加到列表框中;2.在列表中需寻找等于当前工作簿并让滚动条滚动
        Dim wb As Excel.Workbook   '定义工作簿变量
        On Error Resume Next
        Dim i As Int16          '定义i
        REM.1.依次把打开所有的工作簿添加到列表框中
        ListView1.Items.Clear()   '添加工作簿之前清楚ListView1中内容
        For Each wb In App.Workbooks   '在打开工作簿中循环
            ListView1.Items.Add(wb.Name, 1)    '依次把工作簿的名字添加到ListView中
        Next   '结束循环
        REM 2.在列表中寻找等于当前工作簿名,并让滚动条随着滚动,同时在列表中选中当前工作簿
        REM 让列表中内容选中等于当前工作簿(ListView1.Items(i).Selected = True)
        For i = 0 To ListView1.Items.Count - 1
            If App.ActiveWorkbook.Name = ListView1.Items(i).Text Then   '如果当前工作簿等于列表中内容则
                ListView1.Items(i).Selected = True        '选中当前工作簿
                Exit For    '退出循环
            End If    '结束条件
        Next    '结束循环

        '为了让列表呈现更好的选择效果,让滚动内容呈现向下可见5个内容
        If ListView1.Items.Count - (i + 1) < 5 Then
            ListView1.EnsureVisible(ListView1.Items.Count - 1)
        Else
            ListView1.EnsureVisible(i + 5)       '让选选钟内容跟着滚动条滚动，且向下多显示5个内容
        End If
    End Sub
    Public Sub Sht()
        REM  同工作簿原理一样
        Dim sht As Excel.Worksheet, i As Int16
        REM.1.依次把正在操作的工作簿中所有工作表添加列表2中
        ListView2.Items.Clear()  '添加之前清楚所有内容,以免重复添加
        On Error Resume Next
        For Each sht In App.ActiveWorkbook.Sheets   '在操作的工作簿中所有工作表中循环
            ListView2.Items.Add(sht.Name, 0)  '依次添加到ListView2中
        Next   '结束循环
        REM 2.在列表中寻找等于当前工作表名,并让滚动条随着滚动,同时在列表中选中当前工作簿
        REM 让列表中内容选中等于当前工作表(ListView1.Items(i).Selected = True)
        For i = 0 To ListView2.Items.Count - 1   '在列表2中循环
            If App.ActiveSheet.Name = ListView2.Items(i).Text Then  '如果正在操作的工作表等于列表框中内容则
                ListView2.Items(i).Selected = True
                Exit For
            End If
        Next '结束循环
        '为了让列表呈现更好的选择效果,让滚动内容呈现向下可见5个内容
        If ListView2.Items.Count - (i + 1) < 5 Then
            ListView2.EnsureVisible(ListView2.Items.Count - 1)
        Else
            ListView2.EnsureVisible(i + 5)       '让选选钟内容跟着滚动条滚动，且向下多显示5个内容
        End If
    End Sub
    Private Sub ListView1_Click(sender As Object, e As EventArgs) Handles ListView1.Click
        Dim Index As Int16
        Index = ListView1.SelectedIndices(index:=0)     '获取当前选中的内容的索引号
        App.Workbooks(ListView1.Items(Index).Text).Activate()     '激活当前选中的工作簿
        App.WindowState = Microsoft.Office.Interop.Excel.XlWindowState.xlMaximized '让工作簿显示
        Call Sht()    '选中的工作中的所有工作表，引用sub sht()
    End Sub

    Private Sub ListView2_Click(sender As Object, e As EventArgs) Handles ListView2.Click
        Dim Index As Int16
        Index = ListView2.SelectedIndices(index:=0)    '获取当前选中的内容索引号
        App.Sheets(ListView2.Items(Index).Text).Activate()   '激活选中的工作表
    End Sub
    Private Sub UserControl1_Load(sender As Object, e As EventArgs) Handles Me.Load
        Call Wb()
        Call Sht()
    End Sub
End Class

Excelhome112233

在工作簿和工作表时间中添加以下代码
Private Sub Application_WorkbookActivate(Wb As Workbook) Handles Application.WorkbookActivate
        On Error Resume Next
        If Globals.Ribbons.Ribbon1.导航窗格.Checked Then
            Call 用户控件.Wb()
            Call 用户控件.Sht()
            If App.Version <= 14 Then
                Exit Sub
            Else
                Me.CustomTaskPanes.RemoveAt(0)
                用户控件 = New UserControl1
                任务窗格 = Me.CustomTaskPanes.Add(用户控件, "导航")
                With 任务窗格
                    .DockPosition = Microsoft.Office.Core.MsoCTPDockPosition.msoCTPDockPositionLeft
                    .Width = 220
                    .Visible = True
                End With
            End If
        Else
            Me.CustomTaskPanes.RemoveAt(0)
        End If
    End Sub
    Private Sub Application_SheetActivate(Sh As Object) Handles Application.SheetActivate
        On Error Resume Next
        Call 用户控件.Sht()
    End Sub
End Class

Excelhome112233

Private Sub 导航窗格_Click(sender As Object, e As RibbonControlEventArgs) Handles 导航窗格.Click
        On Error Resume Next
        If 导航窗格.Checked Then
            Globals.ThisAddIn.用户控件 = New UserControl1
            Globals.ThisAddIn.任务窗格 = Globals.ThisAddIn.CustomTaskPanes.Add(Globals.ThisAddIn.用户控件, "导航")
            With Globals.ThisAddIn.任务窗格
                .DockPosition = Microsoft.Office.Core.MsoCTPDockPosition.msoCTPDockPositionLeft
                .Visible = True
                .Width = 220
            End With
        Else
            Globals.ThisAddIn.CustomTaskPanes.RemoveAt(0)
        End If
    End Sub

Excelhome112233

开始要声明两个变量
Public 用户控件 As UserControl1
Public 任务窗格 As Microsoft.Office.Tools.CustomTaskPane