Discussion :

[LANGAZOU]

Bonjour,

j'ai créer une macro sous Excel qui fait les étapes suivantes:

- copier des champs Excel
- ouvrir word
-coller ces champs sur word (en obtenant un format image)
-enregistre ensuite ce formulaire word dans un dossier.

y'a t-il un moyen par lequel chaque formulaire enregistré m'affiche un msgbox lors de son ouverture qui indique que ce formulaire est à usage strictement interne ?

Merci pour votre réponse.

[gnain]

au lieu de ouvrir word de coller et enregistrer
Il faudrait que tu ouvre un Template préalablement créer avec comme événement
dans ThisDocument

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Document_Open()
    MsgBox "ce formulaire est à usage strictement interne"
End Sub

de coller et de enregistrer sous

[LANGAZOU]

Merci beaucoup pour votre réponse.

je suis débutant en VBA et j'ai encore deux questions si vous me permettez:

1) y'a t-il un moyen de faire apparaître ce msgbox uniquement après l'avoir l'enregistrer afin de ne pas le visualisez à chaque fois lors de sa création ?
2) les fichiers créés sont transmis souvent à des personnes qui n'ont pas activés leur macro automatiquement. Est ce que ce msgbox apparaît malgré la désactivation de leur macro ?

Merci pour votre suivi.

[gnain]

oui à la question 1
oui à la question 2

à placer toujours dans ThisDocument

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private WithEvents App As Word.Application
 
Private Sub Document_Open()
Set App = Word.Application
End Sub
 
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "ce formulaire est à usage strictement interne"
End Sub

[LANGAZOU]

Désolé si je n'ai pas arrivé à m'éclaircir ma première question.au fait, je veux que le msgbox n’apparaît pas lors de sa création (ni lors de la première ouverture du template ni lors de l'enregistrement). je préfère après avoir faire le save du fichier dans le dossier sous le nom approprié et la réouverture pour la 2eme fois du document(devenu formulaire complet ) le msgbox apparaît . si je résume le msgbox apparaîtra lors de l'ouverture du formulaire complet et sauvegardé (et non pas du template).

voici mon code sous excel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Formulaire()
 
Dim Dte As Date
Dim j As Byte, m As Variant
Dim a As Integer
 
mee = Sheets("Historique.").Cells(3, 1)
m = Format(mee, "mmmm")
Dte = Sheets("Offre").Cells(5, 8)
j = Day(Dte)
a = Year(Dte)
 
Dim oWdApp As Object
Dim oWdDoc As Object
 
ligne = ActiveCell.Row
 
Sheets("Offre").Activate
relation = Sheets("Offre").Cells(9, 6)
 
Set oWdApp = CreateObject("Word.Application")
Set oWdDoc = oWdApp.Documents.Open("C:\Users\Sinfo\Desktop\Doc2.docx")
 
oWdApp.Visible = True
Range("A1:J47").Copy
oWdApp.Selection.PasteAndFormat (13)
Application.CutCopyMode = False
oWdApp.Visible = True
oWdApp.Selection.TypeParagraph
oWdApp.ActiveDocument.SaveAs Filename:="C:\Users\Sinfo\Desktop\" & relation & "(" & j & "_" & m & "_" & a & ")" & ".docx"
 
End Sub

je vous remercie encore une fois.

[gnain]

Pour ce que vous voulez c'est un peu plus compliqué mais réalisable.
Donc votre Template word devra être vide de macro dans ThisDocument.

Il faut créer une macro word avec une macro excel.

Premièrement dans word il faut que
Dans Paramètre des macro "Accès approuvé au modèle d'object du projet VBA" soit coché.

2- Dans Excel ajouter la référence "Microsoft Visual Basic for Applications Extensibility 5.3"

3- Il faut un fichier txt qui contient ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private WithEvents App As Word.Application
 
Private Sub Document_Open()
Set App = Word.Application
End Sub
 
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "ce formulaire est à usage strictement interne"
End Sub

on fera appel au txt dans votre code

4-Après avoir enregistrer votre document il faut le fermer.
ensuite on l'ouvre avec un nouvel object pour pouvoir lui insérer la macro et on enregistre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Formulaire()
 
Dim Dte As Date
Dim j As Byte, m As Variant
Dim a As Integer
 
mee = Sheets("Historique.").Cells(3, 1)
m = Format(mee, "mmmm")
Dte = Sheets("Offre").Cells(5, 8)
j = Day(Dte)
a = Year(Dte)
 
Dim oWdApp As Object
Dim oWdDoc As Object
 
ligne = ActiveCell.Row
 
Sheets("Offre").Activate
relation = Sheets("Offre").Cells(9, 6)
 
Set oWdApp = CreateObject("Word.Application")
Set oWdDoc = oWdApp.Documents.Open("C:\Users\Sinfo\Desktop\Doc2.docx")
 
oWdApp.Visible = True
Range("A1:J47").Copy
oWdApp.Selection.PasteAndFormat (13)
Application.CutCopyMode = False
oWdApp.Visible = True
oWdApp.Selection.TypeParagraph
 
oWdApp.ActiveDocument.SaveAs Filename:="C:\Users\Sinfo\Desktop\" & relation & "(" & j & "_" & m & "_" & a & ")" & ".docx"
 
oWdApp.Quit 'On ferme
 
Set oWdApp = Nothing
Set oWdDoc = Nothing
 
Dim oWdApp_2 As Object
Dim oWdDoc_2 As Object
 
Set oWdApp_2 = CreateObject("Word.Application")
Set oWdDoc_2 = oWdApp_2.documents.Open("C:\Users\Sinfo\Desktop\" & relation & "(" & j & "_" & m & "_" & a & ")" & ".docx")
oWdApp_2.Visible = True
 
'On écrit la macro à partir du txt
oWdApp_2.VBE.VBProjects("Project").VBComponents.Item("ThisDocument").CodeModule.AddFromFile ("C:\Chemin du txt\Code.txt")
oWdDoc_2.Save
 
Set oWdApp_2 = Nothing
Set oWdDoc_2 = Nothing
 
End Sub

J'ai tester et cela fonctionne.
Salutation!