Следващата статия показва как да маркирате и разпитвате календар с мишка. 
* В реалния свят щяхме да отворим формуляр за четене и писане на значими дневници в база данни. Това упражнение просто разкрива механиката на щракване с десен бутон и намира подробностите от самия работен лист.
Преди да започнем, няколко думи за обяснение на електронната таблица, работещ модел на която може да се намери тук.
Процесът
Кликването върху клетка в мрежата ще подчертае тази клетка и ще промени нейната стойност. Щракнете и плъзнете ще маркира диапазон и ще промени стойностите му. Ако клетката е попълнена, тя ще бъде изчистена, в противен случай ще бъде попълнена, в този случай с „*“.
Щракването с десния бутон за разлика е заявка за информация от избраната клетка.
По същество се използват две събития, заедно с няколко модула.
- Работен лист_SelectionChange което се нарича, когато са избрани клетка или клетки.
- Работен лист_BeforeRightClick което се извиква от десния бутон на мишката.
Проблемът
Щракването с десен бутон върху клетка също представлява селекция, задействане SelectionChange. Ще трябва да оставим това събитие да се развие, като изчисти избраната клетка, преди да предаде контрола на Преди RightClick събитие, когато отново ще попълним изчистената клетка. Но това действие ще задейства Изборът е променен отново събитие, което трябва да бъде спряно от изчистването му за пореден път.
Това ще направим с булев флаг, наречен blnLoading.
Събитията
Въведете следното в прозореца на кода зад работния лист (т.е. не в модул).
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
Това се грижи за двете събития.
Референтен код
Добавете следните кодове за попълване и обезлюдяване към кода:
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
Поддръжка на решетки
Поставете модул в приложението. Добавете следния код за поддържане на външния вид на мрежата. Това беше копирано от макрорекордера, съкращения и всичко останало.
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
Защита срещу катастрофа
Всеки, който се занимава с разработка на Excel, знае, че сложните xlsm електронни таблици могат да се сринат от време на време, повреждайки отворения документ. В повече случаи, отколкото може да се очаква, повредената работна книга не може да бъде възстановена от процедурите за възстановяване на Excel. Ако няма резервни копия, извършената работа се губи. Това може да се предотврати с инструменти, предназначени да изпълняват... Поправка в Excel.
Въведение на автора:
Феликс Хукър е експерт по възстановяване на данни в DataNumen, Inc., която е световен лидер в технологиите за възстановяване на данни, включително ремонт на RAR файлове и sql софтуерни продукти за възстановяване. За повече информация посетете WWW.datanumen.com