Discussion :

[roby68]

Bonjour le Forum

Suite aux différents codes trouvés sur la toile et adaptés à mon projet, j'ai un soucis pour récupérer une "date" dans un signet à l'initialisation d'une boîte de dialogue.

la routine "ExtraitNOM" fonctionne mais la routine "ExtraitDate1" ne fonctionne pas.

Les codes:

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
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
Public Function ExtraireTXT(ChaineSource As String, Optional LimiteAvant As String = "", Optional LimiteApres As String = "")
'par: Excel-Malin.com ( <a href="https://excel-malin.com" target="_blank">https://excel-malin.com</a> )
'Exemples : ExtraireTXT("abcdef","ab","ef") Résultat : "cd"
'           ExtraireTXT("abcdef","ab")      Résultat : "cdef"
'           ExtraireTXT("abcdef",,"ef")     Résultat : "abcd"
'           ExtraireTXT("abcdef","abc","")  Résultat : "def"
'           ExtraireTXT("abcdef")           Résultat : "abcdef"
'           ExtraireTXT("abcdef","","ef")   Résultat : "abcd"
 
On Error GoTo FunctionErreur
If InStr(1, ChaineSource, LimiteAvant) = 0 Then
    ExtraireTXT = CVErr(xlErrNA)
    Exit Function
Else
    ExtraitPositionDebut = InStr(1, ChaineSource, LimiteAvant) + Len(LimiteAvant)
End If
If LimiteApres = "" Then
    ExtraitPositionFin = Len(ChaineSource)
Else
    ExtraitPositionFin = InStr(1, ChaineSource, LimiteApres) - 1
End If
ExtraireTXT = Mid(ChaineSource, ExtraitPositionDebut, ExtraitPositionFin - ExtraitPositionDebut + 1)
Exit Function
 
FunctionErreur:
    ExtraireTXT = CVErr(xlErrNA)
    'ExtraireTXT = ""
End Function
 
 
Sub ExtraitNOM() ' Ce code fonctionne parfaitement, il restitue les choix civilité ( optionbutton1 et 2 ) et affiche le NOM et Prénom seulement ( Combobox1 )
'par: Excel-Malin.com ( <a href="https://excel-malin.com" target="_blank">https://excel-malin.com</a> )
On Error GoTo ExempleErreur
Dim VText1 As String
Dim LimitG As String
Dim LimitD As String
Dim VariableNOM As String
LimitD = " est"
MonSignet = "Lig1"
If ActiveDocument.Bookmarks.Exists(MonSignet) And ActiveDocument.Bookmarks(MonSignet).Range.Text <> "" Then
    VText1 = ActiveDocument.Bookmarks(MonSignet).Range.Text
    ' pour l'exemple : VText1 = "Monsieur DUPONT Durand est l'heureux gagnant de la journée du 31/07/2020, il va pouvoir recevoir son chèque."
    If Left(ActiveDocument.Bookmarks("Lig1").Range.Text, 2) = "Mo" Then ' Monsieur
        LimitG = "Monsieur "
        UserForm1.OptionButton1 = True
        VariableNOM = ExtraireTXT(VText1, LimitG, LimitD)
    Else
        If Left(ActiveDocument.Bookmarks("Lig1").Range.Text, 2) = "Ma" Then ' Madame
            LimitG = "Madame "
            UserForm1.OptionButton2 = True
            VariableNOM = ExtraireTXT(VText1, LimitG, LimitD)
        End If
    End If
End If
UserForm1.ComboBox1.Value = VariableNOM
Exit Sub
ExempleErreur:
        MsgBox "Une erreur est survenue..."
End Sub
 
 
Sub ExtraitDate1() ' le code n'affiche pas la date dans son textbox1
'par: Excel-Malin.com ( <a href="https://excel-malin.com" target="_blank">https://excel-malin.com</a> )On Error GoTo ExempleErreur
Dim VText1 As String
Dim LimitG As String
Dim LimitD As String
Dim VariableDate1 As String
LimitG = "journée du "
LimitD = ", il"
MonSignet = "Lig1"
If ActiveDocument.Bookmarks.Exists(MonSignet) And ActiveDocument.Bookmarks(MonSignet).Range.Text <> "" Then
    VText1 = ActiveDocument.Bookmarks(MonSignet).Range.Text
    ' pour l'exemple le même : VText1 = "Monsieur DUPONT Durand est l'heureux gagnant de la journée du 31/07/2020, il va pouvoir recevoir son chèque."
    VariableDate1 = ExtraireTXT(VText1, LimitG, LimitD)
End If
UserForm1.TextBox1.Value = VariableDate1
Exit Sub
ExempleErreur:
        MsgBox "Une erreur est survenue..."
End Sub

Message d'erreur n°13



Merci de me donner une piste

Bonne journée à tous

[roby68]

Re

Même en formatant la variable -> VariableDate1 =Format(ExtraireTXT(VText1, LimitG, LimitD), "dd/mm/yyyy").
ne fonctionne pas.

Bonne fin de journée

Roby

[Invité]

Bonjour,

A tester en supposant qu'il n'y ait qu'une date dans le range du signet :

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
 
Sub Test_ExtraitDate1()
 
   Debug.Print ExtraitDate1(ActiveDocument, "Lig1")
 
End Sub
 
Function ExtraitDate1(ByVal DocEnCours As Document, ByVal MonSignet As String) As String
 
Dim MonTableau As Variant
 
    ExtraitDate1 = ""
    With DocEnCours
         If .Bookmarks.Exists(MonSignet) Then
            If InStr(1, .Bookmarks(MonSignet).Range.Text, "/", vbTextCompare) > 0 Then
               MonTableau = Split(.Bookmarks(MonSignet).Range.Text, "/")
               ExtraitDate1 = Join(Array(Right(MonTableau(0), 2), MonTableau(1), Left(MonTableau(2), 4)), "/")
            End If
         End If
    End With
 
End Function

[roby68]

Bonsoir le Forum, Eric KERGRESSE

Je n'ai pas encore essayé ton code, mais effectivement le range peut contenir plusieurs dates, dates qui sont au fur et à mesure du déroulement de la procédure sont intégrées dans des phrases ou doivent être afficher dans plusieurs boîtes de dialogue à l'initialisation de celles-ci (fichier réutilisable). C'est pourquoi, je dois récupérer certaines chaines (Textes ou Dates et même du numérique). Il y a également beaucoup de signets dans mon document, donc plusieurs "Lig1 Lig2 etc...

A la base, je pensais que ce code pouvait extrait n'importe quelle chaine. ce qui aurait été super génial.

Bien cordialement

Roby

Ton code fonctionne, mon textbox a bien récupéré la première date du range.

[Invité]

Si le range contient plusieurs dates, la variable MonTableau les contient également. Il suffit dont de créer une boucle sur cette matrice sachant qu'une nouvelle date est "générée" tous les 3 enregistrements.

[roby68]

Bonsoir le Forum, Eric KERGRESSE

je n'ai pas tout compris, car je ne maitrise pas assez le VBA Word.
Par contre j'avais pensé a rajouter un élément dans la fonction " extraitDate" si c'est faisable bien entendu, à savoir une variable 1, 2, 3 etc qui indiquerait dans l'ordre la première date à récupérer etc... un truc du genre et bien entendu si on précise 3, il faudra que le range contienne au moins 3 dates..

merci encore au temps consacré à ma problématique.

Bonne soirée
Roby

[Invité]

A tester, ici le code récupère la troisième date contenue dans le range :

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
 
Sub Test_ExtraitDate2()
 
   Debug.Print ExtraitDate2(ActiveDocument, "Lig1", 3)
 
End Sub
 
 
Function ExtraitDate2(ByVal DocEnCours As Document, ByVal MonSignet As String, ByVal ChoixDate As Integer) As String
 
Dim MonTableau As Variant
Dim MesDates() As Variant
Dim IndexDates As Integer, I As Integer
 
    ExtraitDate2 = ""
    IndexDates = 0
    With DocEnCours
         If .Bookmarks.Exists(MonSignet) Then
            If InStr(1, .Bookmarks(MonSignet).Range.Text, "/", vbTextCompare) > 0 Then
               MonTableau = Split(.Bookmarks(MonSignet).Range.Text, "/")
               For I = LBound(MonTableau) To UBound(MonTableau) - 2 Step 2
                       ReDim Preserve MesDates(IndexDates)
                       MesDates(IndexDates) = Join(Array(Right(MonTableau(I), 2), MonTableau(I + 1), Left(MonTableau(I + 2), 4)), "/")  'ExtraitDate2
                       IndexDates = IndexDates + 1
               Next I
            End If
            If ChoixDate - 1 <= UBound(MesDates) Then ExtraitDate2 = MesDates(ChoixDate - 1)
         End If
    End With
 
End Function

[roby68]

Bonjour le Forum, Eric KERGRESSE

Merci pour ta réponse Eric, cela fonctionne bien.

Bonne journée à tous
Roby