
' ----------------------------------------------------------------
' Hands-On 30-1
' No code.
' Please follow the instructions in the book.
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Hands-On 30-2
' No code.
' Please follow the instructions in the book.
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Hands-On 30-3
' Statements to be entered in the Immediate Window.
' ----------------------------------------------------------------

DoCmd.NavigateTo "acNavigationCategoryCreatedDate"
DoCmd.NavigateTo "acNavigationCategoryObjectType", "acNavigationGroupForms"
DoCmd.NavigateTo "acNavigationCategoryTablesAndViews", "Invoices"
DoCmd.NavigateTo "Objects in Development", "Dev Forms"
DoCmd.NavigateTo "acNavigationCategoryModifiedDate", "acNavigationGroupOlder"


' ----------------------------------------------------------------
' Code on page 788
' Statements to be entered in the Immediate Window.
' ----------------------------------------------------------------

DoCmd.SetDisplayedCategories False, "Objects in Development"
Application.ExportNavigationPane "C:\Acc07_ByExample\North2007NavConfig.xml"
Application.ImportNavigationPane "C:\Acc07_ByExample\North2007NavConfig.xml", False


' ----------------------------------------------------------------
' Hands-On 30-4
' Statements to be entered in the Immediate Window.
' ----------------------------------------------------------------

Application.ExportNavigationPane "C:\Acc07_ByExample\North2007NavConfig.xml"
Application.ImportNavigationPane "C:\Acc07_ByExample\North2007NavConfig.xml", False


' ----------------------------------------------------------------
' Hands-On 30-5
' Code location: \Acc07_HandsOn\EduSystems_01.txt
' See callback procedures in \Acc07_HandsOn\RibbonVBA.txt
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Custom Project 30-1
' Code location: \Acc07_HandsOn\RibbonVBA.txt
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Additional code on page 801
' ----------------------------------------------------------------

Sub OpenFrm(ByVal control AS IRibbonControl)
  Select Case control.Id
    Case "btnNewStud"
     DoCmd.OpenForm "Student Details", acNormal, , , acFormAdd
    Case "btnViewAllStud"
     DoCmd.OpenForm "Student List", acNormal
   End Select
End Sub


' ----------------------------------------------------------------
' Code on page 804 in Figure 30-27
' See the completed database \Acc07_Completed\EduSystems3.accdb
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Hands-On 30-6
' Code location: \Acc07_HandsOn\EduSystems_01.xml
' See the completed database \Acc07_Completed\EduSystems_Local.accdb
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Custom Project 30-2
' Code location: \Acc07_HandsOn\EduSystems_04.xml
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Custom Project 30-3
' Code location: \Acc07_HandsOn\EduSystems_05.txt
' ----------------------------------------------------------------

Public Sub OnLoadImage(imgName As String, ByRef image)
  Dim strImgFileName As String
  strImgFileName = "C:\Acc07_ByExample\images\" & imgName
  Set image = LoadPicture(strImgFileName)
End Sub


Public Sub OpenNotepad(ctl As IRibbonControl)
  Shell "Notepad.exe", vbNormalFocus
End Sub



' ----------------------------------------------------------------
' Code on pages 816-819 
' ----------------------------------------------------------------

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
  loadImage="OnLoadImage">
    <ribbon startFromScratch="false">
      <tabs>
        <tab id="custTabEdu" label="Edu Systems">
          <group id="StudGroup" label="Students">
            <button id="btnNewStud" imageMso="RecordsAddFromOutlook"
              size="large" label="Add Student"
              screentip="Add Student" supertip="Enter new student information"
              onAction="RibbonLib.OpenStudentDetails" />
            <button id="btnViewAllStud" imageMso="ShowDetailsPage"
              size="large" label="View Students"
              screentip="View Students"
              supertip="View Current Students"
              onAction="RibbonLib.OpenStudentList" />
          </group>
          <group id="ToolsGroup" label="Special Commands">
            <button idMso="FilePrintQuick" size="normal" />
            <button idMso="FileSendAsAttachment" size="normal" />
          </group>
            <group id="ImagesGroup" label="Special Features">
            <button id="btnNotes" label="Open Notepad"
               image="Note.gif" size="large"
               onAction="OpenNotepad" />
            <button id="btnComputer" label="Computer Folder"
               image="MyFolder.gif" size="normal" />
            <button id="btnRedStar" label="Honor Student"
               getImage="OnGetImage" size="large" />
            <gallery id="glHolidays" label="Holidays" columns="3" rows="4"
               getImage="OnGetImage" getItemCount="OnGetItemCount"
               getItemLabel="OnGetItemLabel" getItemImage="OnGetItemImage"
               getItemID="onGetItemID" onAction="onSelectedItem" />
         </group>
        </tab>
    </tabs>
  </ribbon>
</customUI>


Public Sub OnGetImage(ctl As IRibbonControl, ByRef image)
  Select Case ctl.id
     Case "btnRedStar"
       Set image = LoadPicture("C:\Acc07_ByExample\images\redstar.gif")
     Case "glHolidays"
       Set image = LoadPicture("C:\Acc07_ByExample\images\Square0.gif")
  End Select
End Sub


Public Sub OnGetItemCount(ctl As IRibbonControl, ByRef count)
   count = 12
End Sub


Public Sub OnGetItemLabel(ctl As IRibbonControl, _
       index As Integer, _
       ByRef label)
       label = MonthName(index + 1)
End Sub


Public Sub OnGetItemImage(ctl As IRibbonControl, _
                          index As Integer, _
                          ByRef image)

  Dim imgPath As String

  imgPath = "C:\Acc07_ByExample\images\square"
  Set image = LoadPicture(imgPath & index + 1 & ".gif")
End Sub


Public Sub onGetItemID(ctl As IRibbonControl, _
                      index As Integer, ByRef id)
  
  id = MonthName(index + 1)
End Sub



Public Sub onSelectedItem(ctl As IRibbonControl, _
                        selectedId As String, _
                        selectedIndex As Integer)
    Select Case selectedIndex
        Case 6
            MsgBox "Holiday 1: Independence Day, July 4th", _
            vbInformation + vbOKOnly, _
            selectedId & " Holidays"
        Case 11
            MsgBox "Holiday 1: Christmas Day, December 25th", _
            vbInformation + vbOKOnly, _
            selectedId & " Holidays"
        Case Else
            MsgBox "Please program holidays for " & selectedId & ".", _
            vbInformation + vbOKOnly, _
            " Under Construction"
    End Select
End Sub


' ------------------------------------------------------------------
' Code on pages 817-819
' ------------------------------------------------------------------


Public Sub OnGetImage(ctl As IRibbonControl, ByRef image)
  Select Case ctl.id
     Case "btnRedStar"
       Set image = LoadPicture("C:\Acc07_ByExample\images\redstar.gif")
     Case "glHolidays"
       Set image = LoadPicture("C:\Acc07_ByExample\images\Square0.gif")
  End Select
End Sub


Public Sub OnGetItemCount(ctl As IRibbonControl, ByRef count)
   count = 12
End Sub


Public Sub OnGetItemLabel(ctl As IRibbonControl, _
       index As Integer, _
       ByRef label)
       label = MonthName(index + 1)
End Sub


Public Sub OnGetItemImage(ctl As IRibbonControl, _
                          index As Integer, _
                          ByRef image)

  Dim imgPath As String

  imgPath = "C:\Acc07_ByExample\images\square"
  Set image = LoadPicture(imgPath & index + 1 & ".gif")
End Sub


Public Sub onGetItemID(ctl As IRibbonControl, _
                      index As Integer, ByRef id)
  
  id = MonthName(index + 1)
End Sub



Public Sub onSelectedItem(ctl As IRibbonControl, _
                        selectedId As String, _
                        selectedIndex As Integer)
    Select Case selectedIndex
        Case 6
            MsgBox "Holiday 1: Independence Day, July 4th", _
            vbInformation + vbOKOnly, _
            selectedId & " Holidays"
        Case 11
            MsgBox "Holiday 1: Christmas Day, December 25th", _
            vbInformation + vbOKOnly, _
            selectedId & " Holidays"
        Case Else
            MsgBox "Please program holidays for " & selectedId & ".", _
            vbInformation + vbOKOnly, _
            " Under Construction"
    End Select
End Sub


' ----------------------------------------------------------------
' Hands-On 30-7
' Code location: \Acc07_HandsOn\EduSystems_05.txt
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Code on page 822
' ----------------------------------------------------------------

<group id="Today’s Events" getLabel="getEventDate">


Public Sub getEventDate(ctl As IRibbonControl, _
                        ByRef ReturnValue As Variant)

   ReturnValue = "Events for " & Format(Now(), "mm/dd/yyyy")
End Sub


' ----------------------------------------------------------------
' Code on page 823
' ----------------------------------------------------------------

<toggleButton id="tglNewStudent" label="New Student Questionnaire"
size="normal" getPressed="OnGetPressed" onAction="ShowHideQ" />


Sub OnGetPressed(control As IRibbonControl, _
                 ByRef pressed)

   If control.id="tglNewStudent" then
      pressed = False
   End if
End Sub


Sub ShowHideQ(control As IRibbonControl, pressed As Boolean)
   If pressed Then
      MsgBox "The toggle button is pressed."
   Else
      MsgBox "The toggle button is not pressed."
   End If
End Sub


' ----------------------------------------------------------------
' Code on page 824
' ----------------------------------------------------------------

<group id="OtherControlsGroup" label="Other Controls" >
  <splitButton id="btnSplit1" size="large" imageMso="ImportAccess" >
    <button id="btnImport" label="Import More" />
     <menu id="mnuImport" label="More Import Formats" itemSize="normal" >
      <menuSeparator id="mnuDiv1" title="Other Databases" />
        <button id="btnImportODBC" label="ODBC database" imageMso="ImportOdbcDatabase" />
        <button id="btnImportDbase" label="Dbase file" imageMso="ImportDBase" />
        <button id="btnImportParadox" label="Paradox file" imageMso="ImportParadox" />
      <menuSeparator id="mnuDiv2" title="Spreadsheet Files" />
        <button id="btnImportExcel" label="Excel file" imageMso="ImportExcel" />
        <button id="btnImportLotus" label="&Lotus 1-2-3 file" imageMso="ImportLotus" />
        <menuSeparator id="mnuDiv3" title="Other Files" />
        <button id="btnText" label="Text file" imageMso="ImportTextFile" />
        <button id="btnXML" label="XML file" imageMso="ImportXmlFile" />
        <button id="btnHTML" label="HTML file" imageMso="ImportHtmlDocument" />
        <button id="btnOutlook" label="Outlook folder" imageMso="ImportOutlook" />
        <button id="btnSharepoint" label="SharePoint List" imageMso="ImportSharePointList" />
     </menu>
  </splitButton>
</group>


' ----------------------------------------------------------------
' Code on pages 825-827
' ----------------------------------------------------------------

<group id="OtherControlsGroup" label="Other Controls" >
  <splitButton id="btnSplit1" size="large" imageMso="ImportAccess" >
    <button id="btnImport" label="Import More" />
      <menu id="mnuImport" label="More Import Formats" itemSize="normal" >
       <menuSeparator id="mnuDiv1" title="Other Databases" />
        <button id="btnImportODBC" label="ODBC database" imageMso="ImportOdbcDatabase" />
        <button id="btnImportDBase" label="Dbase file" imageMso="ImportDBase" />
        <button id="btnImportParadox" label="Paradox file" imageMso="ImportParadox" />
       <menuSeparator id="mnuDiv2" title="Spreadsheet Files" />
      <menu id="mnuExcel" label="Excel File Formats" imageMso="ImportExcel" itemSize="normal" >
        <checkBox id="xlsFormat" label="xls file" />
        <checkBox id="xlsxFormat" label="xlsx file" />
        <button id="btnImportLotus" label="&Lotus 1-2-3 file" imageMso="ImportLotus" />
       <menuSeparator id="mnuDiv3" title="Other Files" />
         <button id="btnText" label="Text file" imageMso="ImportTextFile" />
         <button id="btnXML" label="XML file" imageMso="ImportXmlFile" />
         <button id="btnHTML" label="HTML file" imageMso="ImportHtmlDocument" />
         <button id="btnOutlook" label="Outlook folder" imageMso="ImportOutlook" />
         <button id="btnSharepoint" label="SharePoint List" imageMso="ImportSharePointList" />
      </menu>
  </splitButton>
</group>



<separator id="OtherControlsDiv1" />
  <labelControl id="TitleForBox1" label="Areas of Interest (please check below)" />
   <box id="boxLayout1">
    <checkBox id="chkSafety" label="School Safety" 
      enabled="true" visible="true"
      onAction="DoSomething" />
    <checkBox id="chkHealth" label="Health" enabled="false" />
    <checkBox id="chkSportsMusic" getLabel="onGetLabel" />
</box>


Public Sub onGetLabel(ctl As IRibbonControl, ByRef label)
  If ctl.id = "chkSportsMusic" And _
    Weekday(Now(), vbWednesday) Then
      label = "Sports"
  Else
      label = "Music"
  End If
End Sub


Public Sub DoSomething(ctl As IRibbonControl, _
                     pressed As Boolean)
   
   If ctl.id = "chkSafety" And pressed Then
      MsgBox "Safety is our number one concern."
   Else
      MsgBox "Sorry to hear that safety is not your concern."
   End If
End Sub



' ----------------------------------------------------------------
' Code on pages 828-829
' ----------------------------------------------------------------

<editBox id="txtFullName" label="First and Last Name:"
sizeString="AAAAAAAAAAAAAAAA" maxLength="25"
onChange="onFullNameChange" />


Public Sub onFullNameChange(ctl As IRibbonControl, _
                            text As String)

   If text <> "" Then
     MsgBox "Is '" & text & _
       "' your real name?"
   End If
End Sub


<separator id="OtherControlsDiv2" />
  <comboBox id="cmbLang" label="Languages" supertip="Select Language Guide"
    onChange="OnChangeLang" >
     <item id="English" label="English" />
     <item id="Spanish" label="Spanish" />
     <item id="French" label="French" />
     <item id="German" label="German" />
     <item id="Russian" label="Russian" />
</comboBox>


Public Sub OnChangeLang(ctl As IRibbonControl, _
                        text As String)

   MsgBox "You selected " & text & " language guide."
End Sub


<dropDown id="drpBoro" label="City Borough"
  supertip="Select School Borough"
  onAction="OnActionBoro" >
    <item id="M" label="Manhattan" />
    <item id="B" label="Brooklyn" />
    <item id="Q" label="Queens" />
    <item id="I" label="Staten Island" />
    <item id="X" label="Bronx" />
</dropDown>


Public Sub OnActionBoro(ctl As IRibbonControl, _
                       ByRef SelectedID As String, _
                       ByRef SelectedIndex As Integer)

   MsgBox "Index=" & SelectedIndex & " ID=" & SelectedID
End Sub



' ----------------------------------------------------------------
' Code on page 830, above Figure 30-43
' ----------------------------------------------------------------


<dialogBoxLauncher>
   <button id="Launch1"
     screentip="Show Product Key"
     onAction="OnActionLaunch" />
</dialogBoxLauncher>


Public Sub OnActionLaunch(ctl As IRibbonControl)
  ' open the About Microsoft Office Access box
  DoCmd.RunCommand acCmdAboutMicrosoftAccess
End Sub



' ----------------------------------------------------------------
' Code on pages 830, below Figure 30-43
' Code location: \Acc07_HandsOn\FinalRibbon.txt
'                \Acc07_HandsOn\FinalRibonVBA.txt
' ----------------------------------------------------------------



' ----------------------------------------------------------------
' Code on page 832 - 835
' ----------------------------------------------------------------

<!-- Built-in commands section -->
<commands>
    <command idMso="DatabaseRelationships" onAction="DisableRelations" />
</commands>


Sub DisableRelations(ctl As IRibbonControl, _
                     ByRef cancelDefault)

   MsgBox "You are not authorized to use this function."
   cancelDefault = True
End Sub


<command idMso="DatabaseDocumentor" onAction="ShowDbProperties" />


Public Sub ShowDbProperties(ctl As IRibbonControl, _
                            ByRef cancelDefault)

  If CurrentProject.AllForms("Student List").IsLoaded Then
    ' display Database Properties dialog box instead
    DoCmd.RunCommand acCmdDatabaseProperties
  Else
    cancelDefault = False
  End If
End Sub


<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
loadImage="OnLoadImage" onLoad="RefreshMe">


'module level variable declaration
Public objRibbon As IRibbonUI
Private strUserTxt As String
Private isCtlEnabled As Boolean


' callback for the onLoad attribute of customUI
Public Sub RefreshMe(ribbon As IRibbonUI)
   Set objRibbon = ribbon
   isCtlEnabled = False
End Sub


<checkBox id="chkHealth" label="Health" getEnabled="onGetEnabled_Health" />
<editBox id="txtFullName" label="First and Last Name:"
   sizeString="AAAAAAAAAAAAAAAAAA" maxLength="25"
   getText="getEditBoxText" onChange="onFullNameChangeToUcase" />


Public Sub onGetEnabled_Health(control As IRibbonControl, _
                              ByRef enabled)
    enabled = isCtlEnabled
End Sub


Public Sub getEditBoxText(control As IRibbonControl, _
                          ByRef text)
    
    text = UCase(strUserTxt)
End Sub


Public Sub onFullNameChangeToUcase(ByVal control As IRibbonControl, _
                                   text As String)
   If text <> "" Then
     strUserTxt = text
     objRibbon.InvalidateControl "txtFullName"
     isCtlEnabled = True
   Else
     isCtlEnabled = False
   End If

   objRibbon.InvalidateControl "chkHealth"
End Sub


' ----------------------------------------------------------------
' Code for figure 30-44 on page 835
' Code location: \Acc07_HandsOn\FinalRibbon_withRefresh.txt
' ----------------------------------------------------------------


' ----------------------------------------------------------------
' Code on page 836
' Statements to be entered in the Immediate Window
' ----------------------------------------------------------------

MsgBox Application.CommandBars.GetEnabledMso("Cut")
MsgBox Application.CommandBars.GetImageMso("Cut", 16, 16)


' ----------------------------------------------------------------
' Code on pages 836 - 837
' ----------------------------------------------------------------

<button id="btnRptWizard" label="Use Report Wizard" size="normal"
  getImage="onGetBitmap" onAction="DoDefaultPlus" />


Sub onGetBitmap(ctl As IRibbonControl, ByRef image)
   Set image = Application.CommandBars. _
   GetImageMso("CreateReportFromWizard", 16, 16)
End Sub


Sub DoDefaultPlus(ctl As IRibbonControl)

   If Application.CurrentObjectName = "Student List" Then
      Application.CommandBars.ExecuteMso "CreateReportFromWizard"
   Else
      MsgBox "To run this Wizard you need to open " & _
       " the Student List Form", _
       vbOKOnly + vbInformation, "Action Required"
   End If
End Sub


' ----------------------------------------------------------------
' Code on pages 837 - 838
' ----------------------------------------------------------------

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
  loadImage="OnLoadImage" onLoad="RefreshMe" >
  <!-- Built-in commands section -->
 <commands>
   <command idMso="DatabaseRelationships" onAction="DisableRelations" />
   <command idMso="DatabaseDocumenter" onAction="ShowDbProperties" />
 </commands>
 <ribbon startFromScratch="false" >
 <!-- Office Button Menu section -->
  <officeMenu>
    <control idMso="MenuPublish" visible="false" />
    <control idMso="FileSendAsAttachment" visible="false" />
    <menu idMso="FileManageMenu">
      <button idMso="ManageReplies" />
    </menu>
    <button id="btnNotes1" label="Open Notepad"
      image="Note.gif" insertBeforeMso="FileSave"
      onAction="OpenNotepad" />
  </officeMenu>
 </ribbon>
</customUI>


