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 Nothing) Then
'------------- 初回表示 -----------------------------
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
|
