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
| Option Explicit
'Sub ShowUsf()
'Dim Language As String
'With usfMultilanguages
'.cboLanguage.List = Range("t_languages[Language]").Value
'.Show
' Language = .cboLanguage.Value
'End With
'Unload usfMultilanguages
'MsgBox getText("AlertMsg", Language)
'End Sub
Sub testsansusf()
Dim barre As CommandBar
Set barre = CreateCommandbar("EN") 'si l 'argument"BarName" est omis son nom est "Bartest"
barre.ShowPopup
End Sub
Function CreateCommandbar(Language As String, Optional BarName As String = "Bartest")
Dim cb As CommandBar
Dim Ctrl As CommandBarControl
Dim Cell As Range
Dim Caption As String
Dim Typ As Integer
Dim capt As String
Dim p As String
Dim par As Object ' (as object) car ca peut etre la barre ou un msocontrolpopup
On Error Resume Next
CommandBars(BarName).Delete
On Error GoTo 0
Set cb = CommandBars.Add(BarName, msoBarPopup)
For Each Cell In Range("t_Controls[id]")
Typ = Cell.Offset(, 1).Value
If Typ = 10 Then capt = Cell.Offset(, 5).Value Else capt = getText(Cell.Value, Language) 'caption sub
p = Cell.Offset(, 4).Value
If p = "barre" Then Set par = cb Else Set par = FindControlByCaption(cb, p, True)
Set Ctrl = par.Controls.Add(Cell.Offset(, 1))
With Ctrl
.Caption = capt 'getText(Cell.Value, Language)
.OnAction = Cell(1, 3).Value
End With
Next
Set CreateCommandbar = cb
End Function
Function getText(ByVal ID As String, Language As String) As String
Dim Formula As String
Formula = "index(t_texts[Text],match(1,(t_texts[id]=""{id}"")*(t_texts[language]=""{language}""),0))"
Formula = Replace(Formula, "{id}", ID, , , vbTextCompare)
Formula = Replace(Formula, "{language}", Language, , , vbTextCompare)
getText = Evaluate(Formula)
End Function
'fonction de recherche de control par le texte de la caption (récursive)
'raze est optional et utile au depart quand est la commandbar
' la variable mycontrol est en static pour ne pas la perdre dans le looping de la récursivité
Private Function FindControlByCaption(Lparent As Variant, Lcaption As String, Optional Raze As Boolean = False) As CommandBarControl
Static mycontrol As Object, Ctrl As CommandBarControl
If Raze = True Then Set mycontrol = Nothing
If mycontrol Is Nothing Then
For Each Ctrl In Lparent.Controls
If Ctrl.Caption = Lcaption Then Set mycontrol = Ctrl:
If Ctrl.Type = 10 And mycontrol Is Nothing Then FindControlByCaption Ctrl, Lcaption '(récursivité pour le looping sur les descendants )
Next
End If
Set FindControlByCaption = mycontrol
End Function |
Partager