1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
| Option Explicit
Const shLayout_Management As String = "Layout_Management"
Dim sUserName As String
Dim rRange As Range
Dim cpt As Integer
Dim strTemp As String
Dim iRowIntDeb As Integer, iRowIntFin As Integer
Dim lRow As Long
'Callback for DDM1 getItemCount
Sub nbMembers(control As IRibbonControl, ByRef returnedVal)
Set rRange = Sheets(shLayout_Management).Columns(1).Find(vbNullString)
ThisWorkbook.Names("UserList").RefersTo = "=" & shLayout_Management & "!A2:A" & (rRange.Row - 1)
returnedVal = ThisWorkbook.Sheets(shLayout_Management).Range("UserList").Count
End Sub
'Callback for DDM1 getItemLabel
Sub LabelMembers(control As IRibbonControl, index As Integer, ByRef returnedVal)
Set rRange = ThisWorkbook.Sheets(shLayout_Management).Range("UserList")
returnedVal = rRange(index + 1, 1)
End Sub
'Callback for DDM2 getItemCount
Sub NbLayout(control As IRibbonControl, ByRef returnedVal)
returnedVal = ThisWorkbook.Sheets(shLayout_Management).Range("LayoutList").Count
End Sub
'Callback for DDM2 getItemLabel
Sub LabelLayout(control As IRibbonControl, index As Integer, ByRef returnedVal)
Set rRange = ThisWorkbook.Sheets(shLayout_Management).Range("LayoutList")
ThisWorkbook.RibbonUI.InvalidateControl ("DDM2")
returnedVal = rRange(index + 1, 1)
End Sub
'Callback for DDM1 onAction
Sub UpdateLayout(control As IRibbonControl, id As String, index As Integer)
iRowIntDeb = 0
iRowIntFin = 0
'index+1 = index dans le range userlist pour les membres
Set rRange = ThisWorkbook.Sheets(shLayout_Management).Range("UserList")
sUserName = rRange(index + 1, 1)
Set rRange = Sheets(shLayout_Management).Columns(3).Find(vbNullString)
If sUserName <> "All" Then
lRow = 2
Do
If Cells(lRow, 2).Value = sUserName And iRowIntDeb = 0 Then iRowIntDeb = lRow
lRow = lRow + 1
Loop Until (Cells(lRow, 2).Value <> sUserName And iRowIntDeb <> 0 And iRowIntFin = 0) Or rRange.Row = lRow
iRowIntFin = lRow - 1
Else
iRowIntDeb = 2
Set rRange = Sheets(shLayout_Management).Columns(3).Find(vbNullString)
iRowIntFin = rRange.Row - 1
End If
If iRowIntDeb = 0 Then iRowIntDeb = 2
ThisWorkbook.Names("LayoutList").RefersTo = "=" & shLayout_Management & "!C" & iRowIntDeb & ":C" & iRowIntFin & ""
End Sub
'Callback for subMenu getContent
Private Function GetMembersList(control As IRibbonControl, ByRef content)
Dim c As Range
cpt = 1
Set rRange = ThisWorkbook.Sheets(shLayout_Management).Range("UserList")
strTemp = vbNullString
'On crée le nombre de semaine
For Each c In rRange
strTemp = strTemp & _
"<button " & _
CreationAttribut("id", "buttonLayout" & cpt) & " " & _
CreationAttribut("label", vbNullString & c.Value) & " />"
cpt = cpt + 1
Next
content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">" & strTemp & "</menu>"
Debug.Print control.id
End Function
'Callback for subMenu getContent
Sub GetLayoutList(control As IRibbonControl, ByRef content)
Dim c As Range
cpt = 1
Set rRange = ThisWorkbook.Sheets(shLayout_Management).Range("LayoutList")
strTemp = vbNullString
'On crée le nombre de semaine
For Each c In rRange
strTemp = strTemp & _
"<button " & _
CreationAttribut("id", "buttonLayout" & cpt) & " " & _
CreationAttribut("label", vbNullString & c.Value) & " />"
cpt = cpt + 1
Next
content = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">" & strTemp & "</menu>"
End Sub
'Fonction facilitant la creation du code XML
Function CreationAttribut(strAttribut As String, Donnee As String) As String
CreationAttribut = strAttribut & "=" & Chr(34) & Donnee & Chr(34)
End Function |
Partager