O seguinte artigo mostra como marcar e interrogar um calendário com o mouse. 
*No mundo real, abriríamos um formulário para ler e gravar entradas de diário significativas em um banco de dados. Este exercício simplesmente revela a mecânica de clicar com o botão direito do mouse e encontra os detalhes na própria planilha.
Antes de começar, algumas palavras de explicação sobre a planilha, cujo modelo de trabalho pode ser encontrado aqui..
O Processo
Clicar em uma célula dentro da grade destacará essa célula e alterará seu valor. Clicar e arrastar destacará um intervalo e alterará seus valores. Se uma célula for preenchida, ela será apagada, caso contrário será preenchida, neste caso por um “*”.
Um clique com o botão direito do mouse, por outro lado, é uma solicitação de informações da célula selecionada.
Existem essencialmente dois eventos usados, juntamente com vários módulos.
- Worksheet_SelectionAlterar que é chamado quando uma célula ou células são selecionadas.
- Planilha_BeforeRightClick que é chamado pelo botão direito do mouse.
O Problema
Clicar com o botão direito em uma célula também constitui uma seleção, acionando Alteração de seleção. Teremos que deixar esse evento seguir seu curso, limpando a célula selecionada antes que ela entregue o controle ao AntesRightClick evento, quando vamos repovoar a célula limpa. Mas essa ação acionará o Seleção alterada evento novamente, que deve ser impedido de limpá-lo novamente.
Faremos isso com um sinalizador booleano chamado blnLoading.
Os eventos
Digite o seguinte na janela de código atrás da planilha (ou seja, não em um módulo).
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
Isso cuida dos dois Eventos.
Código referenciado
Anexe os seguintes intervalos de preenchimento e despovoamento ao código:
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
Manutenção de Linhas de Grade
Insira um módulo no aplicativo. Adicione o código a seguir para manter a aparência da grade. Isso foi copiado do gravador de macro, redundâncias e tudo.
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
Proteção contra catástrofes
Quem trabalha com desenvolvimento em Excel sabe que planilhas complexas em formato XLSM podem travar ocasionalmente, corrompendo o documento aberto. Em muitos casos, a pasta de trabalho danificada não pode ser recuperada pelas rotinas de recuperação do Excel. Se não houver backups, todo o trabalho realizado estará perdido. Isso pode ser evitado com ferramentas desenvolvidas para realizar essa tarefa. Correção do Excel.
Introdução do autor:
Felix Hooker é um especialista em recuperação de dados em DataNumen, Inc., líder mundial em tecnologias de recuperação de dados, incluindo reparo rar e produtos de software de recuperação SQL. Para mais informações visite www.datanumen.com