access2010 Webブラウザーコントロール その3

Webブラウザーコントロールのobjectプロパティ
Webブラウザーコントロールのメソッドでは、実体であるIEを直接操作することができない。
イベントはひと通り揃ってるからよいのだけれど、GoBackとかリロードさせるメソッドがないということ。なので、objectプロパティで オブジェクトを参照しメソッドを呼び出す。

Option Compare Database
Option Explicit
'エラー処理してない

Private wbObj As WebBrowser

Const BaseUrl = "http://www.google.co.jp/"

Private Sub cmdBack_Click()
    wbObj.GoBack
End Sub

Private Sub cmdForword_Click()
    wbObj.GoForward
End Sub

Private Sub cmdReload_Click()
    wbObj.Refresh
End Sub

Private Sub Form_Load()
    Set wbObj = Me.Webブラウザー0.Object
    Me.Webブラウザー0.ControlSource = URLstring(BaseUrl)
End Sub

Private Function URLstring(x As String)
    URLstring = Chr(61) & Chr(34) & x & Chr(34)
End Function

access2010 access2007 メッセージバー（読み取り専用）の制御

Option Compare Database
Option Explicit
'*********************************************
'引用及び参考：http://www.ka-net.org/
'参照設定：oleacc.dll
'*********************************************
Private Const CHILDID_SELF = 0&
Private Const OBJID_CLIENT = &HFFFFFFFC
Private Const ROLE_SYSTEM_PUSHBUTTON = &H2B

#If VBA7 Then
Private Declare PtrSafe Function AccessibleChildren Lib "oleacc" ( _
                                ByVal paccContainer As IAccessible, _
                                ByVal iChildStart As Long, _
                                ByVal cChildren As Long, _
                                ByRef rgvarChildren As Any, _
                                ByRef pcObtained As Long _
                                ) As Long
 
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
                                ByVal hWnd As LongPtr, _
                                ByVal dwId As Long, _
                                riid As Any, _
                                ByRef ppvObject As IAccessible _
                                ) As Long
 
Private Declare PtrSafe Function IIDFromString Lib "ole32" ( _
                                ByVal lpsz As LongPtr, _
                                lpiid As Any _
                                ) As Long

Private Declare PtrSafe Function FindWindowEx Lib "user32" _
                                Alias "FindWindowExA" ( _
                                ByVal hWnd1 As LongPtr, _
                                ByVal hWnd2 As LongPtr, _
                                ByVal lpsz1 As String, _
                                ByVal lpsz2 As String _
                                ) As LongPtr
Private Function MsgBarHwnd() As LongPtr
    Dim hndl As LongPtr
    hndl = FindWindowEx(hWndAccessApp, 0, _
                       "MsoCommandBarDock", "MsoDockTop")
    hndl = FindWindowEx(hndl, 0, "MsoCommandBar", " ") '決め打ちしてるところ
    hndl = FindWindowEx(hndl, 0, "MsoWorkPane", vbNullString)
    hndl = FindWindowEx(hndl, 0, "NUIPane", vbNullString)
    hndl = FindWindowEx(hndl, 0, "NetUIHWND", vbNullString)
    MsgBarHwnd = hndl
End Function
#Else
Private Declare Function AccessibleChildren Lib "oleacc" ( _
                                ByVal paccContainer As IAccessible, _
                                ByVal iChildStart As Long, _
                                ByVal cChildren As Long, _
                                ByRef rgvarChildren As Any, _
                                ByRef pcObtained As Long _
                                ) As Long
 
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
                                ByVal hwnd As Long, _
                                ByVal dwId As Long, _
                                riid As Any, _
                                ByRef ppvObject As IAccessible _
                                ) As Long
 
Private Declare Function IIDFromString Lib "ole32" ( _
                                ByVal lpsz As Long, _
                                lpiid As Any _
                                ) As Long

Private Declare Function FindWindowEx Lib "user32" _
                                Alias "FindWindowExA" ( _
                                ByVal hWnd1 As Long, _
                                ByVal hWnd2 As Long, _
                                ByVal lpsz1 As String, _
                                ByVal lpsz2 As String _
                                ) As Long

Private Function MsgBarHwnd() As Long
    Dim hndl As Long
    hndl = FindWindowEx(hWndAccessApp, 0, _
                       "MsoCommandBarDock", "MsoDockTop")
    hndl = FindWindowEx(hndl, 0, "MsoCommandBar", " ") '決め打ちしてるところ
    hndl = FindWindowEx(hndl, 0, "MsoWorkPane", vbNullString)
    hndl = FindWindowEx(hndl, 0, "NUIPane", vbNullString)
    hndl = FindWindowEx(hndl, 0, "NetUIHWND", vbNullString)
    MsgBarHwnd = hndl
End Function
#End If
Private Function GetAcc(myAcc As IAccessible, _
                        myAccName As String, _
                        myAccRole As Long _
                        ) As IAccessible
  Dim ReturnAcc As IAccessible
  Dim ChildAcc As IAccessible
  Dim List() As Variant
  Dim Count As Long
  Dim i As Long
   
  If (myAcc.accState(CHILDID_SELF) <> 32769) And _
     (myAcc.accName(CHILDID_SELF) = myAccName) And _
     (myAcc.accRole(CHILDID_SELF) = myAccRole) Then
    Set ReturnAcc = myAcc
  Else
    Count = myAcc.accChildCount
    If Count > 0& Then
      ReDim List(Count - 1&)
      If AccessibleChildren(myAcc, 0&, ByVal Count, List(0), Count) = 0& Then
        For i = LBound(List) To UBound(List)
          If TypeOf List(i) Is IAccessible Then
            Set ChildAcc = List(i)
            Set ReturnAcc = GetAcc(ChildAcc, myAccName, myAccRole)
            If Not ReturnAcc Is Nothing Then Exit For
          End If
        Next
      End If
    End If
  End If
  Set GetAcc = ReturnAcc
End Function

Function MsgBarClose()
    If CurrentDb.Updatable Then Exit Function
    Do Until MsgBarHwnd <> 0
        DoEvents
    Loop
    Dim accApp As IAccessible, acc As IAccessible, accChild As IAccessible
    Dim IID(0 To 3) As Long, strName As String
#If VBA7 Then
    strName = "このメッセージを閉じる"
#Else
    strName = "閉じる"
#End If
    IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), IID(0)
    If AccessibleObjectFromWindow(MsgBarHwnd, _
                                  OBJID_CLIENT, _
                                  IID(0), _
                                  acc) _
                                  <> 0 Then Exit Function

    Set accChild = GetAcc(acc, strName, ROLE_SYSTEM_PUSHBUTTON)
    accChild.accDoDefaultAction CHILDID_SELF
End Function

ちょっと安定した
振り返ると、メッセージバーを表示しないメニューコマンドの実行/DoCmd.RunCommand acCmdHideMessageBar で制御できるし。

access2010 ナビゲーションフォーム その5

移動ボタン(NavigationButton)と移動コントロール(NavigationControl)の件。
移動ボタンにはParentTab、移動コントロールにはTabs、っつープロパティがあったのね。
ちょっと遠回りしたか?

Dim NavCtr As NavigationControl
Dim NavBtn As NavigationButton
Set NavCtr = Me.移動コントロール5 '最上位ではない

For Each NavBtn In NavCtr.Tabs
    Debug.Print NavBtn.Name, NavBtn.ParentTab.Name
Next
'ここまでとここからの出力はちょっとだけ違うけど
For Each NavBtn In NavCtr.Controls
    Debug.Print NavBtn.Name, NavBtn.Properties("NavigationParentButton")
Next

ヘルプを見ると、最上位レベルとある。英語版でもTop-Levelとなっているが、最上位ということではなく、親。ひとつ上位レベルの移動ボタン(NavigationButton)を参照できる。
そして、最上位レベルである時ParentTabを参照すると、強制終了する。

If NavCtr.Properties("NavigationParent") <> "" Then
    For Each NavBtn In NavCtr.Tabs
        Debug.Print NavBtn.Name, NavBtn.ParentTab.Name
    Next
End If

単純に選択されている移動ボタン(NavigationButton)を参照するだけなら、移動コントロール(NavigationControl)のSelectedTabプロパティでいい。

access2010 access2007 Win32API レジストリ その2

Option Compare Database
Option Explicit
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Const HKEY_CURRENT_USER = &H80000001
 
Private Const ERROR_SUCCESS = 0
 
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_DWORD = 4 '32-bit number
 
Private Const REG_OPTION_NON_VOLATILE = 0
 
Private Const KEY_ALL_ACCESS = &HF003F
Private Const KEY_SET_VALUE = &H2
 
#If VBA7 Then
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As LongPtr
    bInheritHandle As Long
End Type
 
Private Const strTrustedLocations = "Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\"

Private Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" _
                                Alias "RegCreateKeyExA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpSubKey As String, _
                                ByVal Reserved As Long, _
                                ByVal lpClass As String, _
                                ByVal dwOptions As Long, _
                                ByVal samDesired As Long, _
                                lpSecurityAttributes As SECURITY_ATTRIBUTES, _
                                phkResult As LongPtr, _
                                lpdwDisposition As Long _
                                ) As Long
  
Private Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" _
                                Alias "RegSetValueExA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpValueName As String, _
                                ByVal Reserved As Long, _
                                ByVal dwType As Long, _
                                lpData As Any, _
                                ByVal cbData As Long _
                                ) As Long
 
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
                                ByVal hKey As LongPtr _
                                ) As Long

Private Declare PtrSafe Function CoCreateGuid Lib "OLE32.DLL" ( _
                                pGuid As GUID _
                                ) As Long
#Else
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
 
Private Const strTrustedLocations = "Software\Microsoft\Office\12.0\Access\Security\Trusted Locations\"

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
                                Alias "RegCreateKeyExA" ( _
                                ByVal hKey As Long, _
                                ByVal lpSubKey As String, _
                                ByVal Reserved As Long, _
                                ByVal lpClass As String, _
                                ByVal dwOptions As Long, _
                                ByVal samDesired As Long, _
                                lpSecurityAttributes As SECURITY_ATTRIBUTES, _
                                phkResult As Long, _
                                lpdwDisposition As Long _
                                ) As Long
  
Private Declare Function RegSetValueEx Lib "advapi32.dll" _
                                Alias "RegSetValueExA" ( _
                                ByVal hKey As Long, _
                                ByVal lpValueName As String, _
                                ByVal Reserved As Long, _
                                ByVal dwType As Long, _
                                lpData As Any, _
                                ByVal cbData As Long _
                                ) As Long
 
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
                                ByVal hKey As Long _
                                ) As Long

Private Declare Function CoCreateGuid Lib "OLE32.DLL" ( _
                                pGuid As GUID _
                                ) As Long
#End If

Public Function GetNewGUID() As String
    Dim udtGUID As GUID
    If (CoCreateGuid(udtGUID) = 0) Then
        GetNewGUID = "{" & _
        String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & "-" & _
        String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & "-" & _
        String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & "-" & _
        IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _
        IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & "-" & _
        IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _
        IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _
        IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _
        IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _
        IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _
        IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7)) & "}"
    End If
End Function

Sub setTrustedLocations()
#If VBA7 Then
    Dim hNewKey As LongPtr
#Else
    Dim hNewKey As Long
#End If
    Dim lngrtn As Long, strSubKey As String
    Dim SA As SECURITY_ATTRIBUTES, rtnDisp As Long
    Dim strValue As String, lngValue As Long
    
    strSubKey = strTrustedLocations & GetNewGUID
    
    lngrtn = RegCreateKeyEx(HKEY_CURRENT_USER, _
                            strSubKey, _
                            0, _
                            vbNullString, _
                            REG_OPTION_NON_VOLATILE, _
                            KEY_ALL_ACCESS, _
                            SA, _
                            hNewKey, _
                            rtnDisp)
    If lngrtn = ERROR_SUCCESS Then
        strValue = CurrentProject.Path & "\"
        RegSetValueEx hNewKey, _
                      "Path", _
                      0, _
                      REG_SZ, _
                      ByVal strValue, _
                      LenB(strValue)
        
        strValue = CurrentProject.Name & "の自炊レジストリ"
        RegSetValueEx hNewKey, _
                      "Description", _
                      0, _
                      REG_SZ, _
                      ByVal strValue, _
                      LenB(strValue)
        
        strValue = Format(Now, "yyyy/mm/dd hh:nn")
        RegSetValueEx hNewKey, _
                      "Date", _
                      0, _
                      REG_SZ, _
                      ByVal strValue, _
                      LenB(strValue)
        
'        lngValue = 1
'        RegSetValueEx hNewKey, _
'                      "AllowSubfolders", _
'                      0, _
'                      REG_DWORD, _
'                      lngValue, _
'                      Len(lngValue)
    End If
    RegCloseKey hNewKey
End Sub

access2010 Quick Access Display（仮）

これの制御方法がわかんない。accessのオプションなんだけど、
Application.SetOption "Size of MRU File List", 0　じゃないんだよな。そもそも、Size of MRU File List　使えてないみたいだし。
[クライアントの設定]→[表示]→[最近使用した...]の設定は、
キー名：HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\File MRU
名前：Max Display
で、backstageから投入するのは、
名前：Max Quick Access Display
に入ってるしな。SetOptionメソッドで設定する方法が不明だから、そのうちにでも。
で、本題のショートカットの件。

キー名：HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\File MRU
名前：Quick Access Display
に情報がある。 レジストリを直接いじればなんとか。

Sub setQuickAccessDisplay()
    Dim kHnd As LongPtr, lngvalue As Long, lngrtn As Long
    lngvalue = 0 '0:非表示　1:表示
    Const strSubKey = "Software\Microsoft\Office\14.0\Access\File MRU"
    Const strName = "Quick Access Display"
    lngrtn = RegOpenKeyEx(HKEY_CURRENT_USER, strSubKey, 0, KEY_SET_VALUE, kHnd)
    If lngrtn = ERROR_SUCCESS Then
        RegSetValueEx kHnd, strName, 0, REG_DWORD, lngvalue, Len(lngvalue)
    End If
    RegCloseKey kHnd
End Sub

もしくは、
[カレントデータベース]→[リボンとツールバーのオプション]→[すべてのメニューを表示する]で非表示にする。だけど、この場合、セパレータが残る。

CustomUI/backstage要素内で制御する方法はなさそう。

office2010 Win32API レジストリ

Option Compare Database
Option Explicit

Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As LongPtr
        bInheritHandle As Long
End Type

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Const ERROR_SUCCESS = 0

Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_DWORD = 4 '32-bit number

Private Const REG_OPTION_NON_VOLATILE = 0

Private Const KEY_ALL_ACCESS = &HF003F
Private Const KEY_SET_VALUE = &H2
Private Const KEY_QUERY_VALUE = &H1

Private Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" _
                                Alias "RegCreateKeyExA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpSubKey As String, _
                                ByVal Reserved As Long, _
                                ByVal lpClass As String, _
                                ByVal dwOptions As Long, _
                                ByVal samDesired As Long, _
                                lpSecurityAttributes As SECURITY_ATTRIBUTES, _
                                phkResult As LongPtr, _
                                lpdwDisposition As Long _
                                ) As Long

Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" _
                                Alias "RegOpenKeyExA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpSubKey As String, _
                                ByVal ulOptions As Long, _
                                ByVal samDesired As Long, _
                                phkResult As LongPtr _
                                ) As Long

' Note that if you declare the lpData parameter as String, you must pass it By Value.
' RegQueryValueEx kHnd, strName, 0, 0, ByVal strBuffer, Len(strBuffer)
Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" _
                                Alias "RegQueryValueExA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpValueName As String, _
                                ByVal lpReserved As LongPtr, _
                                lpType As Long, _
                                lpData As Any, _
                                lpcbData As Long _
                                ) As Long

' Note that if you declare the lpData parameter as String, you must pass it By Value.
' RegSetValueEx kHnd, strName, 0, REG_SZ, ByVal strValue, Len(strValue)
Private Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" _
                                Alias "RegSetValueExA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpValueName As String, _
                                ByVal Reserved As Long, _
                                ByVal dwType As Long, _
                                lpData As Any, _
                                ByVal cbData As Long _
                                ) As Long

Private Declare PtrSafe Function RegDeleteKey Lib "advapi32.dll" _
                                Alias "RegDeleteKeyA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpSubKey As String _
                                ) As Long

Private Declare PtrSafe Function RegDeleteValue Lib "advapi32.dll" _
                                Alias "RegDeleteValueA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpValueName As String _
                                ) As Long

Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
                                ByVal hKey As LongPtr _
                                ) As Long

Private Declare PtrSafe Function RegQueryInfoKey Lib "advapi32.dll" _
                                Alias "RegQueryInfoKeyA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal lpClass As String, _
                                lpcbClass As Long, _
                                ByVal lpReserved As LongPtr, _
                                lpcSubKeys As Long, _
                                lpcbMaxSubKeyLen As Long, _
                                lpcbMaxClassLen As Long, _
                                lpcValues As Long, _
                                lpcbMaxValueNameLen As Long, _
                                lpcbMaxValueLen As Long, _
                                lpcbSecurityDescriptor As Long, _
                                lpftLastWriteTime As FILETIME _
                                ) As Long

Private Declare PtrSafe Function RegEnumKeyEx Lib "advapi32.dll" _
                                Alias "RegEnumKeyExA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal dwIndex As Long, _
                                ByVal lpName As String, _
                                lpcbName As Long, _
                                ByVal lpReserved As LongPtr, _
                                ByVal lpClass As String, _
                                lpcbClass As Long, _
                                lpftLastWriteTime As FILETIME _
                                ) As Long

Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" _
                                Alias "RegEnumValueA" ( _
                                ByVal hKey As LongPtr, _
                                ByVal dwIndex As Long, _
                                ByVal lpValueName As String, _
                                lpcbValueName As Long, _
                                ByVal lpReserved As LongPtr, _
                                lpType As Long, lpData As Byte, _
                                lpcbData As Long _
                                ) As Long

access2010 access2007 Application.ProductCode

Application.ProductCodeで何を見るか。

{BRMMmmmm-PPPP-LLLL-p000-D000000FF1CE}

MMがメジャーバージョンだから、12だとOffice2007,14だとOffice2010
PPPPが製品IDで、001CがAccess Runtime
pはx86/x64で、x86だと 0、x64なら 1

Office 2010 における製品コード GUID の番号付けのしくみ

2007 Office スイートおよび 2007 Office プログラムにおける製品コード GUID の番号付けのしくみについて

Office2003以前だとちょっと違う
Office 2003 における製品コード GUID の番号付けのしくみ

年末だから、チラシの裏

だらだらと自分用メモとして始めてみたのだけれども、なんだか面白かったなぁと。
Bloggerの統計をみて思ってしまった。

多い順で。
1.日本
日本語なのだから当たり前、全体の95%。自分のアクセスも含まれちゃってんだろうから。
2.アメリカ合衆国
特に印象なし。なんだっけ
3.ルクセンブルグ
ルクセンブルグの人には悪いんだけど、どこにあるのかすら知らんかった。どうやらいい国っぽいな。行ってみたい国１番手。
4.ブラジル
遠いよね、日本から。船旅でなら行ってみたい。
5.カナダ
来日した台湾系米国人が、カナダはいいぜぇ、一緒に行こうぜなんて言ってたけど行きません。
6.南アフリカ
これまた遠いなぁ。google.co.zaからだったかな
7.オランダ
王国なんだよね。飾り窓とかあっちの方しか思い浮かばないのは、申し訳ない。
8.ラトビア
バルト3国って行ってみたい地域。だって、美人が多いって言うじゃないの。
9.ハンガリー
共産党時代があった国や地域ってなんか好き。
10.中国
ニーハオ。グレートファイアウォールはどうなっているのだろうか。

その他、いろんな国からのアクセスがあったみたいなんだけど、google.co.jpだったりするんよね。
いろんなところに日本人がいるのだろうなぁと。行ってみたいなよその国。

1.access2010 不具合
まぁ、当然だな。こればっかりは仕方がない。どえらく機能が追加されてるわけだし、早いとこSP1出してほしいものだ。それ以前に、Win7SP1でどうなるかが気になるが。
2.access 2007 runtime ショートカットメニューが出ない
えぇ、出ませんとも。自前で作るか、Application.Commandbars(hoge).ShowPopupでどうぞ。
3.access2010 backstage ビュー 非表示
ribbonXml書いて好きなだけ非表示にしちゃいなよ。
4.access2010 webデータベース
取っ掛かりは面白い。だが、Sharepointがないとダメなんで今後どうなっていくのかな。office365で使用できるのだけれども、これは広がっていくのだろうか。office15でどうなるかな。フォームがWebページに変換されるのは、スゲーなと思う。ちょっとだけ思い入れ。
5.access2010 互換性
何との互換性だけど、互換性はないと思うべき。JetからAce、VBA7、64bitとかいろいろあるし。access2010x64でaccde/mde/ade作ると、それ以外で開くことできないんだよ。ファイルを開くことができないってことね。
6.access2010 idmso
ribbonに関する情報が少ないんだな、きっと。2010の情報探しても2007の情報を見てください的なこと多い気がする。
7.access 2007 vba 分割フォーム
多分一番ダメな子だと思う。2010でもあるのだけれども、表舞台にはいないし。TempVars使え。
8.access2010 配布
お好きなだけどうぞ。Runtime版は無償で使用できますからね。
9.access2010ﾗﾝﾀｲﾑのリボン
ribbonxml書いて。慣れたら簡単。
10.class_initialize　mysql
記憶にございません。

なんだかなぁと思いつつ思い入れもある検索キーワード

76件てどうなのよと。

9件てね。きっと、どうでもいいことなんだな。いつか役に立つ日がくるかな。

チラシの裏終わり

access2010 パッケージソリューションウィザード その12

だらだらメモし続けて、その12
access2010 パッケージソリューション 表示されない　のキーワードでの検索が定期的にあるようなので書いておく。

1.インストールしないとだめですよ。

2.COMアドインから削除してしまったとき

インストールオプションの再インストールしてもだめみたいなので、インストール済みであることを確認の上、表示されないユーザでログイン後、レジストリの追加
------reg File start ----
Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Microsoft\Office\Access\Addins\AccessPW.14]
"CommandLineSafe"=dword:00000000
"Description"="Microsoft Access Package Solution Wizard 2010 COM Addin"
"FriendlyName"="Microsoft Access Package Solution Wizard 2010 COM Addin"
"LoadBehavior"=dword:00000003
------reg File end ----

3. COMアドインのチェックを外して以降、なにしてもアクティブになってくれない時

LoadBehaviorの値を2から3に更新

Package Solution Wizard まとめはこちら

access2010 Ribbon comboBoxの不具合

invalidateControlで再キャッシュ後getTextで取得した値を中の人が忘れてしまう。

フォームを閉じるとき、invalidatecontrolを実行。開く時では、リボンがキャッシュされていないことがあるからと普通に考えた。要はフォームを開いたときは初期化しておきたかっただけ。
で、どうなるかというと、
comboBoxのItemを選択もしくは同じ文字列を投入し、フォームを閉じる。この時、comboBoxの値の初期化が成功するのは目視できる。だけど、フォームを再び開いたときには最後に投入したItemが選択された状態に戻っている。

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" 
               onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="tab01" label="タブ01">
        <group id="g01" label="グループ01">
          <comboBox id="cb01" label="コンボボックス" getText="getText">
            <item id="i01" label="item01" imageMso="Info" />
            <item id="i02" label="item02" imageMso="HappyFace" />
            <item id="i03" label="item03" imageMso="PanningHand" />
          </comboBox>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

Option Compare Database
Option Explicit

Private rbn As IRibbonUI

Sub onLoad(ribbon As IRibbonUI)
    Set rbn = ribbon
End Sub

Sub getText(ctr As IRibbonControl, rtn)
    rtn = "(未選択)"
End Sub

Sub Invalidate_cb01()
    rbn.InvalidateControl "cb01"
End Sub

Option Compare Database
Option Explicit

Private Sub Form_Close()
    Module1.Invalidate_cb01
End Sub

で、現時点での対策その1。但し、該当comboBoxが配置されているタブがアクティブになること

Option Compare Database
Option Explicit

Private rbn As IRibbonUI

Sub onLoad(ribbon As IRibbonUI)
    Set rbn = ribbon
End Sub

Sub getText(ctr As IRibbonControl, rtn)
    rtn = "(未選択)"
    DoEvents
End Sub

Sub Invalidate_cb01()
    rbn.InvalidateControl "cb01"
End Sub

Option Compare Database
Option Explicit

Private Sub Form_Load()
On Error Resume Next '初回のエラーだけ処理したい
    Module1.Invalidate_cb01
End Sub

対策その2。初期化なんて考えない。

access2010 Ribbon RibbonXmlが読み込まれるのはいつだ

RibbonXmlが読み込まれるタイミングの話。
CutomUI要素のonLoadはリボンが初めて使用される時のことでキャッシュされる時。どっちかっていうとonCacheって感じで違う話。

USysRibbonsに登録したRibbonXmlは自動的に全て読み込まれるのだが、これはAutoExecより先。
AutoExecでLoadCustomUIメソッドを同一RibbonNameで実行してみると明白。
で、BackstageをカスタマイズするRibbonXmlは、AutoExecでのLoadCustomUIメソッド実行が読み込みの最終期限。コマンドラインスイッチ　/x　マクロ実行では間に合わない。

Backstageに配置したコントロールを実行時に操作にする場合は、USysRibbonsで自動読み込むのではなく、AutoExecでCurrentProject.IsTrusted検査後、LoadCustomUIメソッドで読み込むことが大事なポイント。

Backstage以外をカスタマイズするRibbonXmlは、実際に使う時、つまりキャッシュされる直前までに読み込まれていればいい。

たぶんa2007も同じ。

access2010 パッケージソリューションウィザード その11 不具合修正

HotFixが公開されていたので、一応確認。
Description of the Access 2010 hotfix package (accessde-x-none.msp): December 14, 2010
サブフォルダにファイルを追加しようとした場合、「予期しないエラーが発生しました。」でパッケージが作成できないことに対する修正。一応SP1リリースということになっている。

a2010(x64)とa2007用はまだみたい。そのうちでるでしょって。
でもってOrcaで確認

SUBFOLDER1が追加されている。フォルダ名pict

ファイルも無事同梱されている

残念なことにレジストリがa2007用

もうね、なんで一緒に直さないのかと。
念のためインストールさせてみたけど、レジストリ以外は無事に処理が進む。

いまのところレジストリはウィザード途中でa2010用レジストリを追加もしくはmsiの修正が必要。そして、サブフォルダにaccessファイルを同梱してパッケージを作る時、必要に応じてAllowSubfoldersも追加しなければならない。

http://social.answers.microsoft.com/Forums/en-US/addbuz/thread/d009265c-6e87-432a-8515-9265b372836f 
Kathyのコメントがちょっと気になる。

Package Solution Wizard まとめはこちら

access2010 Ribbon contextualTabs TabSetFormReportExtensibility

ユーザ定義ができる組み込みtabSet。idMsoは、TabSetFormReportExtensibility
通常のタブと違うのはタブの表示とオブジェクトが開いたときタブがアクティブになる。
そして、一番右に表示される。

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <ribbon>
    <contextualTabs>
      <tabSet idMso="TabSetFormReportExtensibility">
        <tab id="tab02" label="オブジェクトが開かれたときアクティブになる">
          <group id="g02" label="グループ02">
            <labelControl id="lbl01" label="contextualTabs" />
          </group>
        </tab>
        <tab id="tab03" label="タブ03">
          <group id="g03" label="グループ03">
            <button id="btn02" label="ボタン02" imageMso="Info" />
          </group>
        </tab>
      </tabSet>
    </contextualTabs>
    <tabs>
      <tab id="tab01" label="タブ01" insertAfterMso="TabHomeAccess">
        <group id="g01" label="グループ01">
          <button idMso="ApplicationOptionsDialog" visible="true" />
          <button idMso="FileCloseDatabase" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

office2010 Win32API keybd_event Backstageを表示させない

access2010でファイルタブ押下してもBackstageを表示させない。といっても、onShowでESCキー押下しているだけ。

Option Compare Database
Option Explicit

Private Const VK_ESCAPE = &H1B
Private Const KEYEVENTF_KEYUP = &H2
Private Const KEYEVENTF_EXTENDEDKEY = &H1

'http://msdn.microsoft.com/ja-jp/library/cc364822.aspx
'SendInputを使えとなってるけど、別途x64対応せにゃならんからこっち使う。
Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
                                ByVal bVk As Byte, _
                                ByVal bScan As Byte, _
                                ByVal dwFlags As Long, _
                                ByVal dwExtraInfo As LongPtr)

Sub onShow(cntxt As Object)
    keybd_event VK_ESCAPE, 0, 0, 0
    keybd_event VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <backstage onShow="onShow" />
</customUI>

なのだけど、結局ribbonXmlを書かにゃならん。
SendInputを使うよりは、keybd_eventの方が64bit対応がすっきりしてていいかなということだけ。まぁとりあえず作動するし。

Access2010 フォームイベントのメモ

通常	レコードが0件で AllowAdditions=False	Load時 レコードソース設定	Open時 レコードソース設定
1:Form_Open1	1:Form_Open1	1:Form_Open1	1:Form_Open1
2:Form_Open2	2:Form_Open2	2:Form_Open2	2:Form_Load1
3:Form_Load1	3:Form_Load1	3:Form_Load1	3:Form_Load2
4:Form_Load2	4:Form_Load2	4:Form_Activate	4:Form_Resize
5:Form_Resize	5:Form_Resize	5:Form_Current	5:Form_Activate
6:Form_Activate	6:Form_Activate	6:Form_Load2	6:Form_GotFocus
7:Form_Current		7:Form_Resize	7:Form_Current
		8:Form_Deactivate	8:Form_Open2
		9:Form_Activate
		10:Form_Current
8:Form_Unload	7:Form_Unload	11:Form_Unload	9:Form_Unload
9:Form_Deactivate	8:Form_Deactivate	12:Form_Deactivate	10:Form_Deactivate
10:Form_Close	9:Form_Close	13:Form_Close	11:Form_Close

フォームにEnabled=Trueの コントロールがない	詳細セクションに Enabled=Trueの コントロールがない	PopUp/ダイアログ
1:Form_Open1	1:Form_Open1	1:Form_Open1
2:Form_Open2	2:Form_Open2	2:Form_Open2
3:Form_Load1	3:Form_Load1	3:Form_Load1
4:Form_Load2	4:Form_Load2	4:Form_Load2
5:Form_Resize	5:Form_Resize	5:Form_Resize
6:Form_Activate	6:Form_Activate	6:Form_Current
7:Form_GotFocus	7:Form_GotFocus
8:Form_Current	8:Form_Current
9:Form_Unload	9:Form_Unload	7:Form_Unload
10:Form_LostFocus	10:Form_GotFocus	8:Form_Close
11:Form_Deactivate	11:Form_LostFocus
12:Form_Close	12:Form_Deactivate
	13:Form_Close

Option Compare Database
Option Explicit
'access2010調べ
Private i As Integer

Private Sub Form_GotFocus()
    EventLog "Form_GotFocus"
End Sub

Private Sub Form_LostFocus()
    EventLog "Form_LostFocus"
End Sub

Private Sub Form_Open(Cancel As Integer)
    EventLog "Form_Open1"
'    Me.RecordSource = "テーブル1"
    EventLog "Form_Open2"
End Sub

Private Sub Form_Load()
    EventLog "Form_Load1"
'    Me.RecordSource = "テーブル1"
    EventLog "Form_Load2"
End Sub

Private Sub Form_Resize()
    EventLog "Form_Resize"
End Sub

Private Sub Form_Activate()
    EventLog "Form_Activate"
End Sub

Private Sub Form_Current()
    EventLog "Form_Current"
End Sub

Private Sub Form_Deactivate()
    EventLog "Form_Deactivate"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    EventLog "Form_Unload"
End Sub

Private Sub Form_Close()
    EventLog "Form_Close"
End Sub

Private Sub EventLog(str As String)
    i = i + 1
    Debug.Print i & ":" & str
End Sub

access2010 Webデータベース その6 accdwとはなんぞや

これだけかよ。ははは。

<?xml version="1.0" encoding="utf-8"?>
<ApplicationReference xmlns="http://schemas.microsoft.com/office/accessservices/2009/04/accdw">
  <URL>http://r2datafull01/sample01</URL>
</ApplicationReference>

syntaxhighlighter xml表示

あーやっとできた。でもIEだと1行でないな。もういいや。

<?xml version="1.0" encoding="utf-8"?>
<Wix xmlns="http://schemas.microsoft.com/wix/2006/wi">
  <Product Id="__GUID__" Name="Accessテストアプリケーション" Language="1041" Version="0.0.0.1" Manufacturer="MukkuMuku Div." UpgradeCode="__GUID__" Codepage="932">
    <Package Description="Accessアプリケーション配布テスト" Comments="Wix+WixEditでやってみた" InstallerVersion="200" Compressed="yes" />
    <Media Id="1" Cabinet="simple.cab" EmbedCab="yes" />
    <Directory Id="TARGETDIR" Name="SourceDir">
      <Directory Id="WINDOWSVOLUME" Name="sample01">
        <!--WindowsVolumeだとエラーって言ってくるんだわ-->
        <Directory Name="app01" Id="app01">
          <Component Id="db01" DiskId="1" Guid="__GUID__">
            <File Id="maindb.accdb" Name="maindb.accdb" Source="__source path__" KeyPath="yes">
              <Shortcut Id="desktopShortcut" Directory="DesktopFolder" Name="Accessテストアプリケーション" WorkingDirectory="INSTALLDIR" Advertise="yes" Icon="AppIcon.ico" IconIndex="0" />
              <Shortcut Id="ExeShortcut" Directory="ProgramMenuDir" Name="Accessテストアプリケーション" Advertise="yes" Icon="AppIcon.ico" IconIndex="0" />
            </File>
            <CreateFolder>
              <!--フォルダapp01に必要なパーミッションはここ-->
              <Permission User="Users" GenericExecute="yes" GenericRead="yes" GenericWrite="yes" />
              <Permission User="Administrators" GenericAll="yes" />
            </CreateFolder>
            <!--Access Trusted Location用のレジストリ-->
            <RegistryValue Key="Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\[ProductCode]" Root="HKLM" Type="string" Value="[app01]" Name="Path" />
          </Component>
        </Directory>
      </Directory>
      <Directory Id="DesktopFolder"></Directory>
      <Directory Id="ProgramMenuFolder">
        <Directory Id="ProgramMenuDir" Name="MukkuMuku Div.">
          <Component Id="StartMenuShortcuts" Guid="__GUID__">
            <RemoveFolder Id="ProgramMenuDir" On="uninstall" />
            <RegistryValue Root="HKCU" Key="Software\[Manufacturer]\[ProductName]" Type="string" Value="" />
            <Shortcut Id="UninstallProduct" Name="Uninstall" Description="Uninstalls the application" Target="[System64Folder]msiexec.exe" Arguments="/x [ProductCode]" />
          </Component>
        </Directory>
      </Directory>
    </Directory>
    <Feature Id="DefaultFeature" Title="Main Feature" Level="1">
      <ComponentRef Id="db01" />
      <ComponentRef Id="StartMenuShortcuts" />
    </Feature>
    <UI />
    <Icon Id="AppIcon.ico" SourceFile="__icon_source_path__" />
    <!--すべてのユーザで使えるようにするProperty-->
    <Property Id="ALLUSERS" Value="2" />
  </Product>
</Wix> 

access2010 Webデータベース その5 SharePoint上のユーザー権限

ACCDE’s are not supported in Access Services on SharePoint 2010
AccessTeamBlogに投稿されていたので、久しぶりにWebデータベースについて。
accdeはAccess Serviceに対応しないってことなんだけど、発行できなくはない。でも、あんまり意味ないし、不都合だらけだし。

以下、権限の話。
全てのユーザは、accdw経由でaccdbをダウンロードしファイルを開くことができる。そして、ローカル上ではオブジェクトの作成編集自体は可能。だが、権限がなければ新規や編集済みオブジェクトをSharepoint上のオブジェクトと同期させることができないというだけ。なので、事実上変更できないということ。
ローカルへダウンロードさせたくないとする場合は、Sharepointユーザ権限だけでは対応できないのではないかと思う。Access Serviceのサイトテンプレートをごにょごにょしないとならんような気がする。ドロップダウンメニューをいじるのはどっかで見た。

SharePoint Permission Level	Access Services Actions
	Read Data	Open in Access (rehydrate) / Take Offline	Modify/ Add Data	Create/ Modify Objects & Sync	Create/ Edit Schema	Publish
フルコントロール	○	○	○	○	○	○
デザイン	○	○	○	○	○	○
投稿	○	○	○	×	×	×
閲覧	○	○	×	×	×	×
制限付きアクセス	○	○	×	×	×	×

Sharepoint アクセス許可ダイアログ

権限が足りない場合　投稿

権限が足りない場合 閲覧

権限が足りない場合 閲覧

権限が足りない場合

ログ

access2010 アプリケーションパーツ その8 -accde-

accdeで運用している場合で、アプリケーションパーツを使用できる状態にしていると、削除できないフォームとレポートが氾濫することになる。と、いうことで、リボンでのコマンド制御などは必須になった。プリインストールのアプリケーションパーツを削除しておいたとしても、ユーザ定義のものも存在するからどうにもならね。

オブジェクトのインポートUIからだと、テーブル/クエリ以外は選択できないようになっているからよいのだけれど、アプリケーションパーツからだとオブジェクトががっつりとインポートされてしまうので要注意。
コードが含まれるアプリケーションパーツの場合、モジュール以外のオブジェクトがインポートされる。インスタンス化したフォームだとしてもVBAは実行されることはないから大きな影響はなさそうだけれども、なんだかなぁ。 可能性は低いだろうけど、モーダル+ショートカットメニューを表示しない+コントロールボックスがないフォームを開いてしまうともうどうにもならなくなるってことか。

特段の要件がない限り、Runtime/Runtimeモードでの展開をしておくべきなんだろうな、きっと。

access2010 アプリケーションアイコンの設定

Option Compare Database
Option Explicit

Sub SetAppIcon()
On Error GoTo ErrHnd
    Dim curPath As String
    Dim iconName As String, iconFullPath As String
    Dim rs As DAO.Recordset, rsPct As DAO.Recordset
    
    curPath = Application.CurrentProject.Path
    iconName = "logo"
    iconFullPath = curPath & "\" & iconName & ".ico"
    
    If Len(Dir(iconFullPath)) = 0 Then
        Set rs = CurrentDb.OpenRecordset( _
                "select Data from MSysResources where Name='" & _
                iconName & "';")
                'a2007なら添付ファイルありのテーブル使うべな
        Set rsPct = rs("Data").Value
        rsPct("FileData").SaveToFile iconFullPath
    End If
    
    ChangeProperty "AppIcon", dbText, iconFullPath
    ChangeProperty "UseAppIconForFrmRpt", dbBoolean, True
    Application.RefreshTitleBar
Exit Sub
ErrHnd:
    MsgBox Error$
End Sub

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 ピボットテーブルのVBAコーディング

とりあえず、単純なところまで。

Option Compare Database
Option Explicit
'参照設定：Microsoft Office XP Web Components
'C:\Program Files\Microsoft Office\Office14\OFFOWC.DLL

Private Sub inipvt()
    Dim fst As OWC10.PivotFieldSet

    With Me.PivotTable.activeview
        Do Until .RowAxis.FieldSets.Count = 0
            Set fst = .RowAxis.FieldSets(0)
            .RowAxis.RemoveFieldSet fst
        Loop

        Do Until .ColumnAxis.FieldSets.Count = 0
            Set fst = .ColumnAxis.FieldSets(0)
            .ColumnAxis.RemoveFieldSet fst
        Loop

        Do Until .FilterAxis.FieldSets.Count = 0
            Set fst = .FilterAxis.FieldSets(0)
            .FilterAxis.RemoveFieldSet fst
        Loop

        Do Until .DataAxis.Totals.Count = 0
            .DataAxis.RemoveTotal .DataAxis.Totals(0)
        Loop
        
        Do Until .Totals.Count = 0
            .DeleteTotal .Totals(0).Name
        Loop
    End With
End Sub

Private Sub Form_Load()

    Call inipvt
    
    Dim Fst1 As OWC10.PivotFieldSet
    Dim fld As OWC10.PivotField
    Dim ttl As OWC10.PivotTotal

    With Me.PivotTable.activeview
        Set Fst1 = .FieldSets("F_num1")
        .DataAxis.InsertFieldSet Fst1
        Set Fst1 = .FieldSets("F_num2")
        .DataAxis.InsertFieldSet Fst1
        
        Set Fst1 = .FieldSets("F_date")
        .RowAxis.InsertFieldSet Fst1
        
'        .FilterAxis.InsertFieldSet Fst1

        Set fld = .FieldSets("F_num1").Fields("F_num1")
        .AddTotal "合計：F_num1", fld, plFunctionSum
        Set ttl = .Totals("合計：F_num1")
        .DataAxis.InsertTotal ttl
        Set fld = .FieldSets("F_num2").Fields("F_num2")
        .AddTotal "合計：F_num2", fld, plFunctionSum
        Set ttl = .Totals("合計：F_num2")
        .DataAxis.InsertTotal ttl
    End With
End Sub