이 편지지 하나로 "오른쪽 클릭 메뉴가 추가되어 선택하면 매크로 함수 (서브 루틴)가 호출된다"Excel의 추가 기능을 만들 수 있습니다. 약간의 작업 자동화에 적합합니다.

Excel 추가 기능 정보

xla 파일: 설치하지 않고 일시적으로 사용할 수 있는 추가 기능. xla 파일을 직접 열면 작동 시작. Excel을 모두 닫으면 동작 종료한다.

내용은 Excel VBA의 매크로이지만 통합 문서 (xlsx, xlsm 파일)에 의존하지 않으므로 통합 문서를 복사하여 논리 복제되는 것을 피할 수 있습니다. 애드인 파일에 쓰기 잠금도 할 수 있으므로, 「모르고 모르게 Excel 편집하고 있는 동안에 실수로 매크로를 파괴해 버렸다」는 위험을 회피할 수 있습니다.
"xlax"가 아닌 것은 사정에 따라 · ·

추가 기능 추가 : xla 파일은 Excel을 모두 닫으면 종료되어 버리므로 다시 시작할 때마다 매번 열어야합니다. 그것이 귀찮은 경우는, 「애드인의 추가」를 실시하면 애드인의 삭제를 할 때까지 xla 파일의 동작이 유효하게 된다.

편지지

이하의 기술을 「표준 모듈」에 복사해 xla 파일로서 보존하면 완성. 이해할 수 있던 사람은 그대로 가져가 주세요. (xla 파일을 만드는 방법은 후술)

추가 기능 병아리

Const HEAD_TITLE = "ハローワールド" 'コンテキストメニューのタイトル
Const MENU = "ハロー,ワールド" 'サブメニューのタイトル（カンマ区切り）
Const MENU_ACT = "hello,world" 'サブメニューのSub名（カンマ区切り）

'ここに関数挿入

Sub hello()

    MsgBox "Hello," & Selection

End Sub

Sub world()

    MsgBox Selection & " World!"

End Sub


'以降、共通処理

Sub Auto_Open()
    AddMenu
End Sub

Sub Auto_Close()

End Sub

Sub EditCode()
    SendKeys "%{F11}"
End Sub

Sub AddMenu()
    On Error Resume Next
    Dim aMenu() As String
    Dim aMenuAct() As String

    Dim codeEditName As String
    codeEditName = "> マクロ編集"

    If Not IsControl(HEAD_TITLE) Then
        Set contextmenu = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Temporary:=True)
        With contextmenu
            .Caption = HEAD_TITLE
            .BeginGroup = False
        End With
        With contextmenu.Controls.Add(Temporary:=True)
            .Caption = codeEditName
            .OnAction = "EditCode"
            .BeginGroup = True
        End With
    End If

    Set contextmenu = Application.CommandBars("Cell").Controls(HEAD_TITLE)
    With contextmenu
        aMenu = Split(MENU, ",")
        aMenuAct = Split(MENU_ACT, ",")

        For i = 0 To UBound(aMenu)
            If Not IsSubControl(aMenu(i)) Then
                bidx = contextmenu.Controls(codeEditName).Index
                With .Controls.Add(Temporary:=True, Before:=bidx)
                    .Caption = aMenu(i)
                    .OnAction = aMenuAct(i)
                End With
            End If
        Next
    End With
End Sub

Function IsControl(name As String) As Boolean
    Dim found As Boolean

    For Each c In Application.CommandBars("Cell").Controls
        If c.Caption = name Then
            found = True
        End If
    Next c
    IsControl = found
End Function

Function IsSubControl(name As String) As Boolean
    On Error GoTo ex
    Dim found As Boolean
    found = False
    For Each c In Application.CommandBars("Cell").Controls(HEAD_TITLE).Controls
        If c.Caption = name Then
            found = True
        End If
    Next c

ex:
    IsSubControl = found
End Function

xla 파일을 만드는 방법

Excel을 시작하고 빈 통합 문서를 엽니다.

Alt + F11 키를 눌러 매크로 프로그램 화면을 엽니 다

왼쪽 프로젝트 메뉴에서 VBAProject(Book1) 설명을 찾아 오른쪽 클릭 > 삽입 > 표준 모듈을 선택합니다.　(「Book1」은 신규로 열린 북의 명칭입니다)

오른쪽에 삽입한 신규 표준 모듈(공백 영역)이 생기므로 거기에 앞의 코드를 붙인다.

Ctrl + S 키를 눌러 아무 곳에나 저장합니다.

저장된 xla 파일을 두 번 클릭하여 엽니다.

열어도 좋은지 확인 다이얼로그가 나오므로 OK한다. (※모르는 파일에는 실시하지 않는 것)

오른쪽 클릭 메뉴가 표시되는지 확인

주의점

배포된 추가 기능을 열면 반응하지 않고 움직이지 않는 현상

보안 제한이 걸려 있는 경우, 동작이 무반응이 되어, 빠져나갈 곳이 되고 있습니다.

xla 파일을 마우스 오른쪽 버튼으로 클릭하고 속성을 엽니 다

"일반"탭 아래의 "속성"근처에 "보안 해제"라는 표기가 있다면 그것을 확인하고 "OK"로 반영한다. (※ 물론 모르는 파일에는 실시하지 않는 것)

다시 열면 작동한다고 생각됩니다.

덤. 추가 기능 추가를 수행하는 추가 기능

아래 코드를 마찬가지로 "xla 파일을 만드는 방법"과 같은 절차로 작성하면 설치 프로그램 제거 프로그램과 유사합니다.
※파일명을 기준으로 동작하므로, 파일명은 타이틀 기재대로 해 주세요.
※ 인스톨러는 xla 파일과 같은 위치에 배치해 주십시오.
※수동으로 할 수 있는 일(애드인의 추가・삭제)을 매크로로 하고 있을 뿐이므로, 동작하지 않는 경우는 수동으로 실시해 주세요.

Install_【설치할 xla의 파일명(확장자 제외)】.xla

Sub Auto_Open()
    On Error GoTo ex

    If IsAddin(GetName()) Then
        MsgBox "既にアドインが起動されているので、続行できません。"
        Exit Sub
    End If

    If MsgBox(GetName() & "をExcelアドインに追加します。よろしいですか？", vbYesNo) = vbNo Then Exit Sub

    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile ThisWorkbook.Path & "\" & GetName() & ".xla", Application.UserLibraryPath & GetName() & ".xla"
    Set fso = Nothing

    Set myaddin = AddIns.Add(Filename:=Application.UserLibraryPath & GetName() & ".xla")
    myaddin.Installed = True

    MsgBox "Excelアドインを追加しました。次回起動時に有効になります。"

    Exit Sub
ex:
    MsgBox "アドインを追加できませんでした。Excelを開いた状態でInstallを実行してください。"
End Sub

Function IsAddin(name As String) As Boolean
    On Error GoTo ex
    IsAddin = False
    If AddIns(name).Installed = True Then
        IsAddin = True
    End If
ex:
End Function

Function GetName()
    Dim aNam() As String
    aNam = Split(Split(ThisWorkbook.name, ".")(0), "_", 2)
    GetName = aNam(1)
End Function

Uninstall_【제거할 xla의 파일명(확장자 제외)】.xla

Sub Auto_Open()
    On Error Resume Next

    Dim name As String
    name = GetName()

    If MsgBox(name & "をExcelアドインから削除します。よろしいですか？ ", vbYesNo) = vbNo Then Exit Sub

    Application.AddIns(name).Installed = False

    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.DeleteFile Application.UserLibraryPath & name & ".xla"
    Set fso = Nothing

    Application.CommandBars("Cell").Controls(name).Delete

    MsgBox "削除が完了しました。もし削除されていない場合は、Excelをすべて閉じた後に再度実行してください。"

End Sub

Function GetName()
    Dim aNam() As String
    aNam = Split(Split(ThisWorkbook.name, ".")(0), "_", 2)
    GetName = aNam(1)
End Function