08 – Drop Down Menus 1

In this post I will be showing you how to create Drop Down Menus in the Ribbon.

Featured Videos:

• 08 – Drop Down Menus 1

Featured Downloads

• AccessRibbon08

08 – Drop Down Menus 1

The Code

< customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
< ribbon startFromScratch="true">
< tabs>

< tab id="tabHome" label="Home" visible="true">

< group id="GroupInfo"  label="Info">
< labelControl id="lblDate" getLabel="onGetLabel"/>
< labelControl id="lblUser" getLabel="onGetLabel"/>
< labelControl id="lblTerminal" getLabel="onGetLabel"/>
< /group>

< group id="GroupHome"  label="Home">
< button id="cmdHome" label="Home" imageMso="BlogHomePage"
size="large"   onAction="onClick"/>
< /group>

< group id="GroupNavigation"  label="Navigation">

< splitButton id="sbStudents" size="large">
< button id="cmdStudents"  imageMso="AddOrRemoveAttendees"
label="Students"  onAction="onClick"/>
< menu id="menStudents">
< button id="cmdStudentsNew" label="New Student" onAction="onClick"   imageMso="DiagramShapeInsertClassic" />
< button id="cmdStudentsEdit" label="Edit Student" onAction="onClick"   imageMso="DataFormSource" />
< button id="cmdStudentsReports" label="Reports" onAction="onClick"   imageMso="DefinedPrintStyle"/>
< /menu>
< /splitButton>

< separator id="separator1"/>
< splitButton id="sbTeachers" size="large">
< button id="cmdTeachers"  imageMso="AccessTableContacts"
label="Teachers"  onAction="onClick"/>
< menu id="menTeachers">
< button id="cmdTeachersNew" label="New Teacher" onAction="onClick" imageMso="DiagramShapeInsertClassic"/>
< button id="cmdTeachersEdit" label="Edit Teacher" onAction="onClick" imageMso="DataFormSource"/>
< button id="cmdTeachersReports" label="Reports" onAction="onClick" imageMso="DefinedPrintStyle"/>
< /menu>
< /splitButton>

< separator id="separator2"/>

< splitButton id="sbCourses" size="large">
< button id="cmdCourses"  imageMso="ReadingMode"
label="Courses"  onAction="onClick"/>
< menu id="menCourses">
< button id="cmdCoursesNew" label="New Course" onAction="onClick" imageMso="DiagramShapeInsertClassic"/>
< button id="cmdCoursesEdit" label="Edit Course" onAction="onClick" imageMso="DataFormSource"/>
< /menu>
< /splitButton>

< separator id="separator3"/>

< splitButton id="sbClasses" size="large">
< button id="cmdClasses"  imageMso="MeetingsWorkspace"
label="Classes"  onAction="onClick"/>
< menu id="menClasses">
< button id="cmdClassTimeTable" label="TimeTable" onAction="onClick" imageMso="StartAfterPrevious"/>
< button id="cmdClassCalendar" label="Calendar" onAction="onClick" imageMso="DateAndTimeInsert"/>
< button id="cmdClassRegister" label="Register" onAction="onClick" imageMso="AddressBook"/>
< button id="cmdClassLogAttendance" label="Log Attendance" onAction="onClick" imageMso="DateAndTimeInsert"/>
< button id="cmdClassAttendanceReport" label="Attendance Report" onAction="onClick" imageMso="CopyToPersonalContacts"/>
< /menu>
< /splitButton>

< /group>

< group id="GroupClasses"  label="Today's Classes">
< labelControl id="lblTest" label="Please choose a class:"/>
< dropDown
id="drpClasses"
keytip="& amp;TN"
label="Classes:"
screentip="View classes"
sizeString="WWWWWWWWWWW"
tag="TS"
getItemCount="OnGetItemCount"
getItemID="OnGetItemID"
getItemLabel="OnGetItemLabel"

onAction="OnSelectItem"/>
< /group>

< /tab>
< /tabs>
< /ribbon>
< /customUI>

Option Compare Database

Public Sub onGetLabel(control As IRibbonControl, ByRef label)

'-----------------Other Labels--------------------------------
Select Case control.id
Case "lblDate"
label = FormatDateTime(Date, vbLongDate)
Case "lblUser"
label = getAccessUserName()
Case "lblTerminal"
label = getComputerName()

End Select
End Sub

Public Sub OnClick(control As IRibbonControl)
Select Case control.id

'---------------------------------------------------
'---------------------------------------------------
'----------------Home---------------------------

Case "cmdHome"
CloseAllFormsAndReports
OpenSingleform "frmHome", Edit, Normal

'---------------------------------------------------
'---------------------------------------------------
'----------------Students---------------------------

Case "cmdStudents"
OpenSingleform "frmStudentsNav", Edit, Normal
Case "cmdStudentsNew"
DoCmd.OpenForm "frmStudentsDataEntry", , , , acFormAdd, acDialog
Case "cmdStudentsEdit"
OpenSingleform "frmStudentContinuous", Edit, Normal
Case "cmdStudentsReports"
OpenSingleform "frmStudentReports", Edit, Normal

'---------------------------------------------------
'---------------------------------------------------
'----------------Teachers---------------------------

Case "cmdTeachers"
OpenSingleform "frmTeachersNav", Edit, Normal
Case "cmdTeachersNew"
DoCmd.OpenForm "frmTeachersDataEntry", , , , acFormAdd, acDialog
Case "cmdTeachersEdit"
OpenSingleform "frmTeacherContinuous", Edit, Normal
Case "cmdTeachersReports"
OpenSingleform "frmTeacherReports", Edit, Normal

'---------------------------------------------------
'---------------------------------------------------
'----------------Courses----------------------------

Case "cmdCourses"
OpenSingleform "frmCoursesNav", Edit, Normal
Case "cmdCoursesNew"
DoCmd.OpenForm "frmCoursesView", , , , acFormAdd
Case "cmdCoursesEdit"
OpenSingleform "frmCoursesContinuous", Edit, Normal

'---------------------------------------------------
'---------------------------------------------------
'----------------Classes----------------------------

Case "cmdClassTimeTable"
OpenSingleform "frmClassTimeTable", Edit, Normal
Case "cmdClassCalendar"
OpenSingleform "frmCalendar", Edit, Normal
Case "cmdClassRegister"
DoCmd.OpenForm "frmDateSelector", , , , , acDialog
DoCmd.OpenReport "rptClassRegister", acViewPreview, , , acWindowNormal
Case "cmdClassLogAttendance"
DoCmd.RunMacro "mcrProgramFlow.LogAttendance"
Case "cmdClassAttendanceReport"
DoCmd.RunMacro "mcrProgramFlow.AttendanceReport"

End Select
End Sub

Option Compare Database
Option Explicit

Private myArray() As Variant

Sub onGetItemCount(control As IRibbonControl, ByRef count)
count = getTodaysClasses()
End Sub

Public Function getTodaysClasses() As Integer
getTodaysClasses = LoadArray()
End Function

Public Function LoadArray() As Integer
Dim i As Integer
Dim strSQL As String
Dim db As DAO.Database
Dim rs As DAO.Recordset

strSQL = "SELECT tblClass.ClassID, tblClass.ClassDate, " _
& "DLookUp('[LookUp24Hour]','tblTimes','[LookUpScheduleTime]=' & [tblclass].[StartTime]) AS StartTime, " _
& "DLookUp('[LookUp24Hour]','tblTimes','[LookUpScheduleTime]=' & [tblclass].[EndTime]) AS EndTime, " _
& "Left([tblTeachers].[FirstName],1) & Left([tblTeachers].[LastName],1) AS Teacher, tblLevel.Code " _
& "FROM tblLevel INNER JOIN (tblTeachers INNER JOIN (tblCourse INNER JOIN tblClass  " _
& "ON tblCourse.CourseID = tblClass.CourseID) ON tblTeachers.TeacherID = tblClass.TeacherID)  " _
& "ON tblLevel.LevelID = tblCourse.Level " _
& "WHERE (((tblClass.ClassDate)=" & CLng(Date) & ")) " _
& "ORDER BY tblClass.ClassDate, DLookUp('[LookUp24Hour]','tblTimes','[LookUpScheduleTime]=' & [tblclass].[StartTime]);"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

With rs
If Not .BOF And Not .EOF Then

.MoveLast
.MoveFirst
ReDim myArray(0 To .RecordCount - 1, 5)

For i = LBound(myArray) To UBound(myArray)

myArray(i, 0) = .Fields("ClassID")
myArray(i, 1) = .Fields("StartTime")
myArray(i, 2) = .Fields("EndTime")
myArray(i, 3) = .Fields("Teacher")
myArray(i, 4) = .Fields("Code")

.MoveNext
Next i
LoadArray = .RecordCount
Else
'Return value = 0
LoadArray = 0
End If
.Close
End With

Set rs = Nothing
Set db = Nothing
End Function

Public Function strGetItemLabel(index As Integer) As String
strGetItemLabel = myArray(index, 1) & " " _
& myArray(index, 2) & " " _
& myArray(index, 3) & " " _
& myArray(index, 4) & " "
End Function

Public Function lngGetItemID(index As Integer) As Long
lngGetItemID = myArray(index, 0)
End Function

Public Sub onGetItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
returnedVal = strGetItemLabel(index)
End Sub

Public Sub onGetItemID(ctl As IRibbonControl, index As Integer, ByRef id)
id = lngGetItemID(index)
End Sub

Public Sub OnSelectItem(ctl As IRibbonControl, selectedId As String, selectedIndex As Integer)

If (ctl.id = "drpClasses") Then
DoCmd.OpenForm "frmClassView", , , "[ClassID]=" & CLng(selectedId), , acDialog

End If
End Sub

Related Posts