|
Sub オリジナル図形描画作成()
On Error Resume Next
Application.CommandBars("オリジナル図形描画").Delete
Set myCB = Application.CommandBars.Add(Name:="オリジナル図形描画")
With myCB
Set myCBCtrl = Application.CommandBars.FindControl(ID:=30013): _
myCBCtrl.Copy myCB
myCBCtrl.Caption = "図形の調整"
.Controls.Add ID:=182
.Controls.Add ID:=688
Set myCBCtrl = myCB.Controls.Add(ID:=1849)
myCBCtrl.BeginGroup = True
Set myCBCtrl = myCB.Controls.Add(ID:=313)
myCBCtrl.Style = msoButtonIcon
Set myCBCtrl = myCB.Controls.Add(ID:=852)
myCBCtrl.BeginGroup = True
Set myCBCtrl = myCB.Controls.Add(ID:=848)
With myCBCtrl
.TooltipText = " 《 シートの移動またはコピー 》" & vbLf & _
"・ブック内の移動 … シート名部をドラッグ&ドロップでも可" & vbLf & _
"・ブック内のコピー … [Ctrl]を押しながら、シート名部をドラッグ&ドロップでも可"
.Style = msoButtonIcon
.FaceId = 489
End With
Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
With myCBCtrl
.TooltipText = "シート保護・保護解除"
.FaceId = 225
.OnAction = "シート保護"
End With
Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
With myCBCtrl
.TooltipText = "シート見出しON・OFF"
.FaceId = 529
.OnAction = "シート見出し"
End With
Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
With myCBCtrl
.TooltipText = "シート選択"
.FaceId = 461
.OnAction = "シート選択"
End With
Set myCBCtrl = myCB.Controls.Add(ID:=522)
With myCBCtrl
.Style = msoButtonIcon
.FaceId = 2585
End With
Set myCBCtrl = myCB.Controls.Add(ID:=164)
With myCBCtrl
.Style = msoButtonIcon
.BeginGroup = True
.TooltipText = " 《 図形のグループ化 》" & vbLf & _
"[Shift]を押しながら、各図形を選択後、実行"
End With
.Controls.Add ID:=165
.Controls.Add ID:=338
Set myCBCtrl = myCB.Controls.Add(ID:=549)
myCBCtrl.TooltipText = " 《 グリッドに合わせる 》" & vbLf & _
"図形作成時、セルに位置合わせします。"
Set myCBCtrl = myCB.Controls.Add(ID:=1402)
myCBCtrl.TooltipText = " 《 図形に位置を合わせる 》" & vbLf & _
"図形作成時、他の図形に位置合わせします。"
Set myCBCtrl = myCB.Controls.Add(ID:=166)
myCBCtrl.Style = msoButtonIcon
Set myCBCtrl = myCB.Controls.Add(ID:=167)
myCBCtrl.Style = msoButtonIcon
Set myCBCtrl = Application.CommandBars.FindControl(ID:=30177): _
myCBCtrl.Copy myCB
myCBCtrl.Caption = "オートシェイプ"
Set myCBCtrl = myCB.Controls.Add(ID:=130)
myCBCtrl.TooltipText = " 《 直線 》" & vbLf & _
"・ダブルクリックにて連続直線となります。" & vbLf & _
"・連続直線の場合は、[図形に合わせる]との併用をお勧めします。"
.Controls.Add ID:=243
.Controls.Add ID:=409
Set myCBCtrl = myCB.Controls.Add(ID:=1111)
myCBCtrl.TooltipText = " 《 四角形 》" & vbLf & _
"[Shift]を押しながら行うと正方形なります。"
Set myCBCtrl = myCB.Controls.Add(ID:=1119)
myCBCtrl.TooltipText = " 《 楕円 》" & vbLf & _
"[Shift]を押しながら行うと真円なります。"
.Controls.Add ID:=139
.Controls.Add ID:=318
.Controls.Add ID:=1031
.Controls.Add ID:=682
Set myCBCtrl = myCB.Controls.Add(ID:=1691)
myCBCtrl.BeginGroup = True
.Controls.Add ID:=1692
.Controls.Add ID:=401
.Controls.Add ID:=692
.Controls.Add ID:=693
.Controls.Add ID:=694
.Controls.Add ID:=394
.Controls.Add ID:=339
.Controls(19).BeginGroup = True
.Visible = True
.Position = msoBarBottom
End With
Set myCB = Nothing: Set myCB2 = Nothing: Set myCBCtrl = Nothing: Set myCBCtrl2 = Nothing
End Sub
|
|