access2010 VSTOアプリケーションアドイン -7-

少しずつRibbonのカスタマイズを。

タブの間を行ったり来たりを自分好みに調整という感じで。最終的には組み込みタブの TabHomeAccess / TabCreate / TabExternalData / TabDatabaseTools をまとめたいかなと。ちょっと機能を加えながら。

<?xml version="1.0" encoding="UTF-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" 
          onLoad="Ribbon_Load">
  <ribbon>
    <tabs>
      <tab id="DevelopTab" 
           label="Development" 
           insertBeforeMso="TabHomeAccess">
        <group id="Files" label="Files" 
               autoScale="true" 
               imageMso="FileOpenDatabase">
          <button idMso="FileCloseDatabase" 
                  size="large" 
                  label="Close"/>
          <dynamicMenu id="dm1" size="large" 
                       label="Open" 
                       imageMso="FileOpenDatabase" 
                       getContent="dmGetContent" 
                       invalidateContentOnDrop="true"/>         
        </group>

Public Function dmGetContent(control As Office.IRibbonControl) As String
    Dim rf As New RecentFiles
    Return rf.getMenuContent
End Function

Public Sub menuItemOnAction(control As Office.IRibbonControl)
    Dim strFullName As String =
        Globals.ThisAddIn.Application.CurrentProject.FullName
    If control.Tag = strFullName Then
        Return
    ElseIf strFullName.Length > 0 Then
        Globals.ThisAddIn.Application.CloseCurrentDatabase()
    End If
    If IO.File.Exists(control.Tag) Then
        Globals.ThisAddIn.Application.OpenCurrentDatabase(control.Tag)
    Else
        Dim rf As New RecentFiles
        rf.DeleteMRU(control.Tag)
    End If
End Sub

Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Windows.Forms
Imports Microsoft.Win32

Public Class RecentFiles

    Const KeyName$ = "Software\Microsoft\Office\14.0\Access\File MRU"
    Const MenuItemsButton$ = "<button id=""_{0}"" label=""{1}"" tag=""{2}"" screentip=""{2}"" onAction=""menuItemOnAction""/>"
    Private TargetDir$ = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)

    Public Sub DeleteMRU(FullPath As String)
        Dim sb As New StringBuilder
        sb.AppendFormat("'{0}'、は存在しません。最近使ったファイルから削除しますか？", FullPath)
        If MessageBox.Show(sb.ToString,
                           "Infomation",
                           MessageBoxButtons.OKCancel,
                           MessageBoxIcon.Information) = DialogResult.OK Then
            Using reg As RegistryKey = Registry.CurrentUser.OpenSubKey(KeyName, True)
                If Not reg Is Nothing Then
                    Dim List = From Value In reg.GetValueNames.Where(Function(n) n.StartsWith("Item"))
                               Where DirectCast(reg.GetValue(Value), String).EndsWith(FullPath)
                               Select Value
                    reg.DeleteValue(List(0), False)
                End If
            End Using
        End If
    End Sub

    Public Function getMenuContent() As String
        Dim sb As New StringBuilder
        sb.Append("<menu xmlns=""http://schemas.microsoft.com/office/2009/07/customui"" >")
        sb.Append("<button idMso=""FileOpenDatabase""/>")
        sb.Append(GetRecentFiles)
        sb.Append(GetFiles)
        sb.Append("</menu>")
        Return sb.ToString
    End Function

    Private Function GetRecentFiles() As String
        Using reg As RegistryKey = Registry.CurrentUser.OpenSubKey(KeyName)
            If Not IsNothing(reg) Then
                Dim values = From value In reg.GetValueNames.Where(Function(n) n.StartsWith("Item"))
                        Let FileName = DirectCast(reg.GetValue(value), String)
                        Order By FileName Descending
                        Select FormatButtons(FileName.Substring(FileName.IndexOf("*") + 1))
                If values.Count > 0 Then
                    Return "<menuSeparator id=""MRUSeparator"" title=""Recent Files""/>" +
                        Join(values.ToArray, "")
                End If
            End If
            Return Nothing
        End Using
    End Function

    Private Function GetFiles() As String
        Dim regex As New Regex("\.(accdb|accde|mdb|mde|adp|ade)$")
        Dim files = From file In Directory.GetFiles(TargetDir)
                    Where regex.IsMatch(file)
                    Order By file
                    Select FormatButtons(file)
        If files.Count > 0 Then
            Return "<menuSeparator id=""MyDocumentsSeparator"" title=""MyDocuments""/>" +
                Join(files.ToArray, "")
        End If
        Return Nothing
    End Function

    Private Function FormatButtons(FileFullPath As String) As String
        Dim sb As New StringBuilder
        sb.AppendFormat(MenuItemsButton,
                        Guid.NewGuid.ToString("N"),
                        Path.GetFileName(FileFullPath),
                        FileFullPath)
        Return sb.ToString
    End Function
End Class

LINQとかラムダ式とかなんかおもしろい。手さぐり状態書いても動くことは確認できた。