(6)自作のツールバーからマクロ実行例
実行するマクロのイメージを表すアイコンがあると、通常使用しているアイコン（ツールバーボタン）
クリックで操作するのと同じ感じであり、自作のマクロを意識しないでマクロを実行できます（画面44参照）

画面44　自作のツールバー実行例

Sub 自作コマンドバー()
Dim cb As CommandBar
Dim cb1 As CommandBarButton
 
On Error Resume Next
    CommandBars("mycb").Delete
On Error GoTo 0
 
Set cb = Application.CommandBars.Add(Name:="mycb", Temporary:=True)
    With cb
        .Controls.Add Type:=msoControlButton, ID:=23, before:=1
        .Controls.Add Type:=msoControlButton, ID:=3, before:=2
        .Visible = True
        .Position = msoBarTop
    End With
Set cb1 = cb.Controls.Add(Type:=msoControlButton, before:=3)
   With cb1
        .BeginGroup = True
        .Caption = "画像の取り込み"
        .FaceId = 931
        .OnAction = "Macro1"
   End With
Set cb1 = cb.Controls.Add(Type:=msoControlButton, before:=4)
   With cb1
        .Caption = "画像の切り取り"
        .FaceId = 21
        .OnAction = "Macro1"
   End With
End Sub

[1]Excel2003で使用していたツールバーボタンのID番号について
Excel2003で使用していたコマンドバーボタンはExcel2010でも使用できますが（使用できないのもあり）、
表示方法が変わりFaceID番号一覧を表示するExcel2003のマクロはExcel2010のワークシートに表示
できなくなりました。

Excel2007/2010ではID番号一覧は表示できませんが、Excel2007/2010でもID番号指定で操作できるの
で、コマンドバーボタンを使いたい方を考慮し、付録のサンプルファイルに画像化したFaceID番号一覧
を掲載しました。
Excel2003までのID番号でExcel2007以降の追加分はありませんが必要な方は活用して下さい。（画面45）

画面45　FaceID番号一覧




(7)ショートカットメニューからマクロ実行例
ワークシート上で作業をする場合は、右クリックで「ショートカットメニュー」を表示して各種処理をすること
が多いと思います。その「ショートカットメニュー」　に自作のマクロを登録して実行すると大変便利です。
画面46は「ショートメニュー1」の実行例で、画面3-47は「ショートメニュー2」の実行例です。
Excel2007でメニューは無くなったが、ショートカットメニューは生きています。

画面46ショートカットメニューの最後に追加した例　


画面47　ショートカットメニューの7番目に追加した例　


Sub ショートメニュー1()
    With CommandBars("cell").Controls.Add(Temporary:=True)
        .Caption = "Webから株価ロード"
        .OnAction = "Macro1"
        .BeginGroup = True
    End With
End Sub
--------------------------------------------------------
Sub ショートメニュー2()
Dim cb As CommandBarButton
    Set cb = Application.CommandBars("cell").Controls.Add _
    (Type:=msoControlButton, Before:=7, temporary:=True)
 
    With cb
        .Caption = "Webから株価ロード"
        .OnAction = "Macro1"
    End With
End Sub
--------------------------------------------------------
Sub ショートメニュー3()
   ShortcutMenus(xlWorksheetCell).MenuItems.Add "-"
   ShortcutMenus(xlWorksheetCell).MenuItems.Add "Webから株価ロード", "Macro1"
End Sub
上記のAdd "-"で区切り線が入ります
--------------------------------------------------------
Sub ショートメニュー削除()
On Error Resume Next
    CommandBars("cell").Controls("Webから株価ロード").Delete
On Error GoTo 0
End Sub


【参考354】右クリックで ショ−トカットメニュ−を表示させない方法
 ショートカットメニューへ自作マクロ実行のアイテム追加を記述しましたが、右クリックで ショ−トカット
メニュ−を表示させたくない場合は、下記のように右クリックイベントの引数を「 Cancel = True」設定で
表示しません。

「Sheet1」コードウインドウ
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Cancel = True MsgBox "ショートカットメニュー「キャンセル」になっています" End Sub



(8)既存のメニューアイテムへ追加してマクロ実行例
本例はExcel2003のワークシートメニューの「ツール」へ「Webからロード」項目を追加した例です。ただし、
Excel2007からメニューバーとツールバーが廃止されたので、本サンプルマクロを実行でExcel2007は
メニューではなく、リボンの「アドイン」クリックで、Excel2003のメニューアイテムは表示しませんが、
追加した項目のみ表示されます（画面48、画面49参照）。

画面48　Excel2003既存のメニューアイテムへ追加例


画面49　Excel2010アドインへ追加例


Sub 既存アイテムへ追加()
Dim menu As CommandBar
 
Set menu = Application.CommandBars("Worksheet Menu Bar")
Set menu1 = menu.Controls("ツール(&T)")
 
Set menu2 = menu1.Controls.Add(Type:=msoControlButton, Temporary:=True)
   With menu2
        .Caption = "Webからロード"
        .OnAction = "Macro1"
   End With
End Sub
----------------------------------------------------------
Sub 既存アイテムへ削除()
    CommandBars("worksheet menu bar").Reset
End Sub



(9)メニューへ新規に追加してマクロ実行例
Excel2007からメニューバーとツールバーが廃止されました。　Excel2003既存メニュー分は表示されませ
んが、ユーザーの追加分は表示されます。メニューへ新規に追加したアイテムも前項のアイテムへ
追加したのと同じようにリボンの「アドイン」クリックで表示できます（画面50、画面51参照）。

画面50　メニューへ新規に追加（Excel2003)


画面51　メニューへ新規に追加（Excel2010)


Sub メニューへ新規追加()
Set menu1 = Application.CommandBars("worksheet menu bar")
Set menu2 = menu1.Controls.Add(Type:=msoControlPopup, Temporary:=True)
 
menu2.Caption = "追加メニュー"
 
With menu2
     .Controls.Add Type:=msoControlButton
   With .Controls(1)
        .Caption = "株価ロード"
        .OnAction = "Macro1"
 
   End With
 
 サブメニュー追加
    .Controls.Add Type:=msoControlPopup
   With .Controls(2)
        .Caption = "その他"
 
        .Controls.Add Type:=msoControlButton
        .Controls(1).Caption = "シート保護"
        .Controls(1).OnAction = "シート保護"
 
        .Controls.Add Type:=msoControlButton
        .Controls(2).Caption = "シート保護解除"
        .Controls(2).OnAction = "保護解除"
 
        .Controls.Add Type:=msoControlButton
        .Controls(3).Caption = "HTMLファイル作成"
        .Controls(3).OnAction ="Macro1"
  '      .Controls(3).OnAction = "C:\サンプル\KIweb\KIweb.xls!chengs"
   End With
 End With
End Sub
  Sub シート保護() ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True MsgBox "シートにプロテクトを掛けました" End Sub
Sub 保護解除() ActiveSheet.Unprotect MsgBox "シートにプロテクトを解除しました" End Sub


【参考355】プロシージャへ記述してマクロを実行させる例
 特定のプロシージャ（下記例：chengs）を実行させたい場合、事前に参照を設定したないとエラーになります。

Sub test1()
  '  Application.Run "C:\サンプル\KIweb\KIweb.xls!chengs"
 
  '  Application.Run "KIweb.xls!chengs"
 
  '  Call chengs
End Sub



(10) マクロを一定時間で連続実行するコマンド使用例
マクロの連続実行を行う方は一般的には少ないかもしれないが、株価をリアルタイムに解析して
ランキング表示したい場合などでは必ず使う機能です。

[1]OnTimeメソッドで連続実行例
OnTimeメソッドは指定した時刻に指定したプロシージャを実行します。指定した時刻に達するまでは、
キー入力も受け付けるし普通のExecl操作が可能であり、OnTimeメソッドは扱い易いメソッドです。

Const zikan As Date = "0:00:01"
Dim kurikaesitm As Date
 
Sub 連続1()
    Call 連続1a
    kurikaesitm = Now + TimeValue(zikan)
    Application.OnTime kurikaesitm, "連続1"
End Sub<
--------------------------------------------------------
Sub 連続1a()
    Cells(3, 3) = Int((56 + 1) * Rnd + 1)
    Cells(3, 3).Interior.ColorIndex = Cells(3, 3).Value
End Sub
--------------------------------------------------------
Sub 連続中止()
On Error Resume Next
    Application.OnTime kurikaesitm, "連続1", , False
    MsgBox "プロシジャ[連続1]の実行を中止しました"
On Error GoTo 0
    End
End Sub


[2]GetTickCount関数で連続実行例
こちらはAPIのGetTickCount関数を使用した連続実行例です。
Do….Loopでタイミングをとりますが、マクロは常時実行中であり1秒以下の制御も可能です。ただし、
マクロから抜ける処理が失敗すると無限ループになることがあり前述のOnTimeメソッドより使用は難しい。
なお、本例ではループタイミング中は「↓」キーの監視を入れてあり、「↓」で実行を中止します。

Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetAsyncKeyState Lib "User32.dll" _
(ByVal vKey As Long) As Long
Dim tima As Long, tmae As Long
Dim byo As Integer, kystop As Integer, clrm As Integer
 
Sub 連続2()
    kystop = 0
Do
byo = 0
    Do
        DoEvents
          tima = GetTickCount
            If tima - tmae >= 1000 Then
                tmae = tima
                byo = 1
            End If
        If GetAsyncKeyState(40) < 0 Then
            kystop = 1
            Exit Do
        End If
        If byo = 1 Then
            Exit Do
        End If
    Loop
 
    If kystop = 1 Then
        Exit Do
    End If
    Call 連続2a
Loop
    MsgBox "プロシジャ[連続2]の実行を中止しました"
End Sub
 --------------------------------------------------------
Sub 連続2a()
    Cells(7, 3) = Int((56 + 1) * Rnd + 1)
    Cells(7, 3).Interior.ColorIndex = Cells(7, 3).Value
End Sub


【参考355】プロシージャへ記述してマクロを実行させる例
 特定のプロシージャ（下記例：chengs）を実行させたい場合、事前に
参照を設定したないとエラーになります。
Sub test1()
  '  Application.Run "C:\サンプル\KIweb\KIweb.xls!chengs"
 
  '  Application.Run "KIweb.xls!chengs"
 
  '  Call chengs
End Sub


【戻る】　　　　【Top画面】　　　【HPへ】