TypeSelection – Bipbipcoyote 2000

Menu pour effectuer différents types de sélection

Traduction d'un fichier de démonstration de John Walkenbach qui va nous permettre, grâce à un menu, de sélectionner des cellules par rapport à la cellule active. Non seulement ce fichier est intéressant en lui même car rien ne nous empêche de le sauvegarder en XLA ou d'adjoindre le code dans nos macros complémentaires personnelles mais il constitue une source pour divers copier-coller dans d'autres fonctions que nous pourrions créer

Le système est assez simple, d'abord une procédure Auto_Open qui se déclenche automatiquement à l'ouverture du fichier (parce que c'est un nom réservé dans Excel). Elle va créer notre menu dans la barre de menu. Dans cette procédure, John définit 2 tableaux en mémoire (Cap & Mac) pour stocker des variables de type string (Chaîne de caractère). Il en récupére les valeurs en utilisant les adresses de ces tableaux et en injecte le contenu dans la barre de menu

Sub Auto_Open()
'   Crée un nouveau menu et ajoute les items
'   Ceci crée 2 tableaux dans la mémoire
    Dim Cap(1 To 15)
    Dim Mac(1 To 15)
    Dim NomMenu As String
    
    NomMenu = "&Selection_Demo"
<span style="color: brown;"><b>'   </b></span><b>Il stocke des variables dans les cases des 2 tableaux en mémoire</b>    
    Cap(1) = "Sélectionner vers le bas - Ctrl+Maj+Flèche Bas"
    Mac(1) = "SelectDown"
    
    Cap(2) = "Sélectionner vers le Haut - Ctrl+Maj+Up"
    Mac(2) = "SelectUp"
    
    Cap(3) = "Sélectionner à droite - Ctrl+Maj+Flèche Droite"
    Mac(3) = " SelectToRight"
    
    Cap(4) = "Sélectionner à gauche - Ctrl+Maj+Flèche Gauche"
    Mac(4) = " SelectToLeft"
    
    Cap(5) = "Sélectionner zone contigue - Ctrl+Maj+*"
    Mac(5) = " SelectCurrentRegion"
    
    Cap(6) = "Sélectionner zone active - End, Home, Ctrl+Maj+Home"
    Mac(6) = " SelectActiveArea"
    
    Cap(7) = "Sélectionner les cellules contigues dans la colonne de la cellule active"
    Mac(7) = " SelectActiveColumn"
    
    Cap(8) = "Sélectionner les cellules contigues dans la ligne de la cellule active"
    Mac(8) = " SelectActiveRow"
    
    Cap(9) = "Sélectionner une colonne entière - Ctrl+Barre d'Espace"
    Mac(9) = " SelectEntireColumn"
    
    Cap(10) = "Sélectionner une ligne entière - Maj+Barre d'Espace"
    Mac(10) = " SelectEntireRow"
    
    Cap(11) = "Sélectionner la feuille de travail - Ctrl+A"
    Mac(11) = " SelectEntireSheet"
    
    Cap(12) = "Activer la cellule vide suivante du bas"
    Mac(12) = " ActivateNextBlankDown"
    
    Cap(13) = "Activer la cellule vide suivante à droite"
    Mac(13) = " ActivateNextBlankToRight"
    
    Cap(14) = "Sélectionner depuis la 1ère cellule non vide jusque la dernière cellule non vide dans la ligne"
    Mac(14) = " SelectFirstToLastInRow"
    
    Cap(15) = "Sélectionner depuis la 1ère cellule non vide jusque la dernière cellule non vide dans la colonne"
    Mac(15) = " SelectFirstToLastInColumn"

    On Error Resume Next
'   Efface le menu s'il existait déjà, pour éviter les doubles
    MenuBars(xlWorksheet).Menus(NomMenu).Delete
    
'   Ajoute le menu à la barre de menus
    MenuBars(xlWorksheet).Menus.Add Caption:=NomMenu, before:="Help"
    
'   Ajoute les items dans le nouveau menu en récupérant le contenu
'   des cellules des 2 tableaux créés en mémoire
    With MenuBars(xlWorksheet).Menus(NomMenu).MenuItems
        .Add Caption:=Cap(1), OnAction:=Mac(1)
        .Add Caption:=Cap(2), OnAction:=Mac(2)
        .Add Caption:=Cap(3), OnAction:=Mac(3)
        .Add Caption:=Cap(4), OnAction:=Mac(4)
        .Add Caption:="-"
        .Add Caption:=Cap(5), OnAction:=Mac(5)
        .Add Caption:=Cap(6), OnAction:=Mac(6)
        .Add Caption:="-"
        .Add Caption:=Cap(7), OnAction:=Mac(7)
        .Add Caption:=Cap(8), OnAction:=Mac(8)
        .Add Caption:="-"
        .Add Caption:=Cap(9), OnAction:=Mac(9)
        .Add Caption:=Cap(10), OnAction:=Mac(10)
        .Add Caption:=Cap(11), OnAction:=Mac(11)
        .Add Caption:="-"
        .Add Caption:=Cap(12), OnAction:=Mac(12)
        .Add Caption:=Cap(13), OnAction:=Mac(13)
        .Add Caption:="-"
        .Add Caption:=Cap(14), OnAction:=Mac(14)
        .Add Caption:=Cap(15), OnAction:=Mac(15)
    End With
End Sub

Comme John est une personne soigneuse, il nous débarrasse du menu lorsque l'on referme le fichier

Sub Auto_Close()
    Dim NomMenu As String
    NomMenu = "&Selection_Demo"
'   Efface le menu avant de fermer le classeur
    On Error Resume Next
    MenuBars(xlWorksheet).Menus(NomMenu).Delete
End Sub

Remarquez une propriété très intéressante OnAction.
Elle renvoie ou définit le nom de la macro Visual Basic exécutée si l'utilisateur clique sur le contrôle de barre de commandes ou change sa valeur. Un conseil, consultez l'aide d'Excel (F1) sur cette propriété

Et finalement les macros qui permettent de réaliser les différentes actions. Notez que l'on peut très facilement récupérer ce code en utilisant l'enregistreur de macro, mais l'idée de regrouper celles-ci dans un menu est excellente. Remarquez l'usage intensif de ActiveCell et de Selection , deux mots réservés par Excel pour définir la cellule que le focus (curseur) occupe à un instant X. Pratique lorsque l'on sait où l'on se trouve, catastrophique lorsque le point de départ n'est pas celui escompté... Il est parfois utile de remplacer cette mention par l'adresse de la cellule que l'on désire par exemple Range("B17").Select . Ici on est sûr est certain que la cellule sélectionnée sera B17, le focus s'y déplacera si nécessaire.

Sub SelectDown() Range(ActiveCell, 
   ActiveCell.End(xlDown)).Select 
End Sub


Sub SelectUp()
 Range(ActiveCell, ActiveCell.End(xlUp)).Select 
End Sub


Sub SelectToRight()
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
End Sub


Sub SelectToLeft()
    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
End Sub


Sub SelectCurrentRegion()
    ActiveCell.CurrentRegion.Select
End Sub


Sub SelectActiveArea()
    Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select
End Sub


Sub SelectActiveColumn()
    If IsEmpty(ActiveCell) Then Exit Sub
'   ignore les erreurs si la celllule active est dans la ligne 1
     On Error Resume Next
    If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell _
    Else Set TopCell = ActiveCell.End(xlUp)
    If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell _
    Else Set BottomCell = ActiveCell.End(xlDown)
    Range(TopCell, BottomCell).Select
End Sub


Sub SelectActiveRow()
    If IsEmpty(ActiveCell) Then Exit Sub
'   ignore les erreurs si la cellule activec est dans la colonne A
    On Error Resume Next
    If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = ActiveCell _
    Else Set LeftCell = ActiveCell.End(xlToLeft)
    If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = ActiveCell _
    Else Set RightCell = ActiveCell.End(xlToRight)
    Range(LeftCell, RightCell).Select
End Sub


Sub SelectEntireColumn()
    Selection.EntireColumn.Select
End Sub


Sub SelectEntireRow()
    Selection.EntireRow.Select
End Sub


Sub SelectEntireSheet()
    Cells.Select
End Sub


Sub ActivateNextBlankDown()
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub


Sub ActivateNextBlankToRight()
   ActiveCell.Offset(0, 1).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub


Sub SelectFirstToLastInRow()
    Set LeftCell = Cells(ActiveCell.Row, 1)
    Set RightCell = Cells(ActiveCell.Row, 256)

    If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)
    If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)
    If LeftCell.Column = 256 And RightCell.Column = 1 Then _
    ActiveCell.Select Else Range(LeftCell, RightCell).Select
End Sub


Sub SelectFirstToLastInColumn()
    Set TopCell = Cells(1, ActiveCell.Column)
    Set BottomCell = Cells(16384, ActiveCell.Column)

    If IsEmpty(TopCell) Then Set TopCell = TopCell.End(xlDown)
    If IsEmpty(BottomCell) Then Set BottomCell = BottomCell.End(xlUp)
    If TopCell.Row = 16384 And BottomCell.Row = 1 Then _
    ActiveCell.Select Else Range(TopCell, BottomCell).Select
End Sub

Cliquez ici pour télécharger le fichier exemple TypeSelection

Menu pour effectuer différents types de sélection

FIN

Avertissement