'### Adaptez à votre chemin ###
Const CHEMIN As String = "D:\Dossier_LDC_17F\"
'##############################
Sub MiseAjourXLA(Optional dummy As Byte)
Dim XLA As AddIn
Dim i&
Dim j&
Dim cpt&
Dim reponse%
Dim Txla()
Dim T$()
Dim A$
Dim B$
Dim Msg$
Dim Faire As Boolean
For Each XLA In Application.AddIns
i& = i& + 1
ReDim Preserve Txla(1 To 2, 1 To i&)
Txla(1, i&) = XLA.Name
Txla(2, i&) = XLA.Installed
Next XLA
With Application.FileSearch
.LookIn = CHEMIN
.Filename = "*.xla"
If .Execute() > 0 Then
For i& = 1 To .FoundFiles.Count
Faire = True
A$ = Mid(.FoundFiles(i&), InStrRev(.FoundFiles(i&), "\") + 1)
B$ = Mid(A$, 1, Len(A$) - 4)
For j& = 1 To UBound(Txla, 2)
If LCase(Txla(1, j&)) = LCase(A$) Then
Faire = False
'--- Si la xla est déjà installée et n'est pas en action ---
'--- on la rend active. C'est comme si on faisait menu ---
'--- Outils/Macros complémentaires... et qu'on cochait ---
'--- la case CheckBox de la xla correspondante ---
If Txla(2, j&) = False Then AddIns(B$).Installed = True
'-----------------------------------------------------------
Exit For
End If
Next j&
If Faire Then
cpt& = cpt& + 1
ReDim Preserve T$(1 To cpt&)
T$(cpt&) = .FoundFiles(i&)
End If
Next i&
Else
Exit Sub
End If
.NewSearch
End With
If cpt& = 0 Then Exit Sub
Msg$ = cpt& & " " & " mise(s) à jour disponible(s) " & vbCrLf
reponse% = MsgBox(prompt:=Msg$ & vbCrLf & vbCrLf & "Mise(s) à jour à effectuer, merci", _
Title:="Mise(s) à jour du fichier", _
Buttons:=vbOKCancel + vbDefaultButton2)
If reponse% <> vbOK Then Exit Sub
For i& = 1 To UBound(T$)
AddIns.Add Filename:=T$(i&)
A$ = Mid(T$(i&), InStrRev(T$(i&), "\") + 1)
B$ = Mid(A$, 1, Len(A$) - 4)
AddIns(B$).Installed = True
Next i&
MsgBox prompt:=" mise(s) à jour effectuée(s)", Title:="Information"
End Sub
