目安箱 IV

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

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

┃ ┃ ┃ ┃ ┃ ┃

265 / 277

←次へ　｜　前へ→

【13】メニューバー

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


	引用なし

	パスワード

Sub オリジナルメニューバー作成()

Dim myCB As CommandBar
Dim myCBCtrl As CommandBarControl
Dim myCBBtn As CommandBarButton
Dim myCBpup As CommandBarPopup

　　On Error Resume Next
　　Application.CommandBars("PikaBar").Delete
　　On Error GoTo 0
　　Set myCB = Application.CommandBars.Add(Name:="PikaBar", Position:=msoBarTop, MenuBar:=True)
　　
　　With Application.CommandBars(1)
　　　　For II% = 1 To 9
　　　　　　Select Case II%
　　　　　　　　Case 7:　　IdNum& = 30011
　　　　　　　　Case Else: IdNum& = 30000 + II% + 1
　　　　　　End Select
　　　　　　Set myCBCtrl = .FindControl(ID:=IdNum&): myCBCtrl.Copy myCB, II%
　　　　Next
　　End With
　　
　　Set myCBCtrl = myCB.Controls.Add(Type:=msoControlPopup)
　　With myCBCtrl
　　　　.Caption = "セル書式"
　　　　.BeginGroup = True
　　　　.OnAction = "列Caption"
　　End With
　　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .Caption = "表示形式"
　　　　 .OnAction = "表示形式"
　　 End With
　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .Caption = "配置"
　　　　 .OnAction = "配置"
　　 End With
　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .Caption = "フォント"
　　　　 .OnAction = "フォント"
　　 End With
　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .Caption = "罫線"
　　　　 .OnAction = "罫線"
　　 End With
　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .Caption = "パターン"
　　　　 .OnAction = "パターン"
　　 End With
　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .Caption = "保護"
　　　　 .OnAction = "保護"
　　 End With
　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(ID:=3058)
　　 myCBCtrl.BeginGroup = True
　　　
　　 Set myCBCtrl = myCB.Controls("セル書式").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .Caption = "列形式A1…R1C1"
　　　　 .OnAction = "列表示切替"
　　 End With
　　　
　　Set myCBCtrl = myCB.Controls.Add(Type:=msoControlPopup)
　　With myCBCtrl
　　　　.Caption = "入力設定"
　　　　.OnAction = "入力設定ON"
　　End With
　　
　　 Set myCBCtrl = myCB.Controls("入力設定").Controls _
　　　　.Add(Type:=msoControlButton)
　　 With myCBCtrl
　　　　 .FaceId = 984
　　　　 .Caption = "操作説明"
　　　　 .Style = msoButtonIconAndCaption
　　　　If Val(Application.Version) <> 8 Then
　　　　 .OnAction = "入力設定操作説明"
　　　　Else
　　　　 .OnAction = "入力設定操作説明97"
　　　　End If
　　 End With
　　　
　　Set myCBpup = myCB.Controls("入力設定").Controls.Add(Type:=msoControlPopup)
　　myCBpup.Caption = "入力範囲設定"
　　myCBpup.BeginGroup = True
　　
　　 Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
　　 With myCBBtn
　　　　 .Caption = "入力範囲ロック"
　　　　 .OnAction = "入力範囲ロック"
　　 End With
　　　
　　 Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
　　 With myCBBtn
　　　　 .Caption = "一時解除"
　　　　 .OnAction = "一時解除"
　　 End With
　　　
　　 Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
　　 With myCBBtn
　　　　 .Caption = "再設定"
　　　　 .OnAction = "再設定"
　　 End With
　　　
　　Set myCBpup = myCB.Controls("入力設定").Controls.Add(Type:=msoControlPopup)
　　With myCBpup
　　　　.Caption = "日本語入力"
　　End With
　　For II% = 1 To 3
　　　　Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
　　　　With myCBBtn
　　　　　　Select Case II%
　　　　　　　　Case 1: .Caption = "オン固定"
　　　　　　　　Case 2: .Caption = "オフ固定"
　　　　　　　　Case 3: .Caption = "コントロールなし"
　　　　　　End Select
　　　　　　.OnAction = "変換_" & Format(II%)
　　　　End With
　　Next
　　'
　　Set myCBpup = myCB.Controls("入力設定").Controls.Add(Type:=msoControlPopup)
　　With myCBpup
　　　　.Caption = "Enter移動"
　　End With
　　For II% = 1 To 5
　　　　Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
　　　　With myCBBtn
　　　　　　Select Case II%
　　　　　　　　Case 1: .Caption = "下"
　　　　　　　　Case 2: .Caption = "右"
　　　　　　　　Case 3: .Caption = "上"
　　　　　　　　Case 4: .Caption = "左"
　　　　　　　　Case 5: .Caption = "－"
　　　　　　End Select
　　　　　　.OnAction = "方向_" & Format(II%, "0")
　　　　End With
　　Next

5,577 hits