Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Call delPopup

End Sub

Private Sub Workbook_Open()

    Call mnuPopup

End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _

    Cancel As Boolean)

'   Cancela o evento padrão do Excel para o botão direito

    Cancel = True

'   Se a célula nao estiver em uso

    If Not emUso(ActiveCell.Address) Then

'   Nao cancelar o evento padrao para o botão direito do mouse

    Cancel = False

'       Sair da rotina

        Exit Sub

    Else:

'       Se a célula estiver em uso

'       Chamar a rotina "Info"

        Call info

'       Mostrar o popup

        CommandBars("POPUP").ShowPopup

    End If

End Sub

Private Function emUso(endereco As String) As Boolean

'   Dimensiona o objeto cél

    Dim cél As Range

'   Define o resultado inicial da função como falso

    emUso = False

'   Checar em cada célula se ...

    For Each cél In ActiveSheet.UsedRange

'       o endereco da célula ativa pertence ao

'       conjunto de células usadas

        If endereco = cél.Address Then

'           Se pertencer, o resultado da função

'           é verdadeiro

            emUso = True

'           Termina a função

            Exit Function

        End If

    Next cél

End Function

Sub mnuPopup()

    Dim mnu     As CommandBar

    Dim edit    As CommandBarControl

    Dim btn     As CommandBarButton

    On Error Resume Next

    CommandBars("POPUP").Delete

    Set mnu = CommandBars.Add(Name:="POPUP", Position:=msoBarPopup)

    Set btn = mnu.Controls.Add(Type:=msoControlButton)

        With btn

            .Caption = "INFO SOBRE ESTA CÉLULA E ARQUIVO"

            .Width = 40

            .Enabled = False

        End With

    For i = 1 To 4

        Set edit = mnu.Controls.Add(Type:=msoControlEdit)

            edit.Width = 200

    Next i

    With mnu

        .Width = 200

        .Protection = msoBarNoChangeDock + msoBarNoCustomize _

          + msoBarNoResize

    End With

End Sub

Sub info()

    Dim ctl     As CommandBarControl

    With CommandBars("POPUP").Controls

        On Error Resume Next

'       Se a célula nao contém fórmula...

        If ActiveCell.Formula = "" Then

'           mostre o texto "Esta célula não contém fórmula"

'           no controle Edit

            .Item(2).Text = "Esta célula não contém fórmula"

'       Caso contrário...

        ElseIf ActiveCell.Locked = True Then

'           Mostrar a fórmula da célula selecionada

            .Item(2).Text = "Fórmula: " & ActiveCell.Formula

        End If

'       Adicionar o formato ao controle Edit 3

        .Item(3).Text = "Formato: " & ActiveCell.NumberFormat

'       Adicionar a data da última vez que foi salvo

'       ao controle Edit 4

        .Item(4).Text = "Arquivo salvo em: " _

          & ThisWorkbook.BuiltinDocumentProperties("Last Save Time")

'       Adicionar o nome do autor ao controle Edit 5

        .Item(5).Text = "Arquivo criado por: " _

          & ThisWorkbook.BuiltinDocumentProperties("Author")

    End With

End Sub