Installation automatique macro Excel

Version imprimable

13/03/2012, 12h16
CaptainCavern

Installation automatique macro Excel

Bonjour à tous,

Je bataille grave pour faire ceci :
Installer automatiquement une macro complémentaire Excel (xla) pour la déployer par Gpo à 450 pc.

En gros, je pensais m'y prendre comme ça :

Vérifier les clé de registre correspondantes (HKCU\...Office\11.0\...\OPEN)
Ajouter une nouvelle valeur OPENxx avec en valeur le chemin du fichier xla (copié en local dans MacroLib)

Ben même ça j'y arrive pas !!
Une solution a peut-être déjà été postée ?????

Un grand merci à toute proposition !
13/03/2012, 17h21
ProgElecT

Salut, bienvenue sur DVP

Une piste pour commencer, FAQ VBScript Manipuler la base de registre
13/03/2012, 22h24
CaptainCavern

Bonjour,

Oui, effectivement, je me suis servi de ces exemples pour faire une 1ere ébauche de mon script.
En fait, pour être plus précis, je voudrais :
- Compter le nombre de clés OPEN (OPEN1, OPEN2, ...) présentes, sachant que la 1ere correspond à eurotool je crois,
- vérifier dans les suivantes si la macro NbLettre.xla est présente,
- si pas présente, ajouter une clé OPENx avec comme valeur le chemin vers le fichier xla

Bon, y a p'tet plus simple, je dis pas 8O !
13/03/2012, 22h45
ProgElecT

Tu parles bien de cette clef HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0? , car moi je n'ai pas de sous clefs OPENx
Par contre dans la clef HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Excel j'ai bien des sous clefs, mais pas de sous clefs OPENx.
Peux tu donner le nom de la clef parent de ces sous clefs OPENx.
Tu te branches sur la clef parent avec .EnumValues, dans son troisième paramètre, tu récupères un tableau, avec Ubound(vartableau) tu obtiendras le nombre de sous clefs correspondant surement aux clefs OPEN ? , sinon dans une boucle tu parcours tout le tableau en vérifiant si le nom de chacune contient le mot OPEN If instr(Ucase(Vartableau(n)),"OPEN") <> 0 then Compte = Compte+ 1
14/03/2012, 16h58
CaptainCavern

Ah ben non !!

C'est dans : HKCU\Software\Microsoft\Office\11.0\Excel\Options

Salut

Ok, pour moi il n'y a pas de clef "Options" dans ....\....\OFFICE\11.0, donc je passe à ....\....\Office\12.0
Un bout de code qui devrait te permettre d'avancer

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
	Const  HKEY_CURRENT_USER = &H80000001
	Dim oReg, ClefPrimaire, TblSousClef, StrInfos, Rep, NbrOpen
	Dim T
		Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
		ClefPrimaire = "Software\Microsoft\Office\12.0\Excel\Options"
		oReg.EnumValues HKEY_CURRENT_USER, ClefPrimaire, TblSousClef, Rep
                For T = LBound(TblSousClef) To UBound(TblSousClef)
                        If Instr(Ucase(TblSousClef(T)),"OPEN") then
                                NbrOpen = NbrOpen + 1
                                oReg.GetStringValue HKEY_CURRENT_USER, ClefPrimaire, TblSousClef(T), StrInfos
                                MsgBox TblSousClef(T) & " valeur: " &  StrInfos
                        End if
                Next
		MsgBox "Nombre de ""OPENx"": " & NbrOpen

Je confirme que pour moi aussi, la 1er clef = eurotool.xlam

xlam a installation automatique

voici comment je procede :
Vous pouvez rajouter ce petit code dans la feuille "thisWrokbook" de votre fichier xlam.
Ceci permet d'installer et d'activer automatiquement l'AddIns lors de la 1er ouverture.
il ne reste plus qu'a diffuser le fichier *.xlam

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Workbook_Open()
    Dim oXL As Object, oAddin As Object
    URL = Me.Path & "\"
    normalUrl = Application.UserLibraryPath ' Environ("AppData") & "\Microsoft\AddIns"
    AddinTitle = Mid(Me.Name, 1, Len(Me.Name) - 5)
 
    If URL <> normalUrl Then
        If MsgBox("Can you Install AddIns ?", vbYesNo) = vbYes Then
            Set oXL = Application ' CreateObject("Excel.Application")
            oXL.Workbooks.Add
            Me.SaveCopyAs normalUrl & Me.Name
            Set oAddin = oXL.AddIns.Add(normalUrl & Me.Name, True)
            oAddin.Installed = True
 
            oXL.Quit
            Set oXL = Nothing
        End If
    End If
End Sub