Skip to content

Instantly share code, notes, and snippets.

@shizone
Created May 20, 2011 02:47
  • Star 2 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save shizone/982259 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment