Discussion :

[gerard8311]

Bonjour

D'abord merci de m'accueillir parmi vous. Je ne suis pas un spécialiste et votre aide va m'être précieuse.!!!

Je suis devant un document qui doit, entre autres, enregistrer un nom un prénom et une date.
Je voudrais qu'à la saisie le nom soit basculer en capital, le prénom en minuscule avec la première lettre en majuscule.
Après saisie, ce document sera d'une part remis à la personne soit par édition papier soit par envoi mail et d'autre part enregistrer (genre piste d'audit).
Cet enregistrement se fera avec un nom de fichier structuré : nom prénom date . docx.

Voila la demande. Je réussis à faire la saisie sans problème par contre je ne réussis pas à créer mon nom de fichier en sortie.

Alors help au secours etc ... Quelqu'un peut-il m'aider?
Merci d'avance

[gerald2545]

merci de nous donner ton fichier pour exemple et test
ça devrait être jouable avec une macro

[E KERGRESSE]

Bonjour à tous,

En supposant que le document en question soit issu d'un modèle .dotm pour qu'il puisse contenir les macros et qu'à l'intérieur on ait les signets Nom et Prénom

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
Option Explicit
 
Function NomDocument(ByVal LeNom As String, LePrenom As String) As String
 
Dim I As Integer
Dim NouveauNom As String, NouveauPrenom As String
 
    For I = 1 To Len(Trim(LeNom))
        Select Case Mid(Trim(LeNom), I, 1)
               Case Chr(10), Chr(13)
 
               Case Else
                  NouveauNom = NouveauNom & Mid(Trim(LeNom), I, 1)
        End Select
    Next I
 
    For I = 1 To Len(Trim(LePrenom))
        Select Case Mid(Trim(LePrenom), I, 1)
               Case Chr(10), Chr(13)
 
               Case Else
                  NouveauPrenom = NouveauPrenom & Mid(Trim(LePrenom), I, 1)
        End Select
    Next I
 
   NomDocument = UCase(NouveauNom) & " " & UCase(Mid(NouveauPrenom, 1, 1)) & LCase(Mid(NouveauPrenom, 2, Len(NouveauPrenom) - 1)) & " " _
                 & Format(Year(Date), "0000") & "-" & Format(Month(Date), "00") & "-" & Format(Day(Date), "00")
 
End Function
 
 
Sub SauvegardeDoc()
 
Dim Repertoire As String
 
    Repertoire = "D:\XXXX\" ' A adapter
 
    With ActiveDocument
         If .Bookmarks.Exists("Nom") And .Bookmarks.Exists("Prénom") Then
             'MsgBox NomDocument(.Bookmarks("Nom").Range.Text, .Bookmarks("Prénom").Range.Text)
             .SaveAs2 FileName:=Repertoire & NomDocument(.Bookmarks("Nom").Range.Text, .Bookmarks("Prénom").Range.Text), fileformat:=wdFormatXMLDocument
         End If
    End With
 
 
End Sub

[gerard8311]

Bonsoir
Tout d’abord merci E KERGESSSE et gerald2545La Macro de GG.txt d’avoir bien voulu m’aider.
Après beaucoup d’essais, je pense être arrivé à m’approprier la macro.
Il fallait que je la retouche car dans mon document la date est saisie par un « contrôle de contenu » qui propose un calendrier déroulant et c’est cette date que je met dans le nom du fichier. Ensuite le nom et le prénom sont aussi saisi par un contrôle de contenu qui passe le nom en majuscules . Cela me permet d’éditer correctement le document.
J’ai eu 3 soucis et vos avis m’intéressent car j’ai du louper quelque chose. En effet dans la date récupérée j’ai un symbole caché qui se met en dernière position (genre touche entrée) ; pour le nom et le prénom je récupère le mot FORMTEXT dans le contenu ( si le nom est « DUPONT » je récupère « FORMTEXT DUPONT » ; idem pour le prénom où là j’ai 2 blancs. Bizarre !!!
Mais en corrigeant tout ça j’y suis arrivé. Il est possible sans doute de simplifier la macro si ces trucs bizarres arrivent de ma faute.
Je vous donne la macro résultat.
Encore merci de votre aide

[gerard8311]

comme je ne vois pas ma pièce jointe je met la macro ici:


Option Explicit

Function NomDocument(ByVal LeNom As String, LePrenom As String) As String

Dim I As Integer
Dim LaDatetest As String

LeNom = Mid(LeNom, 10)
LePrenom = Mid(LePrenom, 10)
LaDatetest = Left((ActiveDocument.Bookmarks("Datetest").Range), Len(ActiveDocument.Bookmarks("Datetest").Range) - 1)

NomDocument = LeNom & " " & LePrenom & " " & LaDatetest

End Function
Sub SauvegardeDoc()
'
' SauvegardeDoc Macro
'
'
Dim Repertoire As String

Repertoire = "C:\Users\gerar\Desktop\chiro\factures\" ' A adapter

With ActiveDocument
If .Bookmarks.Exists("Nom") And .Bookmarks.Exists("Prénom") And .Bookmarks.Exists("Datetest") Then
'MsgBox NomDocument(.Bookmarks("Nom").Range.Text, .Bookmarks("Prénom").Range.Text) .Bookmarks("Datetest").Range.Text)
.SaveAs2 FileName:=Repertoire & NomDocument(.Bookmarks("Nom").Range.Text, .Bookmarks("Prénom").Range.Text), fileformat:=wdFormatXMLDocument
End If
End With
Word.Application.Quit
End Sub

[E KERGRESSE]

Bonjour,

Si vous vous servez de la fonction, il vaut mieux la rendre totalement paramétrable et ne pas faire référence au document actif dans le code :
Nb : J'ai modifié le code, mais je ne l'ai pas essayé.

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
 
 
Function NomDocument(ByVal LeNom As String, LePrenom As String, LaDateTest As String) As String
 
    LeNom = Mid(LeNom, 10)
    LePrenom = Mid(LePrenom, 10)
    If Len(LaDateTest) > 10 Then LaDateTest = Left(LaDateTest, Len(LaDateTest) - 1)
    'LaDateTest = Mid(LaDateTest,1, 10)
    NomDocument = LeNom & " " & LePrenom & " " & LaDateTest
 
End Function
 
 
Sub SauvegardeDoc()
'
Dim Repertoire As String
 
    Repertoire = "C:\Users\gerar\Desktop\chiro\factures\" ' A adapter
    With ActiveDocument
         If .Bookmarks.Exists("Nom") And .Bookmarks.Exists("Prénom") And .Bookmarks.Exists("Datetest") Then
            'MsgBox NomDocument(.Bookmarks("Nom").Range.Text, .Bookmarks("Prénom").Range.Text) .Bookmarks("Datetest").Range.Text)
            .SaveAs2 FileName:=Repertoire & NomDocument(.Bookmarks("Nom").Range.Text, .Bookmarks("Prénom").Range.Text, .Bookmarks("Datetest").Range.Text), fileformat:=wdFormatXMLDocument
         End If
    End With
    Word.Application.Quit
 
End Sub

Ou :

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
 
Function NomDocument(WdDoc As Document) As String
 
Dim LaDateTest As String
 
    NomDocument = ""
    With WdDoc
         If .Bookmarks.Exists("Nom") And .Bookmarks.Exists("Prénom") And .Bookmarks.Exists("Datetest") Then
            With .Bookmarks("Datetest")
                 If Len(.Range.Text) > 10 Then LaDateTest = Left(.Range.Text, Len(.Range.Text) - 1)
            End With
            NomDocument = Mid(.Bookmarks("Nom").Range.Text, 10) & " " & Mid(.Bookmarks("Prénom").Range.Text, 10) & " " & LaDateTest
          End If
    End With
 
End Function
 
 
Sub SauvegardeDoc()
'
Dim Repertoire As String
 
    Repertoire = "C:\Users\gerar\Desktop\chiro\factures\" ' A adapter
    If NomDocument(ActiveDocument) <> "" Then
       ActiveDocument.SaveAs2 FileName:=Repertoire & NomDocument(ActiveDocument), fileformat:=wdFormatXMLDocument
       ActiveDocument.Close savechanges:=True
       Word.Application.Quit
    Else
       MsgBox "Vérifier la présence des signets nom, prénom, date !", vbCritical, "Document non sauvegardé"
    End If
 
End Sub