如何动态加载Ribbon

为何我用窗体加载后没有出现自定义功能区呢，又没有提示出错：

Public Function LoadRibbons()
'Load ribbons into the database

On Error GoTo Error1

Dim db As DAO.Database
Set db = Application.CurrentDb

Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("tblRibbon")
' tblRibbon has to be replaced by your table name.

    Do Until rs.EOF
        Application.LoadCustomUI _
        rs("RibbonName").Value, rs("RibbonXML").Value
        rs.MoveNext
    Loop

Error1_Exit:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Function

Error1:
    Select Case Err
        Case 32609
        ' Ribbon already loaded
    Case Else
        MsgBox "Error: " & Err.Number & vbCrLf & _
               Err.Description, vbCritical, _
               "Error", Err.HelpFile, Err.HelpContext
    End Select
    Resume Error1_Exit

End Function

在窗体加载事件里放入：

Call CreateRibbon

打开窗体没有出错提示，但也看不到自定义功能区！