RibbonUI VBA Callback Signature

要素	コールバック	VBAシグネチャ
(複数のコントロール)	getDescription	Sub GetDescription(control As IRibbonControl, ByRef description)
(複数のコントロール)	getEnabled	Sub GetEnabled(control As IRibbonControl, ByRef enabled)
(複数のコントロール)	getImage	Sub GetImage(control As IRibbonControl, ByRef image)
(複数のコントロール)	getImageMso	Sub GetImageMso(control As IRibbonControl, ByRef imageMso)
comboBox	getItemCount	Sub GetItemCount(control As IRibbonControl, ByRef count)
dropDown	getItemCount	Sub GetItemCount(control As IRibbonControl, ByRef count)
gallery	getItemCount	Sub GetItemCount(control As IRibbonControl, ByRef count)
gallery	getItemHeight	Sub getItemHeight(control As IRibbonControl, ByRef height)
comboBox	getItemID	Sub GetItemID(control As IRibbonControl, index As Integer, ByRef id)
dropDown	getItemID	Sub GetItemID(control As IRibbonControl, index As Integer, ByRef id)
gallery	getItemID	Sub GetItemID(control As IRibbonControl, index As Integer, ByRef id)
comboBox	getItemImage	Sub GetItemImage(control As IRibbonControl, index As Integer, ByRef image)
dropDown	getItemImage	Sub GetItemImage(control As IRibbonControl, index As Integer, ByRef image)
gallery	getItemImage	Sub GetItemImage(control As IRibbonControl, index As Integer, ByRef image)
comboBox	getItemLabel	Sub GetItemLabel(control As IRibbonControl, index As Integer, ByRef label)
dropDown	getItemLabel	Sub GetItemLabel(control As IRibbonControl, index As Integer, ByRef label)
gallery	getItemLabel	Sub GetItemLabel(control As IRibbonControl, index As Integer, ByRef label)
gallery	getItemScreenTip	Sub GetItemScreenTip(control As IRibbonControl, index as Integer, ByRef screen)
comboBox	getItemScreenTip	Sub GetItemScreenTip(control As IRibbonControl, index As Integer, ByRef screentip)
dropDown	getItemScreenTip	Sub GetItemScreenTip(control As IRibbonControl, index As Integer, ByRef screenTip)
gallery	getItemSuperTip	Sub GetItemSuperTip (control As IRibbonControl, index as Integer, ByRef screen)
comboBox	getItemSuperTip	Sub GetItemSuperTip (control As IRibbonControl, index As Integer, ByRef supertip)
dropDown	getItemSuperTip	Sub GetItemSuperTip (control As IRibbonControl, index As Integer, ByRef superTip)
gallery	getItemWidth	Sub getItemWidth(control As IRibbonControl, ByRef width)
(複数のコントロール)	getKeytip	Sub GetKeytip (control As IRibbonControl, ByRef label)
(複数のコントロール)	getLabel	Sub GetLabel(control As IRibbonControl, ByRef label)
checkBox	getPressed	Sub GetPressed(control As IRibbonControl, ByRef returnValue)
toggleButton	getPressed	Sub GetPressed(control As IRibbonControl, ByRef returnValue)
(複数のコントロール)	getScreentip	Sub GetScreentip(control As IRibbonControl, ByRef screentip)
(複数のコントロール)	getSupertip	Sub GetScreentip(control As IRibbonControl, ByRef screentip)
dropDown	getSelectedItemID	Sub GetSelectedItemID(control As IRibbonControl, ByRef index)
gallery	getSelectedItemID	Sub GetSelectedItemID(control As IRibbonControl, ByRef index)
dropDown	getSelectedItemIndex	Sub GetSelectedItemIndex(control As IRibbonControl, ByRef index)
gallery	getSelectedItemIndex	Sub GetSelectedItemIndex(control As IRibbonControl, ByRef index)
button	getShowImage	Sub GetShowImage (control As IRibbonControl, ByRef showImage)
button	getShowLabel	Sub GetShowLabel (control As IRibbonControl, ByRef showLabel)
(複数のコントロール)	getSize	Sub GetSize(control As IRibbonControl, ByRef size)
comboBox	getText	Sub GetText(control As IRibbonControl, ByRef text)
editBox	getText	Sub GetText(control As IRibbonControl, ByRef text)
menuSeparator	getTitle	Sub GetTitle (control As IRibbonControl, ByRef title)
(複数のコントロール)	getVisible	Sub GetVisible(control As IRibbonControl, ByRef visible)
customUI	loadImage	Sub LoadImage(imageId As string, ByRef image)
command	onAction	Sub OnAction(control As IRibbonControl, ByRef CancelDefault)
button	onAction	Sub OnAction(control As IRibbonControl)
toggleButton	onAction	Sub OnAction(control As IRibbonControl, pressed As Boolean)
checkBox	onAction	Sub OnAction(control As IRibbonControl, pressed As Boolean)
dropDown	onAction	Sub OnAction(control As IRibbonControl, selectedId As String, selectedIndex As Integer)
gallery	onAction	Sub OnAction(control As IRibbonControl, selectedId As String, selectedIndex As Integer)
editBox	onChange	Sub OnChange(control As IRibbonControl, text As String)
comboBox	onChange	Sub OnChange(control As IRibbonControl, text As String)
customUI	onLoad	Sub OnLoad(ribbon As IRibbonUI)
customUI	loadImage	Sub LoadImage(imageId As String, ByRef image)
Backstage	onHide	Sub OnHide(contextObject As Object)
Backstage	onShow	Sub OnShow(contextObject As Object)
dynamicMenu	getContent	Sub GetContent(control As IRibbonControl, ByRef returnedVal)
(複数のコントロール)	getHelperText	Sub GetHelperText(control As IRibbonControl, itemIndex as Integer, ByRef returnedVal)
Image Control	getAltText	Sub GetAltText(control As IRibbonControl, ByRef returnedVal)

ShellSpecialFolderConstants Enumeration

ShellSpecialFolderConstants Enumeration
Shellでフォルダパスを取得するときに使う定数

Sub sample()
    Debug.Print CreateObject("Shell.Application").NameSpace(&H27)
    Debug.Print CreateObject("Shell.Application").NameSpace(&H27).self.Path
End Sub

access2010 CustomUI xml読み込んでからのRibbon設定

'Form:F01
Option Compare Database
Option Explicit

Private Sub Form_Load()
    rbn01.CreateRibbon
    Me.RibbonName = rbn01.rbnName
End Sub

'標準Module:rbn01
Option Compare Database
Option Explicit

Private rbn As IRibbonUI

Public Const rbnName = "rbnName"
Private Const xmlFilePath = "xmlFileFullPath"

Public Function OnLoad(ribbon As IRibbonUI)
    Set rbn = ribbon
End Function

Public Sub CreateRibbon()
    If Not rbn Is Nothing Then Exit Sub
    Dim xmldoc As Object
    Set xmldoc = CreateObject("MSXML2.DOMDocument")
    xmldoc.Load xmlFilePath
    Application.LoadCustomUI rbnName, xmldoc.xml
    Set xmldoc = Nothing
End Sub

access2010 AllowBypasskey Tool

アプリケーションパーツでツール
モーダルにしとけばいいんだな

Option Compare Database
Option Explicit

Private Sub Form_Load()
    Me.RecordSelectors = False
    Me.NavigationButtons = False
    SettglAllowBypasskey
End Sub

Private Sub cmdDelAllowBypassKey_Click()
On Error Resume Next
    CurrentDb.Properties.Delete "AllowBypassKey"
    SettglAllowBypasskey
End Sub

Private Sub tglAllowBypasskey_Click()
    With Me.tglAllowBypasskey
        SetBypassProperty .Value
        .Caption = "AllowBypasskey = " & CBool(.Value)
    End With
End Sub

Private Sub cmdClose_Click()
    DoCmd.Close
End Sub

Private Sub SetBypassProperty(fBool As Boolean)
Const DB_Boolean As Long = 1
    ChangeProperty "AllowBypassKey", DB_Boolean, fBool
End Sub

Private Sub SettglAllowBypasskey()
On Error GoTo ErrHnd
    With Me.tglAllowBypasskey
        .Value = CurrentDb.Properties("AllowBypassKey")
        .Caption = "AllowBypasskey = " & .Value
    End With
Exit Sub
ErrHnd:
    If Err.Number = 3270 Then
        Me.tglAllowBypasskey.Caption = "未設定"
        Me.tglAllowBypasskey = True
    Else
        MsgBox Err.Number
    End If
End Sub

Private Function ChangeProperty(strPropName As String, _
                                varPropType As Variant, _
                                varPropValue As Variant) As Integer

    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True

Change_Bye:
    Exit Function

Change_Err:
    If Err = conPropNotFoundError Then ' プロパティが見つからないエラーの場合。
        Set prp = dbs.CreateProperty(strPropName, _
                                     varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' 不明なエラーの場合。
        ChangeProperty = False
        Resume Change_Bye
    End If
End Function

access2010 SharedResources Tool

アプリケーションパーツでツール

Option Compare Database
Option Explicit

Private objFileSys As Object
Private objShell As Object

Private Sub Form_Load()
    Me.RecordSelectors = False
    Me.NavigationButtons = False
    Set objFileSys = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    SetlstResoueces
End Sub

Private Sub Form_Close()
    Set objFileSys = Nothing
    Set objShell = Nothing
End Sub

Private Sub addImage(imgnamestring As Variant, fullpathstring As Variant)
On Error Resume Next
    CurrentProject.AddSharedImage imgnamestring, fullpathstring
End Sub

Private Sub listResources()
    Dim Srs As SharedResources
    Dim Sr As SharedResource
    
    Set Srs = CurrentProject.Resources
    For Each Sr In Srs
        Debug.Print Sr.Name, Sr.Type
    Next
End Sub

Private Sub delResource(resourcenamestring As String)
    Dim Srs As SharedResources
    Dim Sr As SharedResource

    Set Srs = CurrentProject.Resources
    For Each Sr In Srs
        If Sr.Name = resourcenamestring Then Sr.Delete
    Next
End Sub

Private Sub cmdDelResource_Click()
    If IsNull(Me.lstResources) Then Exit Sub
    delResource Me.lstResources
    SetlstResoueces
End Sub

Private Sub cmdImageFile_Click()
    Dim fdialog As Office.FileDialog
    Dim varFilePath As Variant
    
    Set fdialog = Application.FileDialog(msoFileDialogFilePicker)
    With fdialog
        .AllowMultiSelect = True
        .Title = "ImageFileSelect"
        .Filters.Clear
        .Filters.Add "ImageFile", "*.gif; *.jpg; *.jpeg; *.png"
        .Filters.Add "すべてのファイル", "*.*"
        .InitialFileName = objShell.Namespace(&H27).self.Path & "\"
        If .Show = True Then
            For Each varFilePath In .SelectedItems
                addImage objFileSys.getbasename(varFilePath), varFilePath
            Next
        End If
    End With
    SetlstResoueces
End Sub

Private Sub cmdThemeFile_Click()
    CommandBars.ExecuteMso ("ThemeBrowseForThemes")
    SetlstResoueces
End Sub

Private Sub SetlstResoueces()
    Dim rs As Recordset
    Set rs = CurrentDb.OpenRecordset("select Name,Type from MSysResources order by Type;", dbReadOnly)
    Set Me.lstResources.Recordset = rs.Clone
    rs.Close: Set rs = Nothing
    Me.lstResources = Null
End Sub