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
| Const HKEY_CURRENT_USER = &H80000001
Const REG_DWORD As Long = 4
Const KEY_ALL_ACCESS = &HF003F
'Fonction permettant d’ouvrir une clé existante de la base de registre
'hKey Long Handle d'une clé déjà ouverte ou constante d'une clé principale.
'lpSubKey String Nom de la clé que vous souhaitez ouvrir.
'ulOptions Long Paramètre inutilisé: Vaut 0
'samDesired Long Droits que vous souhaitez utiliser pour cette clé.
'phkResult Long Cette variable prendra le Handle de la clé que vous venez d'ouvrir.
'Valeur renvoyée: Long Renvoi 0 (ERROR_SUCCESS)
'(si la fonction réussi.)
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
'Fonction permettant de fermer une clé de la base de registre.
'hKey Long Handle de la clé que vous souhaitez fermer
'Valeur renvoyée: Long Renvoi 0 (ERROR_SUCCESS)
'(si la fonction réussi.)
Public Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'Cette fonction permet de modifier les données d'une valeur et même de changer son type.
'hKey Long Handle d'une clé déjà ouverte ou constante d'une clé principale.
'lpValueName String Nom de la valeur à modifier. Si cette valeur n'existe pas elle est alors créée.
'Reserved Long Paramètre inutilisé: Vaut 0
'dwType Long Constante définissant le type de valeur à créer ou modifier.
'szData Long Variable contenant les données de la valeur à créer ou modifier.
'cbData Long Vous devez ici mettre une variable qui contient le nombre de caractères que vous avez écrit + 1 (+ caractère de fin de chaîne)
'Valeur renvoyée: Long Renvoi 0 (ERROR_SUCCESS)
'(Si la fonction réussie.)
Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
'Fonction permettant de supprimer une valeur de la base de registre.
'hKey Long Handle d'une clé déjà ouverte ou constante d'une clé principale.
'lpValueName String Nom de la clé que vous souhaitez supprimer.
'Valeur renvoyée: Long Renvoi 0 (ERROR_SUCCESS)
'(Si la fonction réussie.)
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, ByVal lpValueName As String) As Long
Sub fusionner()
Dim lngHandle As Long 'Manipulation de la bdr
Dim sCheminCle As String 'Chemin dans la bdr de la clé à ouvrir et à fermer
Dim sModele As String 'Nom du modèle
Dim sFic_a_Charger As String 'Chemin + modèle à ouvrir
sFic_a_Charger = "S:\Informatique\Projet\Gesper\Sources\modeles_word\Pontoise\AND.doc"
'-------------------------------------------------------------------------------------------------
'Remarques:
'Un handle est une valeur de type Long qui définit un objet de l'environnement Windows.
'Lorsque nous ouvrirons une clé, elle possèdera donc son propre handle qui est renvoyé par la fonction.
'Ce handle nous servira lors de la manipulation de cette clé.
'-------------------------------------------------------------------------------------------------
'Détermine le chemin de la clé dans la bdr en fonction de la version d'Office.
If Application.Version = "11.0" Then
sCheminCle = "Software\Microsoft\Office\11.0\Word\Options"
Else
If Application.Version = "10.0" Then
sCheminCle = "Software\Microsoft\Office\10.0\Word\Options"
End If
End If
'Désactive le message d'alerte : "L'ouverture de ce document exécutera la commande SQL suivante...." => Office 2002 et 2003
'Ouvre la clé, affecte lui la donnée "SQLSecurityCheck" dont la valeur est = 0, ferme la clé
If RegOpenKeyEx(HKEY_CURRENT_USER, sCheminCle, 0, KEY_ALL_ACCESS, lngHandle) = 0 Then
If RegSetValueExLong(lngHandle, "SQLSecurityCheck", 0&, REG_DWORD, 0, 4) = 0 Then
RegCloseKey (lngHandle)
Else
Call MsgBox("L'écriture de la valeur SQLSecurityCheck a échoué" & Chr(10) & _
"Merci de contacter le service informatique", vbCritical)
RegCloseKey (lngHandle)
End If
Else
Call MsgBox("L'ouverure de la clé Options a échoué" & Chr(10) & _
"Merci de contacter le service informatique", vbCritical)
End If
'N'affiche aucune alerte ou boîte de dialogue
' Application.DisplayAlerts = wdAlertsNone
'Ouvre le modèle en lecture seule
Documents.Open FileName:=sFic_a_Charger, ReadOnly:=True
'Positionne-toi sur le modèle
sModele = ActiveDocument.Name
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument 'Définition du résultat de la fusion comme nouveau document
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=True 'Exécution de la fusion
End With
'Réaffiche toutes les alertes et boîtes de dialogue
' Application.DisplayAlerts = wdAlertsAll
'Ferme le modèle sans enregistrer de chgmt
Documents(sModele).Close SaveChanges:=wdDoNotSaveChanges
'Ouvre la clé, supprime la valeur "SQLSecurityCheck" , ferme la clé (Retour à la normal)
If RegOpenKeyEx(HKEY_CURRENT_USER, sCheminCle, 0, KEY_ALL_ACCESS, lngHandle) = 0 Then
If RegDeleteValue(lngHandle, "SQLSecurityCheck") = 0 Then
RegCloseKey (lngHandle)
Else
Call MsgBox("La suppression de la valeur SQLSecurityCheck a échoué" & Chr(10) & _
"Merci de contacter le service technique", vbCritical)
RegCloseKey (lngHandle)
End If
Else
Call MsgBox("L'ouverure de la clé Options a échoué" & Chr(10) & _
"Merci de contacter le service technique", vbCritical)
End If
End Sub |
[VB]Passage de paramètre à une macro
Répondre avec citation
), j'ai une écran Netmeeting qui s'ouvre 
Partager