VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsOfficeClipBoard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

'------------------------------------------------------------
' 作成日：2003/12/20
' 作成者：YU-TANG@http://www.f3.dion.ne.jp/~element/msaccess/
' 目的：Office クリップボードを操作します。
'------------------------------------------------------------

' ********************************************
' * Microsoft Office X.0 Object Library への *
' * 参照設定が必須です。                     *
' * また[クリップボード] ツールバーがカスタマ*
' * イズされている場合は正常に動作しません。 *
' ********************************************

' ------------//変数宣言部//-------------
Dim cb  As CommandBar
Dim ocb As udtOfficeClipBoard

' ------------//構造体宣言部//-------------
Private Type udtOfficeClipBoard
    m_Copy     As CommandBarControl
    m_PasteAll As CommandBarControl
    m_Item     As CommandBarPopup
    m_Clear    As CommandBarControl
    m_Items    As New Collection
End Type

' ------------//コンストラクタ・デストラクタ定義部//-------------

' クラスのインスタンスが作成されたときに、変数を初期化します。
Private Sub Class_Initialize()
On Error GoTo ErrorHandler
    Dim c As CommandBarControl
    Set cb = CommandBars("Clipboard")
    Set ocb.m_Copy = cb.Controls("コピー(&C)")
    Set ocb.m_PasteAll = cb.Controls("すべて貼り付け(&L)")
    Set ocb.m_Item = cb.Controls("アイテム(&M)")
    Set ocb.m_Clear = cb.Controls("クリップボードのクリア(&L)")
    For Each c In ocb.m_Item.Controls
        ocb.m_Items.Add c
    Next
    Exit Sub
    
ErrorHandler:
    Beep
    Call Eval("MsgBox('" & "clsOfficeClipBoard の" & vbCrLf _
            & "初期化に失敗しました。@@処理を終了します。" _
            & "'," & vbCritical & ")")
End Sub

' インスタンスが削除されたときに、オブジェクト変数を
' 解放します。
Private Sub Class_Terminate()
On Error Resume Next
    Set ocb.m_Copy = Nothing
    Set ocb.m_PasteAll = Nothing
    Set ocb.m_Item = Nothing
    Set ocb.m_Clear = Nothing
    Set ocb.m_Items = Nothing
    Set cb = Nothing
End Sub

' ------------//メソッド定義部//-------------

' 関数名：Copy
' 目的：コピーを実行します。
' 戻り値：
'   成功すると格納したアイテムのインデックス（1-12）を返します。
'   失敗すると 0 を返します。
Public Function Copy() As Integer
    If (ocb.m_Copy.Enabled = False) Then Exit Function
    ocb.m_Copy.Execute
    Copy = MaxItems()
End Function

' 関数名：Clear
' 目的：コピー履歴をクリアします。
Public Sub Clear()
    If ocb.m_Clear.Enabled Then ocb.m_Clear.Execute
End Sub

' 関数名：Paste
' 目的：[貼り付け] を実行します。
' 引数：
'   省略可。貼り付けるアイテムのインデックスを渡します。
'   省略時あるいは 0 指定時は最終アイテムを貼り付けます。
' 戻り値：True=成功, False=失敗
Public Function Paste(Optional ByVal idx As Integer = 0) _
    As Boolean
    Dim i As Integer
    
    ' コピー済みアイテムが何も無い場合は終了します。
    i = MaxItems()
    If (i = 0) Then Exit Function
    
    ' 貼り付け対象アイテムのインデックスを確定します
    Select Case idx
        Case 0
            idx = i
        Case Is < 1, Is > ocb.m_Items.Count
            Exit Function
    End Select
    
    ' 貼り付けを実行します
    If (ocb.m_Items(idx).Enabled = False) Then Exit Function
    ocb.m_Items(idx).Execute
    
    ' 戻り値を設定します。
    Paste = True
End Function

' 関数名：PasteAll
' 目的：[全て貼り付け] を実行します。
' 戻り値：True=成功, False=失敗
Public Function PasteAll() As Boolean
    If (ocb.m_PasteAll.Enabled = False) Then Exit Function
    ocb.m_PasteAll.Execute
    PasteAll = True
End Function

' 関数名：ShowToolbar
' 目的：[クリップボード] ツールバーを表示します。
Public Sub ShowToolbar()
    If (cb.Visible = False) Then cb.Visible = True
End Sub

' 関数名：HideToolbar
' 目的：[クリップボード] ツールバーを非表示にします。
Public Sub HideToolbar()
    If (cb.Visible) Then cb.Visible = False
End Sub

' 関数名：ShowHistory
' 目的：アイテム履歴を表示します。
'   [クリップボード] ツールバーが非表示の場合は、まず
'   ツールバーを表示してから履歴を表示します。
Public Sub ShowHistory()
    Call ShowToolbar
    ocb.m_Item.Execute
End Sub


' ------------//プロパティ定義部//-------------

' 関数名：IsFull
' 目的：アイテムが既に 12 個存在するかどうかを返します。
' 戻り値：True=12 個存在する, False=12 個存在しない
Public Property Get IsFull() As Boolean
    IsFull = (MaxItems() = ocb.m_Items.Count)
End Property

' 関数名：IsEmpty
' 目的：全アイテムが空かどうかを返します。
' 戻り値：True=全アイテムが空, False=使用済みアイテム有り
Public Property Get IsEmpty() As Boolean
    IsEmpty = (MaxItems() = 0)
End Property

' 関数名：UsedItems
' 目的：使用済みアイテム数（0-12）を返します。
'   全アイテム未使用の場合は 0 を返します。
Public Property Get UsedItems() As Integer
    UsedItems = MaxItems()
End Property

' 関数名：UnusedItems
' 目的：未使用アイテム数（0-12）を返します。
'   全アイテム使用済みの場合は 0 を返します。
Public Property Get UnusedItems() As Integer
    UnusedItems = ocb.m_Items.Count - MaxItems()
End Property

' 関数名：Visible
' 目的：[クリップボード] ツールバーの表示状態を返します。
Public Property Get Visible() As Boolean
    Visible = cb.Visible
End Property

' 関数名：Visible
' 目的：[クリップボード] ツールバーの表示状態を設定します。
Public Property Let Visible(arg As Boolean)
    cb.Visible = arg
End Property

' 関数名：Caption
' 目的：アイテムの標題を返します。
' 引数：
'   省略可。アイテムのインデックス（1-12）を渡します。
'   省略時あるいは 0 指定時は使用済み最終アイテムの標題を返します。
' 戻り値：標題（文字列）
'   以下の場合は空文字列を返します。
'   1) 指定アイテムが空の場合
'   2) 指定インデックスが無効の場合
Public Property Get Caption(Optional ByVal idx As Integer = 0) _
    As String
    Dim i As Integer
    
    ' コピー済みアイテムが何も無い場合は終了します。
    i = MaxItems()
    If (i = 0) Then Exit Property
    
    ' 標題取得対象アイテムのインデックスを確定します
    Select Case idx
        Case 0
            idx = i
        Case Is < 1, Is > ocb.m_Items.Count
            Exit Property
    End Select
    
    ' アイテムが空であれば終了します
    Select Case ocb.m_Items(idx).Caption
        Case "空(&E)", "空": Exit Property
    End Select
    
    ' 戻り値を設定します。
    Caption = ocb.m_Items(idx).Caption
End Property

' ------------//内部処理用ユーティリティ関数定義部//-------------

' 関数名：MaxItems
' 目的：コピー済み履歴の最大インデックス（0-12）を返します。
'   コピー済み履歴が無い場合は 0 を返します。
Private Function MaxItems() As Integer
    Dim i As Integer
    Dim PrevVisible As Boolean
    ' ツールバーが表示されていないと正確な値を取得できないため、
    ' 非表示の場合はいったん表示します。
    Echo False
    PrevVisible = cb.Visible
    If (PrevVisible = False) Then cb.Visible = True
    For i = ocb.m_Items.Count To 1 Step -1
        Select Case ocb.m_Items(i).Caption
            Case "空(&E)", "空"
            Case Else: Exit For
        End Select
    Next
    If (PrevVisible = False) Then cb.Visible = False
    Echo True
    MaxItems = i
End Function