약어 사전 for Excel

이것은 무엇인가

Excel로 작성된 자료 중 모르는 약어가 있을 때 셀을 선택하고 [F10] 키를 누르면,
창 하단의 상태 표시줄에 의미가 2초 동안 표시된다는 매크로

준비

사전 책의 시트에 약어와 그 의미를 적어 둡니다.
(사실은 사전에 없었다면 Wikipedia를 조사해 사전에 추가하는 곳까지 만들려고 하고 있었다)

코드

· 참조 설정
Microsoft Scripting Runtime
Microsoft VBScript Regular Expression 5.5

'thisworkbook.cls

Option Explicit

Dim MyDictionary As New Dictionary
Dim RYAK_EX As New RegExp
Dim RYAK_PA As New RegExp

Private Sub Workbook_Open()
    Application.OnKey "{F10}", "Thisworkbook.main"
    MakeDictionary
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "{F10}"
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    MakeDictionary
End Sub

Sub MakeDictionary()
    On Error Resume Next
    With RYAK_EX
        .Pattern = "^[A-Z][A-Z0-9\-]*[A-Z]$"
    End With
    With RYAK_PA
        .Global = True
        .Pattern = "[A-Z][A-Z0-9\-]*[A-Z]"
    End With
    Dim c As Range, ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        For Each c In ws.Cells.SpecialCells(xlCellTypeConstants)
            If RYAK_EX.Test(c.Value) Then
                MyDictionary(c.Value) = Join(Array(ws.Name, c.Value, ":", c.Offset(, 1).Value))
            End If
        Next c
    Next ws
End Sub

Function LookupDictionary(key As String) As String
    If MyDictionary.Exists(key) Then
        LookupDictionary = MyDictionary(key)
    Else
        LookupDictionary = key & " : "
    End If
End Function

Sub main()
    On Error Resume Next
    Dim str$

    Select Case TypeName(Selection)
    Case "Range"
        str = ActiveCell.Value
    Case "Rectangle", "TextBox"
        str = Selection.Text
    Case Else
        Debug.Print TypeName(Selection)
        Exit Sub
    End Select

    With Application
        Dim m As Match
        For Each m In RYAK_PA.Execute(str)
            .StatusBar = LookupDictionary(m.Value)
            Wait 2
        Next
        .StatusBar = False
    End With
End Sub

Function Wait(Optional n As Single = 3) As Single
    Wait = Timer + n
    Do While Wait > Timer
        DoEvents
    Loop
End Function