Excel方眼紙アドイン

Excel方眼紙アドイン

Option Explicit

Sub AddNewMenu()
    On Error GoTo ErrHand

    Dim cbrCmd As CommandBar
    Dim cbcMenu As CommandBarControl

    Set cbrCmd = Application.CommandBars("Worksheet Menu Bar")
    cbrCmd.Controls("方眼紙").Delete
    Set cbcMenu = cbrCmd.Controls.Add(Type:=msoControlPopup)
    cbcMenu.Caption = "方眼紙"

    With cbcMenu.Controls.Add(Type:=msoControlButton)
        .Caption = "全シートを方眼紙化"
        .OnAction = "ThisWorkBook.Squared"
    End With

    Set cbrCmd = Nothing
    Set cbcMenu = Nothing

    Exit Sub

ErrHand:

    If Err.Number = 5 Then
       Resume Next
    Else
       MsgBox Err.Description
    End If
End Sub

Sub RemoveMenu()
    On Error GoTo ErrHand

    Dim cbrCmd As CommandBar

    Set cbrCmd = Application.CommandBars("Worksheet Menu Bar")
    cbrCmd.Controls("方眼紙").Delete

    Set cbrCmd = Nothing
    
    Exit Sub

ErrHand:
    If Err.Number = 5 Then
       Resume Next
    End If
End Sub

Sub Squared()
    Dim i As Integer
    For i = 1 To ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(i).Activate
        Cells.Select
        Selection.RowHeight = 13.5
        Selection.ColumnWidth = 2
        Cells(1, 1).Select
    Next
    ActiveWorkbook.Sheets(1).Activate
    Cells(1, 1).Select
End Sub

Private Sub Workbook_Open()
    AddNewMenu
End Sub

Private Sub Workbook_AddinInstall()
    AddNewMenu
End Sub

Private Sub Workbook_AddinUninstall()
    RemoveMenu
End Sub