Următorul articol arată cum să marcați și să interogați un calendar cu mouse-ul. 
*În lumea reală, am deschide un formular pentru a citi și a scrie intrări semnificative din jurnal într-o bază de date. Acest exercițiu dezvăluie pur și simplu mecanica clicului dreapta și găsește detaliile din foaia de lucru în sine.
Înainte de a începe, câteva cuvinte de explicație despre foaia de calcul, al cărei model de lucru poate fi găsit aici.
Cum lucram impreuna
Făcând clic pe o celulă din grilă, aceasta va evidenția celula și îi va schimba valoarea. Făcând clic și trageți, va evidenția un interval și va modifica valorile acestuia. Dacă o celulă este populată, aceasta va fi ștearsă, în caz contrar va fi populată, în acest caz cu un „*”.
În schimb, un clic dreapta este o solicitare de informații din celula selectată.
În esență, sunt utilizate două evenimente, împreună cu mai multe module.
- Worksheet_SelectionChange care este numit atunci când o celulă sau celule sunt selectate.
- Foaia de lucru_BeforeRightClick care este apelat de butonul din dreapta al mouse-ului.
Problema
Făcând clic dreapta pe o celulă constituie și o selecție, declanșare SelectionChange. Va trebui să lăsăm acel eveniment să-și urmeze cursul, ștergând celula selectată înainte de a preda controlul BeforeRightClick, când vom repopula celula șters. Dar această acțiune va declanșa SelectionChanged eveniment din nou, care trebuie oprit din nou pentru a-l șterge.
Acest lucru îl vom face cu un steag boolean numit blnLoading.
Evenimentele
Introduceți următoarele în fereastra de cod din spatele foii de lucru (adică nu într-un modul).
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
Aceasta are grijă de cele două Evenimente.
Codul de referință
Adăugați următoarele intervale de populare și depopulare la cod:
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
Întreținerea liniilor de grilă
Introduceți un modul în aplicație. Adăugați următorul cod pentru a menține aspectul grilei. Acesta a fost copiat de pe macro recorder, redundanțe și tot.
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
Protecția împotriva catastrofei
Oricine dezvoltă mult în Excel știe că foile de calcul complexe xlsm se pot bloca din când în când, corupând documentul deschis. În mai multe cazuri decât s-ar putea aștepta, registrul de lucru deteriorat nu poate fi recuperat de rutinele de recuperare din Excel. Dacă nu există copii de rezervă, munca depusă se pierde. Acest lucru poate fi prevenit cu instrumente concepute pentru a efectua... Remediere Excel.
Introducerea autorului:
Felix Hooker este un expert în recuperarea datelor DataNumen, Inc., care este lider mondial în tehnologiile de recuperare a datelor, inclusiv reparare rar și produse software de recuperare sql. Pentru mai multe informații vizitați www.datanumen.com