L'article suivant montre comment baliser et interroger un calendrier avec la souris. 
* Dans le monde réel, nous ouvririons un formulaire pour lire et écrire des entrées de journal significatives dans une base de données. Cet exercice révèle simplement la mécanique du clic droit et trouve les détails de la feuille de calcul elle-même.
Avant de commencer, quelques mots d'explication sur la feuille de calcul, dont un modèle de travail peut être trouvé ici.
Le processus
Cliquer sur une cellule dans la grille mettra cette cellule en surbrillance et modifiera sa valeur. Cliquer et faire glisser mettra en surbrillance une plage et modifiera ses valeurs. Si une cellule est renseignée, elle sera effacée, sinon elle sera renseignée, en l'occurrence par un « * ».
Un clic droit, en revanche, est une demande d'informations à partir de la cellule sélectionnée.
Il y a essentiellement deux événements utilisés, ainsi que plusieurs modules.
- Feuille de travail_SelectionChange qui est appelée lorsqu'une ou plusieurs cellules sont sélectionnées.
- Feuille de calcul_AvantClic droit qui est appelé par le bouton droit de la souris.
Le problème
Un clic droit sur une cellule constitue également une sélection, déclenchant SélectionModifier. Nous devrons laisser cet événement suivre son cours, en effaçant la cellule sélectionnée avant qu'elle ne cède le contrôle au AvantClicDroitk événement, lorsque nous repeuplerons la cellule effacée. Mais cette action déclenchera le SélectionChangé événement à nouveau, qui doit être empêché de l'effacer une fois de plus.
Nous allons le faire avec un indicateur booléen appelé blnLoading.
Les événements
Entrez ce qui suit dans la fenêtre de code derrière la feuille de calcul (c'est-à-dire pas dans un module).
Option Explicit
Dim blnLoading As Boolean
Dim sPhase As String
Dim currCellValue As String
Dim dDate As Date
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Row > 14 And ActiveCell.Row < 25 Then
If ActiveCell.Column > 4 And ActiveCell.Column < 47 Then 'selection is valid
On Error Resume Next
currCellValue = Target.Value 'get the target value from (ByVal Target As Range)
If blnLoading = True Then 'a value of True will force an exit from this event
blnLoading = False
Exit Sub
End If
sPhase = Cells(ActiveCell.Row, 1)
If sPhase = "" Then Exit Sub
If ActiveCell = "*" Then 'if the cell is populated, clear the selected range
Call ClearRange
Call UnblockCalendar
Else
Call PopulateRange
End If
Call RedrawCells
Range("A1").Select 'revive the SelectionChange event by changing selection.
Exit Sub
End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If currCellValue = "*" Then 'picked up by the previous event BEFORE it cleared it;
'This means this is a valid diary entry with detail.
blnLoading = True 'this will prevent the SelectionChange event (above) from running.
Target.Select
'currCell = Target.Address
'Range(currCell).Select
Target.Value = "*" 're-instate the value of the cell, since SelectionChange has cleared it
Call PopulateRange
dDate = Cells(13, ActiveCell.Column)
sPhase = Cells(ActiveCell.Row, 1)
MsgBox dDate & " - " & sPhase
Cancel = True 'suppress Excel’s standard right_click menus
End If
Range("A1").Select
blnLoading = False
End Sub
Cela prend soin des deux événements.
Code référencé
Ajoutez les plages de remplissage et de dépeuplement suivantes au code :
Sub ClearRange() Selection.FormulaR1C1 = "" With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With End Sub Sub PopulateRange() Selection.FormulaR1C1 = "*" With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorLight2 .TintAndShade = 0.799981688894314 .PatternTintAndShade = 0 End With End Sub
Entretien des quadrillages
Insérez un module dans l'application. Ajoutez le code suivant pour conserver l'apparence de la grille. Cela a été copié à partir de l'enregistreur de macros, des redondances et de tout.
Option Explicit Sub UnblockCalendar() Selection.FormulaR1C1 = "" With Selection Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone End With End Sub Sub RedrawCells() Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End Sub
Se prémunir contre la catastrophe
Quiconque développe régulièrement avec Excel sait que les feuilles de calcul xlsm complexes peuvent planter de temps à autre, corrompant le document ouvert. Plus souvent qu'on ne le pense, le classeur endommagé est irrécupérable par les fonctions de récupération d'Excel. Sans sauvegarde, tout le travail effectué est perdu. Il est possible d'éviter ce problème grâce à des outils conçus pour effectuer des sauvegardes. Correctif Excel.
Introduction de l'auteur:
Felix Hooker est un expert en récupération de données dans DataNumen, Inc., qui est le leader mondial des technologies de récupération de données, y compris réparation rar et produits logiciels de récupération sql. Pour plus d'informations, visitez www.datanumen.com