目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

┃ ┃ ┃ ┃ ┃ ┃

269 / 277

←次へ　｜　前へ→

【9】ツールバー

ぴかる - 02/9/2(月) 21:06 -


	引用なし

	パスワード

Dim myCB As CommandBar
Dim myCB2 As CommandBar
Dim myCBCtrl As CommandBarControl
Dim myCBCtrl2 As CommandBarControl
Sub 既存ツールバーを非表示()

　　On Error Resume Next　　　　'エラーが発生しても処理を続行する
　　
　　For Each myCB In Application.CommandBars
　　　　myCB.Visible = False
　　Next myCB
　　
　　On Error GoTo 0　　　　　　 'エラー処理ルーチンを無効にする
　　
　　Application.CommandBars("Worksheet Menu Bar").Enabled = False
　　
End Sub
Sub 右クリック部追加()

　 For Each myCB In Application.CommandBars
　　　If myCB.Name = "Cell" Then myCB.Reset
　 Next
　
　 For Each myCB In Application.CommandBars
　　　If myCB.Name = "Cell" Then
　　　　 myCB.Reset
　　　　
　　　　 Set myCBCtrl = myCB.Controls.Add(ID:=369, Before:=5)
　　　　 With myCBCtrl
　　　　　　.Style = msoButtonIconAndCaption
　　　　　　.BeginGroup = True
　　　　 End With
　　　　
　　　　 Set myCBCtrl = myCB.Controls.Add(ID:=370, Before:=6)
　　　　 myCBCtrl.Style = msoButtonIconAndCaption
　　　　
　　　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton, Before:=7)
　　　　 With myCBCtrl
　　　　　　.FaceId = 1606
　　　　　　.Caption = "書式と値の貼り付け"
　　　　　　.Style = msoButtonIconAndCaption
　　　　　　.OnAction = "書式と値の貼り付け"
　　　　　　.Enabled = False
　　　　 End With
　　　
　　　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton, Before:=11)
　　　　 With myCBCtrl
　　　　　　.FaceId = 1964
　　　　　　.Caption = "すべてクリア（元に戻せません）"
　　　　　　.Style = msoButtonIconAndCaption
　　　　　　.OnAction = "全てクリア"
　　　　　　.BeginGroup = True
　　　　 End With
　　　
　　　End If
　 Next
　
End Sub
Sub オリジナル標準作成()

　　On Error Resume Next
　　Application.CommandBars("オリジナル標準").Delete
　　
　　Set myCB = Application.CommandBars.Add(Name:="オリジナル標準")
　　
　　With myCB
　　　　.Controls.Add ID:=2520
　　　　.Controls.Add ID:=23
　　　　.Controls.Add ID:=3
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=748)
　　 With myCBCtrl
　　　　 .Style = msoButtonIcon
　　　　 .FaceId = 271
　　 End With
　　
　　　　.Controls.Add ID:=3738

　　 Set myCBCtrl = myCB.Controls.Add(ID:=4)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=364
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=247)
　　 With myCBCtrl
　　　　 .Style = msoButtonIcon
　　　　 .TooltipText = "《ページ設定》" & vbLf & _
　　　　　　　　　　　　"　[ ページ ]" & vbLf & _
　　　　　　　　　　　　"　 ○ 横(F)を選択すると自動縮小します。" & vbLf & _
　　　　　　　　　　　　"　[ ヘッダー･フッター ]" & vbLf & _
　　　　　　　　　　　　" 　用紙上･下にコメント、ページNo等を付けて印刷できます。" & vbLf & _
　　　　　　　　　　　　"　[ シート ]" & vbLf & _
　　　　　　　　　　　　" 　データベース印刷時等の印刷時にタイトルを指定すると" & vbLf & _
　　　　　　　　　　　　"　全ての用紙に項目が入ります。"
　　 End With
　　
　　　　.Controls.Add ID:=109
　　　　.Controls.Add ID:=2
　　
　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .TooltipText = " 《すべてクリア》" & vbLf & _
　　　　　　　　　　　　"・数式、値、書式、図形の全てをクリアします。" & vbLf & _
　　　　　　　　　　　　"・実行後は、元に戻せません。ご注意下さい。"
　　　　 .FaceId = 1964
　　　　 .OnAction = "全てクリア"
　　　　 .BeginGroup = True
　　 End With

　　　　.Controls.Add ID:=21
　　　　.Controls.Add ID:=19
　　　　.Controls.Add ID:=22
　　　　.Controls.Add ID:=369
　　　　.Controls.Add ID:=370
　　
　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .FaceId = 1606
　　　　 .TooltipText = "書式と値の貼り付け"
　　　　 .Style = msoButtonIcon
　　　　 .OnAction = "書式と値の貼り付け"
　　 End With
　　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=280)
　　 myCBCtrl.TooltipText = "　《カメラ》" & vbLf & _
　　　　　　　　　　　　　　"・セル内容を図形として貼り付け出来ます。" & vbLf & _
　　　　　　　　　　　　　　"・思い通りの大きさに表を作成出来ない時等に最適です。" & vbLf & _
　　　　　　　　　　　　　　"・元セルと図形は、リンクしています。" & vbLf & _
　　　　　　　　　　　　　　"・図形の線の色にて線無しにする事をお勧めします。"
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=128)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=129
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=295)
　　 With myCBCtrl
　　　　 .BeginGroup = True
　　　　 .TooltipText = " 《挿入》" & vbLf & _
　　　　　　　　　　　　"・セル、行、列を選択後、実行！"
　　 End With
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=292)
　　 With myCBCtrl
　　　　 .TooltipText = " 《削除》" & vbLf & _
　　　　　　　　　　　　"・セル、行、列を選択後、実行！"
　　 End With
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=1576)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=226
　　　　.Controls.Add ID:=385
　　　　.Controls.Add ID:=210
　　　　.Controls.Add ID:=211
　　　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=486)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=452
　　　　.Controls.Add ID:=453
　　
　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .FaceId = 433
　　　　 .OnAction = "パレート図作成"
　　　　 .BeginGroup = True
　　　　 .TooltipText = "　《パレート図》" & vbLf & _
　　　　　　　　　　　　"・並び替え、比率計算を自動で行います。" & vbLf & _
　　　　　　　　　　　　"・データの左上角にセレクトして実行して下さい。" & vbLf & _
　　　　　　　　　　　　"・詳しい内容は、アイコンをクリックにて!!"
　　 End With

　　　　.Controls.Add ID:=436
　　　　.Controls.Add ID:=204
　　　　
　　 Set myCBCtrl2 = Application.CommandBars.FindControl(ID:=1733)
　　 Set myCBCtrl = myCB.Controls.Add(ID:=1733) '既存のコマンド：ズーム
　　 myCBCtrl.Width = myCBCtrl2.Width　'幅調整
　　　
　　　　.Controls.Add ID:=984
　　　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=282)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=186
　　　　.Controls.Add ID:=184
　　　　.Controls.Add ID:=1695
　　
　　　　.Visible = True
　　　　.Position = msoBarTop
　　
　　End With

End Sub
Sub オリジナル書式設定作成()
　　
　　On Error Resume Next
　　Application.CommandBars("オリジナル書式設定").Delete
　　
　　Set myCB = Application.CommandBars.Add(Name:="オリジナル書式設定")
　　
　　With myCB
　　　　.Controls.Add ID:=1728
　　　　
　　 Set myCBCtrl2 = Application.CommandBars.FindControl(ID:=1731)
　　 Set myCBCtrl = myCB.Controls.Add(ID:=1731) '既存のコマンド：ズーム
　　 myCBCtrl.Width = myCBCtrl2.Width　'幅調整
　　　
　　　　.Controls.Add ID:=403
　　　　.Controls.Add ID:=404
　　　　.Controls.Add ID:=113
　　　　.Controls.Add ID:=114
　　　　.Controls.Add ID:=115
　　　　.Controls.Add ID:=405
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=120)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=122
　　　　.Controls.Add ID:=121
　　
　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .TooltipText = "下詰め"
　　　　 .FaceId = 2601
　　　　 .OnAction = "'mySetVerticalAlignment " & xlBottom & "'"
　　 End With

　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .TooltipText = "中央揃え"
　　　　 .FaceId = 2602
　　　　 .OnAction = "'mySetVerticalAlignment " & xlCenter & "'"
　　 End With

　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .TooltipText = "上詰め"
　　　　 .FaceId = 2600
　　　　 .OnAction = "'mySetVerticalAlignment " & xlTop & "'"
　　 End With

　　 Set myCBCtrl = myCB.Controls.Add(ID:=402)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=1742
　　　　.Controls.Add ID:=800
　　　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=443)
　　 myCBCtrl.BeginGroup = True
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=298)
　　 With myCBCtrl
　　　　 .Style = msoButtonIcon
　　　　 .TooltipText = "《ウィンドウの整列》" & vbLf & _
　　　　　　　　　　　　"・単一ブックで行いたい場合は、" & vbLf & _
　　　　　　　　　　　　"　ウィンドウ→新しいウィンドウを開くで可!!" & vbLf & _
　　　　　　　　　　　　"・他のアプリケーションとの整列は、" & vbLf & _
　　　　　　　　　　　　"　下部のタスクバー上で右クリック!!"
　　 End With
　　
　　　　.Controls.Add ID:=541
　　　　.Controls.Add ID:=542
　　　　.Controls.Add ID:=1643
　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=396)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=397
　　　　.Controls.Add ID:=398
　　　　.Controls.Add ID:=399
　　　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=3162)
　　 myCBCtrl.BeginGroup = True
　　
　　　　.Controls.Add ID:=3161
　　
　　 Set myCBCtrl = Application.CommandBars.FindControl(ID:=203): _
　　　　　　　　　　myCBCtrl.Copy myCB
　　
　　　　.Controls.Add ID:=151
　　　　.Controls.Add ID:=150
　　　　.Controls.Add ID:=1704
　　
　　 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .FaceId = 256
　　　　 .OnAction = "罫線"
　　　　 .TooltipText = "罫線ﾀﾞｲｱﾛｸﾞ"
　　 End With

　　 Set myCBCtrl = Application.CommandBars.FindControl(ID:=1691): _
　　　　　　　　　　myCBCtrl.Copy myCB
　　
　　If Val(Application.Version) = 8 Then
　　 Set myCBCtrl2 = myCB.Controls.Add(Type:=msoControlSplitButtonPopup, ID:=1988)
　　 Set myCB2 = Application.CommandBars("Pattern")
　　 For Each myCBCtrl In myCB2.Controls
　　　　With myCBCtrl
　　　　　 myCBCtrl2.CommandBar.Controls.Add Type:=.Type, ID:=.ID
　　　　End With
　　 Next
　　Else
　　　　.Controls.Add ID:=1988
　　End If
　　
　　 Set myCBCtrl = Application.CommandBars.FindControl(ID:=401): _
　　　　　　　　　　myCBCtrl.Copy myCB
　　　　
　　 Set myCBCtrl = myCB.Controls.Add(ID:=283)
　　 myCBCtrl.TooltipText = "電卓"
　　　　
　　　　.Controls(28).BeginGroup = True
　　　　.Controls(33).BeginGroup = True
　　　　
　　　　.Visible = True
　　　　.Position = msoBarTop
　　
　　End With
　　
End Sub

6,117 hits