时间戳

首页 > 解决方案 > 删除项目时 Excel 功能区 dropBox 不刷新列表

excel - 删除项目时 Excel 功能区 dropBox 不刷新列表

问题描述

我有一个带有最终用户工作表列表的 Ribbon dropBox。该列表位于数据表的“A”列中，dropBox 使我们选择的表可见或在我们选择另一个表时将其隐藏。如果我们选择第一个元素（空），它将全部隐藏。

用户可以执行的操作之一是删除工作表，但要以有序的方式进行，为此我创建了一个工作表编辑表单 (UserForm1)，其中包含一个选择它们的列表 (ComboBox1) 和一个删除它们的按钮 (命令按钮 1)。该表单是必要的，因为除了删除之外还有更多操作。

一切正常，除非我删除的工作表当前在功能区 dropBox 中被选中。即使该工作表不再位于 dropBox 中，该工作表仍保持选中状态。如果我们显示列表，我们会看到它已经消失了。如果我们激活功能区的另一个选项卡并返回它会刷新并消失。

知道如何让它很好地刷新吗？

这是发生的事情的图像：

要使代码正常工作，您必须有一个名为“Data”的工作表，其中包含“A2”范围内的工作表名称列表，例如 Sheets1、Sheets2、Sheets3、Sheets4 和 Sheets5。表格必须存在才能稍后删除，如果它们不存在，我们将出错。

还有表格（“数据”）。Range (“B1”) = 1 以便我们的功能区在打开书本时处于活动状态。

同时创建一个表单（见上图）：

将此代码粘贴到其中：

Option Explicit

Private Sub UserForm_Initialize()
    'Initialize comboBox1 with sheets in _
    'sheets("Data") column "A"
    Dim LRow As Long
    LRow = LastRow(Sheets("Data"), 1)
    Me.ComboBox1.List = Sheets("Data").Range("A2:A" & _
      LRow).Value2
    UserForm1.Show vbModeless
End Sub

Private Sub CommandButton1_Click()
    Dim SheetToDelete As Worksheet
    Set SheetToDelete = Sheets(Me.ComboBox1.Text)
    Application.ScreenUpdating = False
    Dim LRow As Long
    LRow = LastRow(Sheets("Data"), 1)
    'delete actual item from comboBox1
    Me.ComboBox1.RemoveItem (Me.ComboBox1.ListIndex)
    Me.ComboBox1.ListIndex = -1
    'copy new comboBox1 list to sheets("Data") column "A"
    Sheets("Data").Range("A1").EntireColumn.ClearContents
    Sheets("Data").Range("A2:A" & LRow - 1) = Me.ComboBox1.List
    'if the sheet we are deleting is selected in
    'Ribbon dropBox "rxlstSheetsList"
    If SheetToDelete.Name = gstrActualNameSheet Then
        'we put the first empty element in dropBox
        glActualIndexSheet = -1
    End If
    'We update the Ribbon dropBox and activate it
    Call RefreshRibbon("Activate")
    'finally we delete the sheet selected in ComboBox1
    Application.DisplayAlerts = False
    SheetToDelete.Visible = xlSheetVisible
    SheetToDelete.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

在“ThisWorkbook”模块中粘贴此代码

Option Explicit
Private Sub Workbook_Open()
    'At the beginning we hide all sheets in sheets("Data") column "A"
    Sheets("Data").Range("B1") = 1
    Dim LRow As Long
    LRow = LastRow(Sheets("Data"), 1)
    If LRow > 1 Then
        Dim ActualRow As Long
        For ActualRow = 2 To LRow
            If Sheets(Sheets("Data").Range("A" & ActualRow).Text). _
               Visible = xlSheetVisible Then
                Sheets(Sheets("Data").Range("A" & ActualRow).Text). _
                Visible = xlSheetVeryHidden
            End If
        Next ActualRow
    End If
End Sub

最后用这段代码添加一个标准 Module1

Option Explicit
Public grxIRibbonUI As IRibbonUI
Public glActualIndexSheet As Integer
Public gstrActualNameSheet As String

Public Sub rxIRibbonUI_onLoad(ByRef ribbon As IRibbonUI)
    Set grxIRibbonUI = ribbon
End Sub

Public Sub rxlstSheetsList_getSelectedItemIndex(ByRef Control _
  As IRibbonControl, ByRef Index)
    Index = glActualIndexSheet
End Sub

Public Sub rxlstSheetsList_Click(ByRef Control As IRibbonControl, _
  ByVal ID As String, ByVal Index As Integer)
    'first row is empty to hide activesheet
    If glActualIndexSheet + 1 > 1 Then
        gstrActualNameSheet = Sheets("Data").Range("A" & _
          glActualIndexSheet + 1).Text
        Sheets(gstrActualNameSheet).Visible = xlSheetVeryHidden
    End If
    glActualIndexSheet = Index
    If Index = 0 Then
        gstrActualNameSheet = ""
    End If
    If glActualIndexSheet + 1 > 1 Then
        gstrActualNameSheet = Sheets("Data").Range("A" & _
          glActualIndexSheet + 1).Text
        Sheets(gstrActualNameSheet).Visible = xlSheetVisible
        Sheets(gstrActualNameSheet).Select
    End If
    On Error Resume Next
    grxIRibbonUI.Invalidate
    On Error GoTo 0
End Sub

Public Sub rxshared_getEnabled(ByRef Control As IRibbonControl, _
  ByRef returnedVal)
    returnedVal = Sheets("Data").Range("B1")
    If Sheets("Data").Range("B1") = 1 Then
        returnedVal = True
    Else
        returnedVal = False
    End If
End Sub

Public Sub rxlstSheetsList_getItemCount(ByRef Control As IRibbonControl, _
  ByRef returnedVal)
    returnedVal = LastRow(Sheets("Data"), 1)
End Sub

Public Sub rxlstSheetsList_getItemLabel(ByRef Control As IRibbonControl, _
  ByVal Index As Integer, ByRef returnedVal)
    returnedVal = Sheets("Data").Range("A" & Index + 1)
End Sub

Public Sub rxshared_getLabel(ByRef Control As IRibbonControl, _
  ByRef returnedVal)
    returnedVal = GiveLabel(Control.ID)
    grxIRibbonUI.InvalidateControl Control.ID
End Sub

Public Sub rxbtnEditList_Click(ByRef Control As IRibbonControl)
    Load UserForm1
End Sub

Public Sub RefreshRibbon(ByVal strAction_I As String)
    If strAction_I = "Activate" Then
        Sheets("Data").Range("B1") = 1
    Else
        Sheets("Data").Range("B1") = 0
    End If
    grxIRibbonUI.Invalidate
End Sub

Public Function GiveLabel(ByVal sLabel_I As String) As String
    Select Case sLabel_I
    Case "rxtabMyRibbon"
        GiveLabel = "Sheets"
    Case "rxgrp_SheetsDel"
        GiveLabel = "Sheets to delete"
    Case "rxlstSheetsList"
        GiveLabel = "Sheets list"
    Case "rxbtnEditList"
        GiveLabel = "Delete sheet"
    End Select
End Function

Public Function LastRow(ByRef wsSheet_I As Worksheet, ByVal lColumn_I _
  As Long) As Long
    Dim LRow As Range

    Set LRow = wsSheet_I.Columns(lColumn_I).Find(What:="*", _
                 LookIn:=xlFormulas, lookat:= _
                 xlPart, SearchOrder:=xlByRows, _
                 SearchDirection:=xlPrevious, MatchCase:=False)

    If Not LRow Is Nothing Then
        LastRow = LRow.Row
    Else
        LastRow = 0
    End If
End Function

功能区 XML 代码是

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
  onLoad="rxIRibbonUI_onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="rxtabMyRibbon"
       getLabel="rxshared_getLabel"
       insertBeforeMso="TabHome">
        <group id="rxgrp_SheetsDel" getLabel="rxshared_getLabel">
        <dropDown id="rxlstSheetsList"  
         getSelectedItemIndex="rxlstSheetsList_getSelectedItemIndex"
         getLabel="rxshared_getLabel"
         onAction="rxlstSheetsList_Click"
         getEnabled="rxshared_getEnabled" 
         getItemCount ="rxlstSheetsList_getItemCount"
         getItemLabel="rxlstSheetsList_getItemLabel"
        />
        <button id="rxbtnEditList"
           size="large" 
           imageMso="FilePrepareMenu" 
           getLabel="rxshared_getLabel" 
           onAction="rxbtnEditList_Click" 
           getEnabled="rxshared_getEnabled"
          />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

标签： excelvbaribbon

解决方案

全部完成。dropDown 的第一个元素是 0 而不是 -1，在 Combobox 中设置 -1 以清空列表但不在 dropDown 中。用Private Sub CommandButton1_Click()-1代替0。

If SheetToDelete.Name = gstrActualNameSheet Then
    'we put the first empty element in dropBox
    glActualIndexSheet = 0 'Before -1
End If

抱歉这个问题，我希望它适合有类似问题的人

推荐阅读