目安箱 IV

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

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
13 / 118 ﾂﾘｰ ←次へ　｜　前へ→
【56】マクロで作るコマンドバー、ツールバー Jaka 04/8/2(月) 10:32 Excel[未読]
【210】ツールバーボタンに指定した引数を持たせて作... Jaka 07/10/4(木) 13:09 Excel[未読]
【228】升目入力用ツールバーボタン Jaka 08/2/20(水) 16:13 Excel[未読]
【281】今更ながら。 Jaka 15/8/6(木) 12:25 Excel[未読]
【284】Re:今更ながら。 ヒラタ 17/6/14(水) 3:03 Access[未読]
【56】マクロで作るコマンドバー、ツールバー
Excel  Jaka  - 04/8/2(月) 10:32 -
引用なし
パスワード
   全部の参考リンクを書き込もうかと思いましたが、ぞろぞろ出てきたので全部拾い切れませんでした。。

Ｖ３
http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=9971;id=Excel
http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=11458;id=Excel

他は、ここのＶ３の方にもツールバー、コマンドバーで検索すれば結構あります。
http://www21.tok2.com/home/vbalab/


Ｖ４過去ログの方は適当に拾ってみました。
http://www.vbalab.net/vbaqa/data/excel/log/tree_63.htm
http://www.vbalab.net/vbaqa/data/excel/log/tree_225.htm
http://www.vbalab.net/vbaqa/data/excel/log/tree_265.htm
http://www.vbalab.net/vbaqa/data/excel/log/tree_344.htm

------------------------------------
リンクだけだとなんなので、一応コードも。
「ユーザー設定で作ったツールバーの添付」の方もツールバー位置変更の参考になると思います。

Sub マクロで作るコマンドバー()
　　Dim オリジナルバー As CommandBar
　　
　　'同じツールバー名がすでにあるのに作ろうとするとエラーになります。
　　'また、無いのに削除しようとするとエラーになります。
　　'他に方法が無いわけでもありませんが、取り合えず最初に削除。
　　On Error Resume Next
　　Application.CommandBars("ツールバーの名前").Delete
　　
　　Set オリジナルバー = Application.CommandBars.Add(Name:="ツールバーの名前", _
　　　　　　　　　　　　temporary:=True)　', Position:=msoBarBottom)
　　　　　　　　　　　 'temporary:=Trueするとエクセル終了時に自動的に削除されます。
　　
　　'作ったコマンドバーにボタン追加
　　Set オリジナルボタン1 = CommandBars("ツールバーの名前").Controls.Add(Type:=msoControlButton)
　　With オリジナルボタン1
　　　　'Style　アイコンとボタン名の表示
　　　　.Style = msoButtonIconAndCaption
　　　　.Caption = "マクロ１"
　　　　.FaceId = 59
　　　　.TooltipText = "マクロ１を実行します。"　'ボタンの説明みたいな物
　　　　.OnAction = "メッセージ1"　　　　　　　 'ボタンにマクロを割り当てる。
　　End With
　　
　　Set オリジナルボタン2 = CommandBars("ツールバーの名前").Controls.Add(Type:=msoControlButton)
　　With オリジナルボタン2
　　　　'アイコンだけ表示
　　　　.Style = msoButtonIcon
　　　　.Caption = "マクロ１"
　　　　.FaceId = 266
　　　　.TooltipText = "マクロ２を実行します。"
　　　　.OnAction = "メッセージ2"
　　End With
　　
　　'コマンドバーを表示
　　オリジナルバー.Visible = True
　　
　　Set オリジナルバー = Nothing
End Sub

Sub メッセージ1()
　　MsgBox "メッセージ1"
End Sub

Sub メッセージ2()
　　MsgBox "メッセージ2"
End Sub

***********************
他で回答した奴ですが。

Sub デスクトップ右下()
　　Dim Cb As CommandBar, LP2 As Single, TP2 As Single
　　On Error Resume Next
　　Application.CommandBars("TESTBAR").Delete
　　Set Cb = Application.CommandBars.Add(Name:="TESTBAR", Temporary:=True)
　　Cb.Controls.Add Type:=msoControlSplitDropdown, ID:=128, Before:=1
　　Cb.Controls.Add Type:=msoControlButton, ID:=1849, Before:=2
　　Cb.Controls.Add Type:=msoControlButton, ID:=928, Before:=3
　　Cb.Controls.Add Type:=msoControlComboBox, ID:=1733, Before:=4
　　Cb.Visible = True
　　Cb.Left = 1024　　'一応1024×768の解像度と想定していますが、
　　Cb.Top = 768　　　'この数字に深い意味はありません。
　　　　　　　　　　　'要するに使用している解像度より大きればいいみたいなんで適当。
　　LP2 = Cb.Left - 18
　　TP2 = Cb.Top - 19
　　Cb.Left = LP2
　　Cb.Top = TP2
End Sub
【210】ツールバーボタンに指定した引数を持たせて...
Excel  Jaka  - 07/10/4(木) 13:09 -
引用なし
パスワード
   引数は半角数字しか渡せません。

Sub 引数付きツールバー作成()
　　Dim 引数 As String, PtWd As String, ツールバー As CommandBar

　　For Each ツールバー In CommandBars
　　　　If ツールバー.Name = "マクロバー" Then
　　　　　 ツールバー.Visible = True
　　　　　 MsgBox "ツールバーはすでにあります。", vbExclamation
　　　　　 Exit Sub
　　　　End If
　　Next

　　横位置 = 3000
　　縦位置 = 4000
　　PtWd = InputBox("ボタンに持たせる引数（数字のみ）を入力してください。", "引数入力", , XPos:=横位置, YPos:=縦位置)
　　If PtWd = "" Then
　　　 MsgBox "引数なし　終了"
　　　 Exit Sub
　　ElseIf Not IsNumeric(PasWd) Then
　　　 MsgBox "数字だけです。　終了"
　　　 Exit Sub
　　End If

　　Set バーバー = Application.CommandBars.Add(Name:="マクロバー", temporary:=True)
　　Application.CommandBars("マクロバー").Visible = True

　　引数 = PtWd

　　With バーバー
　　　　With .Controls.Add(Type:=msoControlButton, Before:=1)
　　　　　　 .Style = msoButtonIconAndCaption　'←ボタンとCaption　 →msoComboLabel
　　　　　　 .FaceId = 482
　　　　　　　　　　　　　　　　　　　　' ↓　半角数字だけ、全角も半角に直される。
　　　　　　 .OnAction = "'実行マクロ(" & 引数 & ")'"
　　　　　　
　　　　　　 .TooltipText = "実行ボタン"
　　　　　　 .Caption = "引数を持ったボタンバー"
　　　　End With
　　End With
End Su

Sub 実行マクロ(ByVal mmm As String)
　　MsgBox "持っている引数は " & mmm, vbDefaultButton2, "取得してある引数"
End Sub

Sub 削除()
　 On Error Resume Next
　 Application.CommandBars("マクロバー").Delete
End Sub
【228】升目入力用ツールバーボタン
Excel  Jaka  - 08/2/20(水) 16:13 -
引用なし
パスワード
   升目入力用って言っても。下のような特殊文字ですけど。
記号だから升目作成時にあったら便利かな？って程度ですけど。

┼、┴、┬、┤、├、┘、└、┌、┐、│、─

尚、最終的な使い方のコードは自分で付け加えてください。
セルに１文字の入力じゃーあまり使わないだろうから....。
引数持たせたボタンの使い方１って事で。


Sub 升目文字()
　 Const CMBerNm As String = "マス目バー"
　 Dim MasBar As CommandBar, MojTB As Variant
　 Dim MJSt As String, i As Long

　 On Error Resume Next
　 Application.CommandBars(CMBerNm).Delete
　 On Error GoTo 0
　
　 MojTB = Array(9472, 9474, 9484, 9488, 9492, 9496, 9500, 9508, 9516, 9524, 9532)
　
　 Set MasBar = Application.CommandBars.Add(Name:=CMBerNm, temporary:=True)
　 Application.CommandBars(CMBerNm).Visible = True
　 With MasBar
　　　For i = 0 To UBound(MojTB)
　　　　 MJSt = ChrW(MojTB(i))
　　　　 With .Controls.Add(Type:=msoControlButton, Before:=1)
　　　　　　 .Style = msoButtonCaption
　　　　　　 .OnAction = "'マス目文字(" & MojTB(i) & ")'"
　　　　　　 .TooltipText = MJSt
　　　　　　 .Caption = MJSt
　　　　 End With
　　　Next
　 End With
　 MojTB = Empty
End Sub

Sub マス目文字(引数 As Long)
　 MsgBox ChrW(引数)
End Sub
【281】今更ながら。
Excel  Jaka  - 15/8/6(木) 12:25 -
引用なし
パスワード
   誤字だらけやん。
１０年たってから気づきました。
すみません。
他にもありそうな気が・・・。

>　　PtWd = InputBox("ボタンに持たせる引数（数字のみ）を入力してください。", "引数入力", , XPos:=横位置, YPos:=縦位置)
>　　If PtWd = "" Then
>　　　 MsgBox "引数なし　終了"
>　　　 Exit Sub
>　　ElseIf Not IsNumeric(PasWd) Then
>　　　 MsgBox "数字だけです。　終了"
>　　　 Exit Sub
>　　End If


ElseIf Not IsNumeric(PasWd) Then
　　↓
ElseIf Not IsNumeric(PtWd) Then
【284】Re:今更ながら。
Access  ヒラタ  - 17/6/14(水) 3:03 -
引用なし
パスワード
   ▼Jaka さん：
>誤字だらけやん。
>１０年たってから気づきました。
>すみません。
>他にもありそうな気が・・・。
>
>>　　PtWd = InputBox("ボタンに持たせる引数（数字のみ）を入力してください。", "引数入力", , XPos:=横位置, YPos:=縦位置)
>>　　If PtWd = "" Then
>>　　　 MsgBox "引数なし　終了"
>>　　　 Exit Sub
>>　　ElseIf Not IsNumeric(PasWd) Then
>>　　　 MsgBox "数字だけです。　終了"
>>　　　 Exit Sub
>>　　End If
>　
>
>ElseIf Not IsNumeric(PasWd) Then
>　　↓
>ElseIf Not IsNumeric(PtWd) Then


ご情報ありがとうございます。


yaplog.jp/hotbags/
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
13 / 118 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：   
0
(SS)C-BOARD v3.8 is Free