-
Notifications
You must be signed in to change notification settings - Fork 0
/
Z2_Parameters_Ribbon.bas
204 lines (153 loc) · 5.59 KB
/
Z2_Parameters_Ribbon.bas
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
Attribute VB_Name = "Z2_Parameters_Ribbon"
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
Public Rib As IRibbonUI
Public MyTag As String
Public Sub Function_Clicked(control As IRibbonControl, ByRef pressed)
pressed = GetKey(control.ID)
'MsgBox control.ID & " " & pressed
End Sub
'Callback for TbtnToggleSeparateByPhStatus getPressed
'Sub Function_Clicked(control As IRibbonControl, ByRef returnedVal)
'End Sub
Public Function Function_Action(control As IRibbonControl, pressed As Boolean)
Store control.ID, pressed
'MsgBox control.ID & " " & pressed
' Select Case control.ID
'Case Is = "TbtnToggleSeparateByPhStatus"
'
'Case Else
'End Select
End Function
'Callback for Instructions getLabel
'Sub GetInstructionLabel(control As IRibbonControl, ByRef returnedVal)
'NOT WORKING SINCE NO MULTILINE COMMENT POSSIBLE
'returnedVal = INTERNALS.ListObjects("Instructions").ListColumns(1).DataBodyRange.Find(STAGE.value).Offset(0, 1).value '"Instructions: lol"
'returnedVal = "uiopg" & vbCrLf & "srgsdths"
'"Renseignez le canton et l'année d'analyse des données puis cliquez sur « Charger les fichiers » pour selectionner les fichiers médicaments." & Chr(10) & _
' "Le programme se chargera de produire un rapport sur la conformité des données." & Chr(10) & _
' "Il est possible de choisir quels sont les critères de conformité dans le ruban « Paramètres»"
'If PARAM_TABLE.Columns(1).Find("ShowEveryTabs").Offset(0, 1).value Then
' Call RefreshRibbon(Tag:="*")
'Else
' Call RefreshRibbon(Tag:="Custom*")
'End If
'End Sub
Public Sub Store(control_id As String, value As Boolean)
Call DefGlobal
PARAM_TABLE.Columns(1).Find(control_id).Offset(0, 1).value = value
Select Case control_id
Case Is = "VerifyNbSheets"
Case Is = "VerifyColumnsTitle"
Case Is = "VerifyColumnsContent"
'Case Is = "MergeFiles"
Case Is = "AllowAllButtons"
If value Then
Call UpdateStage(-1)
Else
Call UpdateStage(STAGE.value)
End If
Case Is = "CheckPharmacodes"
'Case Is = "TrackChanges"
'Case Is = "AuthorizeChangesOnOpening"
'Case Is = "SaveReadOnly"
Case Is = "SaveInSameWB"
Case Is = "TbtnToggleSeparateByPhStatus"
'Call TbtnToggleSeparateByPhStatus(value)
Case Is = "ShowEveryTabs"
If value Then
Call ShowAllTabs
'Call UpdateStage(STAGE.value)
Else
Call ShowOnlyCustomTabs
'Call UpdateStage(STAGE.value)
End If
Case Else
MsgBox "Feature not implemented yet"
End Select
End Sub
Public Function GetKey(control_id As String) As Boolean
Call DefGlobal
'''write the code for getting the key back from the source which you might have used to store the value.
'''return the correct value here
GetKey = PARAM_TABLE.Columns(1).Find(control_id).Offset(0, 1).value ' True ' or whatever you have selected previously
End Function
'CALLBACKS ON VISIBILITY 1
'Callback for customUI.onLoad
Sub RibbonOnLoad(ribbon As IRibbonUI)
Call DefGlobal
Set Rib = ribbon
INTERNALS.ListObjects("IRibbonUI").DataBodyRange.value = ObjPtr(ribbon)
Call UpdateStage(1)
End Sub
Sub GetVisible(control As IRibbonControl, ByRef visible)
If control.Tag Like MyTag Then
visible = True
'ElseIf Len(control.Tag) > 0 Then
' If MyTag Like "*VG*" Or Len(MyTag) = 0 Then
' If PARAM_TABLE.Columns(1).Find("ShowEveryTabs").Offset(0, 1).value Then
' visible = True
' Else
' visible = False
' End If
' Else
' visible = False
' End If
Else
visible = False
End If
End Sub
Sub GetEnabledMacro(control As IRibbonControl, ByRef Enabled)
Call DefGlobal
'If MyTag = "Enable" Then
' Enabled = True
'Else
'If control.Tag Like MyTag And control.Tag Like DisplayTag.value Then
If control.Tag Like DisplayTag.value Then
Enabled = True
Else
Enabled = False
End If
'End If
End Sub
Sub RefreshRibbon(Tag As String)
MyTag = Tag
If Rib Is Nothing Then
Dim ribbonPointer As Long
ribbonPointer = INTERNALS.ListObjects("IRibbonUI").DataBodyRange.value
Call CopyMemory(Rib, ribbonPointer, 4)
End If
Rib.Invalidate
End Sub
'Sub RefreshButton(controlID As String)
' Rib.InvalidateControl controlID
'End Sub
' Macros ON VISIBILITY
Sub ShowAllTabs()
'Show every Tab, Group or Control(wildgard "*")
Call RefreshRibbon(Tag:="*")
End Sub
Sub ShowOnlyCustomTabs()
'Show Tab, Group or Control(wildgard "*")
Call RefreshRibbon(Tag:="*C_*")
End Sub
Sub TbtnToggleSeparateByPhStatus(control As IRibbonControl, pressed As Boolean)
Call DefGlobal
Store control.ID, pressed
If Not PARAM_TABLE.Columns(1).Find("TbtnToggleSeparateByPhStatus").Offset(0, 1).value Then
Call MergeSheets
Else
Call SplitSheets
End If
End Sub
'Sub AllowEdit(control As IRibbonControl, ByRef CancelDefault)
'
' MsgBox "Yes?!", vbOKOnly, "Command Repurposing Demo"
'
' CancelDefault = False
'End Sub
'*************************************************************
'Sub rxMenu_onAction(control As IRibbonControl)
' msSplitStyle = Mid$(control.ID, 7)
' getRibbon().InvalidateControl "rxButton"
' MsgBox "Control invalidated"
'End Sub