【 2016年9月15日  サイト 移転のお知らせ 】
      AddinBox サイトを [ DION ] から [ さくら インターネット ] へ移転しました。  なお、旧サイト は 2017年10月 まで残します。
      この ページ の 移転先 URL  ⇒⇒  http://addinbox.sakura.ne.jp/FaceIdBrowse.htm  
 
ロゴ(青) FaceId 一覧 ロゴ(緑)
エクセルなどのCommandBarで指定する『FaceId』を一覧表示するマクロです。

下記のマクロを【標準モジュール】に貼り付けて、「マクロ名:FaceId表示」を実行すると
表示されます。一度に500個を表示し[←→ボタン]で500個ずつシフト表示していきます。
(このマクロは、エクセルファンクラブ(VBAラウンジ)の スレッド でレスしたものです)

『FaceId表示』マクロを組み込んだブックを用意しました( FaceId_Browser.lzh 13KB )。

この【FaceId表示】は『kt関数アドイン』にも組み込んであります(メニュー呼び出し)。

※ Excel2007 では使えません(動作はしますが、横1列になって、下図のようにはなりません)※
きぬよ&あさみ さんが、リボン用のツール『Office 2007 Icon Viewer 』を公開されています。

FaceId一覧画像


Private Const cstBarName As String = "FaceId一覧"
Private int表示位置 As Integer


Public Sub FaceId表示()
    int表示位置 = 1
    Call FaceId一覧表示
End Sub


Private Sub FaceId表示Previous()
Dim MyCB As CommandBar
    On Error Resume Next
    'ボタンクリック時に呼ばれるからコマンドバーは必ず存在する
    Set MyCB = Application.CommandBars(cstBarName)
    int表示位置 = Val(MyCB.Controls(2).Caption)    '[〜]の前のみ
    Set MyCB = Nothing
    If (int表示位置 > 1) Then
        int表示位置 = int表示位置 - 500
        Call FaceId一覧表示
    End If
End Sub


Private Sub FaceId表示Next()
Dim MyCB As CommandBar
    On Error Resume Next
    'ボタンクリック時に呼ばれるからコマンドバーは必ず存在する
    Set MyCB = Application.CommandBars(cstBarName)
    int表示位置 = Val(MyCB.Controls(2).Caption)    '[〜]の前のみ
    Set MyCB = Nothing
    If (int表示位置 < 4001) Then
        int表示位置 = int表示位置 + 500
        Call FaceId一覧表示
    End If
End Sub


Private Sub FaceId一覧表示()
Dim i As Integer
Dim j As Integer
Dim MyCB As CommandBar
Dim MyCBCtrl As CommandBarControl
'-------------コマンドバー作成(Temporary)-------------
    On Error Resume Next
    Set MyCB = Application.CommandBars(cstBarName)
    On Error GoTo 0
    If (MyCB Is NothingThen
'------------- 初回表示 -----------------------------
        Set MyCB = Application.CommandBars.Add(cstBarName, , , True)
       'コマンドバーの「閉じるボタン(X)」を無効(非表示)にする
       MyCB.Protection = msoBarNoChangeVisible
'Controls(1)
        Set MyCBCtrl = MyCB.Controls.Add(Type:=msoControlButton)
        With MyCBCtrl
            .FaceId = 132 ' (←)
            .TooltipText = "前の500個"
            .OnAction = "FaceId表示Previous"
        End With
'Controls(2)
        Set MyCBCtrl = MyCB.Controls.Add(Type:=msoControlButton)
        With MyCBCtrl
            .Style = msoButtonCaption
            .Caption = "1〜500"
        End With
'Controls(3)
        Set MyCBCtrl = MyCB.Controls.Add(Type:=msoControlButton)
        With MyCBCtrl
            .FaceId = 133  ' (→)
            .TooltipText = "次の500個"
            .OnAction = "FaceId表示Next"
        End With
'Controls(4)
        Set MyCBCtrl = MyCB.Controls.Add(Type:=msoControlButton)
        With MyCBCtrl
            .FaceId = 358
            .TooltipText = "FaceId一覧の消去"
            .OnAction = "FaceId一覧削除"
        End With
'Controls(5)〜(504)
        For i = 1 To 500
            Set MyCBCtrl = MyCB.Controls.Add(Type:=msoControlButton)
            With MyCBCtrl
                If (i = 1) Then
                    .BeginGroup = True
                End If
                .FaceId = i
                .TooltipText = "(" & i & ")"
            End With
        Next i

        With MyCB
            .Width = MyCB.Controls(5).Width * 26    ' (25個分+α)
            .Top = 50
            .Left = 50
            .Visible = True
        End With

'------------- 表示範囲の書き換え --------------------------
    Else
        With MyCB.Controls(2) ' 表示範囲
            .Caption = int表示位置 & "〜" & int表示位置 + 499
        End With

        For i = 1 To 500
            With MyCB.Controls(i + 4)   '(5)〜(504)
                j = int表示位置 + i - 1
                .FaceId = j
                .TooltipText = "(" & j & ")"
            End With
        Next i
        MyCB.Visible = True
    End If

    Set MyCBCtrl = Nothing
    Set MyCB = Nothing
End Sub


Private Sub FaceId一覧削除()
    On Error Resume Next
    Application.CommandBars(cstBarName).Delete
End Sub

    [ Home へ戻る ]

ロゴ(ゴールド)   ロゴ(ゴールド)

角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2001 Allrights Reserved.