Følgende artikkel viser hvordan du markerer og avhører en kalender med mus. 
*I den virkelige verden ville vi åpne et skjema for å lese og skrive meningsfulle dagbokoppføringer til en database. Denne øvelsen avslører ganske enkelt mekanikken ved høyreklikking, og finner detaljene fra selve regnearket.
Før vi begynner, noen få forklaringsord om regnearket, som du kan finne en arbeidsmodell av her..
Prosessen
Ved å klikke på en celle i rutenettet fremheves den cellen og endre verdien. Klikk-og-dra vil fremheve et område og endre verdiene. Hvis en celle er fylt ut, vil den bli tømt, ellers vil den fylles ut, i dette tilfellet med en "*".
Et høyreklikk er derimot en forespørsel om informasjon fra den valgte cellen.
Det er i hovedsak to hendelser som brukes, sammen med flere moduler.
- Worksheet_SelectionChange som kalles når en eller flere celler er valgt.
- Arbeidsark_BeforeRightClick som kalles opp av høyre museknapp.
Problemet
Høyreklikke på en celle utgjør også et utvalg, utløsende Valg Endre. Vi må la hendelsen gå sin gang, og tømme den valgte cellen før den overgir kontrollen til Før Høyreklikkk-hendelse, når vi skal fylle den slettede cellen på nytt. Men denne handlingen vil utløse Valg Endret hendelsen igjen, som må stoppes fra å fjerne den igjen.
Dette gjør vi med et boolsk flagg kalt blnLoading.
Arrangementene
Skriv inn følgende i kodevinduet bak regnearket (altså ikke i en 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
Dette tar seg av de to arrangementene.
Referert kode
Legg til følgende områder for utfylling og utfylling til koden:
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
Vedlikehold av rutenett
Sett inn en modul i applikasjonen. Legg til følgende kode for å opprettholde utseendet til rutenettet. Dette ble kopiert fra makroopptakeren, redundanser og alt.
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
Sikring mot katastrofe
Alle som driver mye med Excel-utvikling vet at komplekse xlsm-regneark kan krasje fra tid til annen og ødelegge det åpnede dokumentet. I flere tilfeller enn forventet kan ikke den skadede arbeidsboken gjenopprettes av Excels gjenopprettingsrutiner. Hvis det ikke finnes sikkerhetskopier, går arbeidet som er gjort tapt. Dette kan forhindres med verktøy som er utviklet for å utføre Excel-fiks.
Forfatterintroduksjon:
Felix Hooker er en datagjenopprettingsekspert innen DataNumen, Inc., som er verdensledende innen datagjenopprettingsteknologier, inkludert rar-reparasjon og sql-programvareprodukter. For mer informasjon besøk www.datanumen. Med