Discussion :

[touche_a_tout]

Bonjour,
A propos du code proposé par Dysorthographie, je ne comprends pas ce que vise la juxtaposition de 2 expressions sur une même (et unique) ligne.
De toute manière, la sub "creation_squeeze_gedcom_d_apres_XL" n'existe plus. Elle est remplacée par un libellé contenant une partie variable, afin d'ajuster la sub à chacune des feuilles en changeant son nom et, dans la procédure, en changeant le nom de la feuille à laquelle la procédure s'applique.
Si quelqu'un pouvait me dire pourquoi mon code donne le message d'erreur concernant l'ambiguïté de l'expression "ma_macro", je serais très reconnaissant.
J'aimerais ajouter une information: à la suite de l'extrait de code posté précédemment j'ai écrit une procédure qui appelle Word et fonctionne très bien jusqu'à la sauvegarde du fichier .txt produit mais ne lance pas l'impression, sauf si je parcours le module d'impression avec F8. J'ai demandé pourquoi mais sans résultat concret. Quand à mon code, il fait 431 lignes, raison pour laquelle je ne l'ai pas joint en entier.
Bonne soirée
Cordialement
t_a_t

[Invité]

Bonsoir,
En fait, je faisais la rédaction du poste #14, quand tu as poster le poste #13.

Ce qui explique ton incompréhension!

Je voulais juste dire que tu pouvais passer le nom et le chemin de ton fichier en paramètres de ta procédure, mais on dirait que j'ai tou faut !

[touche_a_tout]

Bonsoir dysorthographie,
J'ai bien noté qu'il me faudrait

passer le nom et le chemin de ton fichier en paramètres de ta (=ma) procédure,

. Je te remercie et vais tâcher de suivre efficacement ton conseil. Cela dit, ces jours-ci ça modère sans modération, on dirait. Pourtant le blog du personnage m'a bien intéressé. Pourvu qu'on ne modère pas mes remerciements, ça me ferait moinsser.
Bonne soirée
touche_a_tout

[Pierre Fauconnier]

[...]Quand à mon code, il fait 431 lignes, raison pour laquelle je ne l'ai pas joint en entier.[...]

Si, en disant cela, tu parles d'une macro (sub... end sub) qui fait 431 lignes, tu gagnerais grandement en lisibilité, en maintenabilité et en évolutivité à découper ton code en procédures qui s'enchainent l'une l'autre et qui ont une seule responsabilité, ce qui veut dire que chaque "petite" procédure ou fonction ne réalise qu'une fonction de ton application, en recevant les données dont elle a besoin en arguments (pas en variables globales).

Tu peux ainsi développer chaque petite partie à l'aise puis enchaîner le tout dans une procédure qui appelle séquentiellement chaque "morceau"...

Mais sans voir ton code, c'est difficile de dire si c'est déjà le cas ou pas. Je t'invite à publier ton code, ça pourra aider, notamment pour les problèmes non résolus dans tu parles dans ton dernier message.

[touche_a_tout]

Bonjour Pierre Fauconnier,
Merci pour cette contribution. Le point clef est sûrement ici:

tu gagnerais grandement en lisibilité,

car il est vrai que je me perds à chercher le passage où il reste un bug (qui peut être purement rédactionnel dans le gedcom produit, et parfois informatique). Sur ce sujet un peu ésotérique, je crois utile de joindre une source généalogique sous forme de gedcom pour représenter le "produit" que je veux obtenir par cette appli. En outre, je vais prendre le risque du "pire" en citant intégralement mon code, d'ailleurs en chantier car j'ai d'abord "oublié" que je devais l'avoir en trois versions: naissance, mariage et décès. Ca reste à faire. Cependant je pense que la décomposition en petites unités peut s'y appliquer, par exemple, dans un acte de naissance, en consacrant un "morceau" au nouveau-né, un second à son père, un autre à sa mère, et ainsi de suite. C'est l'enchaînement séquentiel que je ne "vois" pas, j'utilise d'habitude une section "lanceur" avec une série d'appels Call de "sous-procédures".
A la réflexion, je me ravise: faut-il vraiment que j'incorpore ce code de > 400 lignes à un post ou dois-je le mettre en annexe ? Je ferais une copie de mon classeur en n'y laissant qu'une seule feuille à titre d'exemple (l'original en a plus de 70 !). Je sursois, à propos du code.
Dans l'attente
Cordialement
touche_a_tout
P.S. Un touche à tout est quelqu'un qui se disperse et a nécessairement du mal à être bon tous azimuts, d'où ma médiocrité comme développeur.
EDIT un gedcom ne se limite généralement pas à un acte mais enchaîne plusieurs dizaines voire centaines d'actes.

[touche_a_tout]

Re,
Ne te donne pas la peine de répondre maintenant, tu écris "...publier ton code" donc plus d'hésitation: le voici

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
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
Option Explicit
 
Public GED As String, ABBR As String, REPO As String, CALN As String
Public MEDI As String, TEXT As String, CONT As String
Public ligne As Integer, colonne As Integer, compteur As Integer, indice As Integer
Public L As Integer, C As Integer, Today As Object, index As Integer, i As Integer
Public r As Range, mes_gedcoms As String, lieu As String
Public domicile As String, deces As String, logo, mi_logo, parenté As String
Public Aujourdhui  As Variant, son_age  As Variant, annee  As Variant
Public Jour  As Variant, Heure As Variant, sa_dateN As Variant
'Public meslogos() As Variant
Public lig, col As Integer
Public ws As Worksheet
Public wb As Workbook
 
Sub creation_gedcoms_d_apres_XL()
Dim ma_sube
'cree_des_logos()
ThisWorkbook.Sheets("range_logo").Activate 'feuille contenant la partie variable
lig = 1                                     '- un sigle + une lettre de A à K -
col = 3                                     'des noms de worsheets
For lig = 1 To 69
logo = Worksheets("range_logo").Cells(lig, col - 2) & "_" & Cells(lig, col - 1).Value
mi_logo = Worksheets("range_logo").Cells(lig, col - 2) 'mi-logo sert à réunir dsans un même
                                                        'répertoire les sorties Word qui ont
 
Set wb = Workbooks.Open("E:\" & "3_G_E_N_E_A_L_O_G_I_E\Creation_sources_ged\test_mono_wbk\new_consolidation.xlsm")              'le même sigle, sans la lettre
Set ws = ThisWorkbook.Sheets(logo)
 'index = 1"
 
ma_sube = "creation_gedcoms" & "_" & logo & "_" & "d_apres_XL(logo, mi_logo)"
Application.Run "'" & wb.Name & "." & ma_sube
 
Next
End Sub
 
Sub ma_sube()                       'creation_gedcoms_logo_d_apres_XL(logo, mi_logo) 'index = 1
 
ThisWorkbook.Sheets(logo).Activate
 
Set r = ThisWorkbook.Sheets(logo).Range("A1").CurrentRegion
 
GED = ""
compteur = 1
ligne = 3
L = 1
C = 1
 
For ligne = 3 To r.Rows.Count
 
GED = GED & "0 @" & Format(compteur, "000") & "S" & "@" & " " & "SOUR" & Chr(10)
GED = GED & "1 ABBR" & " " & "AN " & ActiveSheet.Cells(ligne, 10).Value & " " & Cells(ligne, 11).Value _
& " " & Cells(ligne, 12).Value & " " & Cells(ligne, 17).Value & Chr(10)
GED = GED & "1 TITL Acte civil, paroissial ou notarié." & " " & Chr(10)
GED = GED & "1 REPO" & " " & Cells(ligne, 4).Value & Chr(10)
GED = GED & "2 CALN" & " " & Cells(ligne, 6).Value & Chr(10)
 
GED = GED & "3 MEDI" & " " & Cells(ligne, 68).Value & Chr(10)
GED = GED & "1 TEXT" & " " & "Réf. Excel:" & " " & Cells(ligne, 1).Value & _
" " & Cells(ligne, 2).Value & Chr(10)
Aujourdhui = Date
 
'===================bloc mise à l'heure================================
ThisWorkbook.Sheets("test_time").Activate
Heure = Format(Time, "hh:mm:ss")
Cells(1, 1).Value = Heure
Jour = Format(Date, "dd, mm, yyyy")
ActiveCell.Offset(0, 1).Value = Jour
 
ThisWorkbook.Sheets(logo).Activate
'==================fin du bloc ======================================
 
ThisWorkbook.Sheets(logo).Activate
GED = GED & "2 CONT" & " " & "Gedcom construit d'après base Excel" & ", " & "feuille" _
& " " & ThisWorkbook.ActiveSheet.Name & " " & "le" & " " & Aujourdhui & " " & "à " & Heure & Chr(10)
GED = GED & "2 CONT" & " " & "(Code VBA © Pierre Ruel 2015)"
 
GED = GED & Chr(10) & "2 CONT" & " " & "Texte résumé: L'elogoant" & " " & Cells(ligne, 10) & " " & Cells(ligne, 11)
'& " " & Cells(ligne, 11).Value
GED = GED & " " & "est né/e le " & Cells(ligne, 12).Value
GED = GED & " " & "au lieu nommé" & " " & Cells(ligne, 17).Value
GED = GED & ", (commune:" & " " & Cells(ligne, 18).Value & ")." & Chr(10)
'baptême
If Cells(ligne, 20).Value <> "" Then
GED = GED & "Il a été baptisé le" & " " & Cells(ligne, 20).Value
End If
If Cells(ligne, 21).Value <> "" Then
GED = GED & " " & "au lieu nommé " & Cells(ligne, 21).Value & Chr(10)
End If
If Cells(ligne, 22).Value <> "" Then
GED = GED & " " & "par le pasteur" & " " & Cells(ligne, 22).Value & Chr(10)
End If
'père
GED = GED & "2 CONT" & " " & "Les palogots sont" & " " & Cells(ligne, 23). _
Value & " " & Cells(ligne, 24).Value & ","
'age pere
Select Case Cells(ligne, 25).Value
    Case Is = ""
    GED = GED & " " & "âge: omis, "
    Case Is = "néant"
    GED = GED & " " & "âge: omis, "
    Case Is = "--"
    GED = GED & " " & "âge: omis, "
    Case Is = Chr(134)
    GED = GED & " " & Chr(134)
    Case Else
    GED = GED & " âgé de" & " " & Cells(ligne, 25).Value _
    & " " & "ans, "
End Select
 
'profession pere
If Cells(ligne, 27).Value <> "" Then
GED = GED & Cells(ligne, 27).Value & " " & "de son métier," & Chr(10) 'VARIANTE
End If
 
'domicilepere:
If Cells(ligne, 28).Value <> "" Then
GED = GED & Chr(10) & "2 CONT" & " " & "demeurant au lieu nommé" & " " & Cells(ligne, 28).Value
End If
 
communepere:
If Cells(ligne, 29).Value <> "" Then
GED = GED & ", (commune:" & " " & Cells(ligne, 29).Value & Chr(10)
End If
 
mere:
GED = GED & "2 CONT" & " " & "et" & " " & Cells(ligne, 31).Value & " " & Cells(ligne, 32).Value
'age mere
Select Case Cells(ligne, 33).Value
    Case Is = ""
    GED = GED & "" & ", âge: omis,"
    Case Is = "néant"
    GED = GED & "" & ", âge: omis,"
    Case Is = "--"
    GED = GED & "" & ", âge: omis,"
    Case Is = Chr(134)
    GED = GED & " " & Chr(134)
    Case Else
    GED = GED & ", âgée de" & " " & Cells(ligne, 33).Value _
    & " " & "ans, "
End Select
 
'date naissance mere
If Cells(ligne, 34).Value <> "" Then
GED = GED & " " & "date de naissance" & " " & Cells(ligne, 34).Value & Chr(10)
End If
 
If Cells(ligne, 35).Value <> "" Then
GED = GED & "2 CONT" & " " & Cells(ligne, 35).Value & " " & "de son métier,"
End If
 
If Cells(ligne, 36).Value <> "" Then
GED = GED & " domiciliée au lieu nommé" & " " & Cells(ligne, 36).Value
End If
If Cells(ligne, 37).Value <> "" Then
GED = GED & ", (commune:" & " " & Cells(ligne, 29).Value & ")." & Chr(10)
End If
 
'parrain_marraine
If Cells(ligne, 39).Value <> "" Then
GED = GED & "2 CONT" & " " & "Son parrain est" & " " & Cells(ligne, 39).Value & " " & _
Cells(ligne, 40).Value & ","
End If
If Cells(ligne, 41).Value <> "" Then
GED = GED & "âgé de " & Cells(ligne, 41).Value & " " & "ans."
End If
If Cells(ligne, 42).Value <> "" Then
GED = GED & " " & Cells(ligne, 42).Value & " " & "de son état" & Chr(10)
End If
If Cells(ligne, 43).Value <> "" Then
GED = GED & " " & "domicilié au lieu nommé " & Cells(ligne, 43).Value
End If
If Cells(ligne, 44).Value <> "" Then
GED = GED & ", " & "(commune:" & " " & Cells(ligne, 44).Value & "), "
End If
GED = GED & "sa marraine " & Cells(ligne, 46).Value & " " & Cells(ligne, 47).Value & _
" demeurant au lieu nommé " & Cells(ligne, 50).Value & "(commune:" & " " & Cells(ligne, 51).Value & ")."
 
'Témoins:
'No 1   53,  54
If Cells(ligne, 53).Value = "" Then
GoTo temoin2
End If
GED = GED & Chr(10) & "2 CONT Etaient témoins: " & Chr(10)
GED = GED & "N° 1: " & Cells(ligne, 53).Value & " " & Cells(ligne, 54).Value
If Cells(ligne, 55).Value = "majeur" Then
GED = GED & " " & "majeur,"
End If
'msgbox ("le GED vaut:" & GED)
'âge 68
If Cells(ligne, 55).Value <> "" Then
    If Cells(ligne, 55).Value <> "majeur" Then
        If Cells(ligne, 55).Value <> "omis" Then
        GED = GED & ", âgé de" & " " & Cells(ligne, 55) & " " & "ans,"
        End If
    End If
End If
 
If Cells(ligne, 56).Value <> "" Then
GED = GED & " " & Cells(ligne, 56).Value & " " & "de son état, "
End If
 
'domicile temoin1  57,   58
 
domicile = Cells(ligne, 57).Value
Select Case domicile
    Case Is = "omis"
        If Cells(ligne, 58).Value <> "" Then
        GED = GED & " commune de domicile:" & " " & Cells(ligne, 58).Value & ", " & Chr(10)
        End If
    Case Is = ""
        If Cells(ligne, 58).Value <> "" Then
        GED = GED & " commune de domicile:" & " " & Cells(ligne, 58).Value & ", " & Chr(10)
        End If
    Case Is <> ""
        If Cells(ligne, 58).Value <> "" Then
            If Cells(ligne, 58) <> "omis" Then
            GED = GED & " demeurant au lieu nommé" & " " _
            & Cells(ligne, 57).Value & " (commune:" _
            & " " & Cells(ligne, 58).Value & ") " & Chr(10)
            End If
        End If
End Select
 
parenté = Cells(ligne, 59).Value
Select Case parenté
    Case Is = ""
    GoTo temoin2
    Case Is = "sans"
    GoTo temoin2
    Case Is = "aucun"
    GoTo temoin2
    Case Else
    GED = GED & "degré de parenté:" & " " & Cells(ligne, 59).Value & "." & Chr(10)
End Select
 
GED = GED & "2 CONT "
 
temoin2:
'temoin2:   60,   61
If Cells(ligne, 60).Value = "" Then
GoTo note_etc
End If
 
GED = GED & " " & "N° 2: " & Cells(ligne, 60).Value & " " & Cells(ligne, 61).Value
If Cells(ligne, 62).Value = "majeur" Then
GED = GED & " " & "majeur,"
End If
'msgbox ("le GED vaut:" & GED)
'âge 62
If Cells(ligne, 62).Value <> "" Then
    If Cells(ligne, 62).Value <> "majeur" Then
        If Cells(ligne, 62).Value <> "omis" Then
        GED = GED & ", âgé de" & " " & Cells(ligne, 62) & " " & "ans,"
        End If
    End If
End If
 
If Cells(ligne, 76).Value <> "" Then
GED = GED & " " & Cells(ligne, 63).Value & " " & "de son état, "
End If
 
'domicile   64,   65
domicile = Cells(ligne, 64).Value
Select Case domicile
    Case Is = "omis"
        If Cells(ligne, 65).Value <> "" Then
        GED = GED & " commune de domicile:" & " " & Cells(ligne, 65).Value & ", " & Chr(10)
        End If
    Case Is = ""
        If Cells(ligne, 65).Value <> "" Then
        GED = GED & " commune de domicile:" & " " & Cells(ligne, 65).Value & ", " & Chr(10)
        End If
    Case Is <> ""
        If Cells(ligne, 65).Value <> "" Then
            If Cells(ligne, 65) <> "omis" Then
            GED = GED & " demeurant au lieu nommé" & " " _
            & Cells(ligne, 64).Value & " (commune:" _
            & " " & Cells(ligne, 65).Value & "). " & Chr(10)
            End If
        End If
End Select
 
parenté = Cells(ligne, 66).Value
Select Case parenté
    Case Is = ""
    GoTo fin_temoins
    Case Is = "sans"
    GoTo fin_temoins
    Case Is = "aucun"
    GoTo fin_temoins
    Case Else
    GED = GED & "degré de parenté:" & " " & Cells(ligne, 66).Value & "." & Chr(10)
End Select
 
note_etc:
 
GED = GED & Chr(10) & "2 CONT" & " " & "Note:" & " " & Cells(ligne, 67).Value & Chr(10)
 
GED = GED & "2 CONT" & " SOURCE: Type d'original:" & " " & Cells(ligne, 68).Value _
& ". " & "Mon support: " & Cells(ligne, 69).Value & ". "
GED = GED & "Mon archivage: " & _
Cells(ligne, 70).Value & Chr(10)
 
GED = GED & "2 CONT" & " " & "Relevé du" & " " & Cells(ligne, 71).Value _
& ". " & "Saisie du" & " " & Cells(ligne, 72).Value & ". "
 
GED = GED & "Feuille XL" & " " & Cells(ligne, 1).Value & ". " _
& "" & " " & "Naissance No" & " " & Cells(ligne, 2).Value & ". " & "Commune/Paroisse:" _
& " " & Cells(ligne, 3).Value & Chr(10)
 
GED = GED & "2 CONT" & ". " & "Dépôt d'archives:" & " " & Cells(ligne, 4).Value _
& ". " & "Cote registre:" & " " & Cells(ligne, 6).Value & ". "
 
If Cells(ligne, 7).Value <> "" Then
GED = GED & "" & "No d'acte:" & " " & Cells(ligne, 7).Value & ". "
End If
'End If
 
date_acte:
If Cells(ligne, 9).Value <> "" Then
GED = GED & "" & "Acte du " & Cells(ligne, 9).Value
End If
'End If
fin_temoins:
 
'=================adjonction à tester
GED = GED & Chr(10) & "1 TEXT Source aussi valable pour " & Chr(10)
GED = GED & "2 CONT" & " " & "Père: " & Cells(ligne, 23).Value & " " & Cells(ligne, 24).Value _
& " en vie le " & Cells(ligne, 20).Value & ", " & Chr(10)
GED = GED & "2 CONT" & " " & "conjoint de: " & Cells(ligne, 31).Value & " " & _
Cells(ligne, 32).Value & " mariage avant le " & Cells(ligne, 20).Value & ", " & Chr(10)
GED = GED & "2 CONT" & " " & "Mère: " & Cells(ligne, 31).Value & " " & Cells(ligne, 32).Value _
& " en vie le " & Cells(ligne, 20).Value & ", " & Chr(10)
GED = GED & "2 CONT" & " " & "conjointe de: " & Cells(ligne, 23).Value & " " & _
Cells(ligne, 24).Value & " mariage avant le " & Cells(ligne, 20).Value & Chr(10)
GED = GED & "2 CONT" & " " & Cells(ligne, 39).Value & " " & Cells(ligne, 40).Value _
& ", " & Cells(ligne, 42) & "de " & Cells(ligne, 43).Value & ", " & Cells(ligne, 44).Value & _
" en vie le " & Cells(ligne, 20).Value & Chr(10)
GED = GED & "2 CONT" & " " & Cells(ligne, 46).Value & " " & Cells(ligne, 47).Value _
& ", " & Cells(ligne, 49) & "de " & Cells(ligne, 50).Value & ", " & Cells(ligne, 51).Value & _
" en vie le " & Cells(ligne, 20).Value & Chr(10)
 
compteur = compteur + 1
GED = GED & "2 CONT Nombre d'enregistlogoents dans cette base" & " " & _
ThisWorkbook.ActiveSheet.Name & ": " & (r.Rows.Count - 2) & Chr(10)
 
'indice = indice + 1
Next
GED = GED & "0 RTLR"
'======================bloc date et heure ===================================
       'Elimine les caractères interdits
        ThisWorkbook.Sheets("test_time").Activate
        Range("A1").Select
        Selection.Replace What:=":", Replacement:="_", LookAt:=xlPart
        Selection.Replace What:="/", Replacement:="_", LookAt:=xlPart
        Heure = ActiveCell.Value
        ActiveCell.Offset(0, 1).Select
        Selection.Replace What:=".", Replacement:="_", LookAt:=xlPart
        Selection.Replace What:=",", Replacement:="_", LookAt:=xlPart
        Selection.Replace What:="/", Replacement:="_", LookAt:=xlPart
        Jour = Selection.Value
 
        ThisWorkbook.Sheets(logo).Activate
'=====================fin du bloc date et heure=============================
 
Call imprime_GED(logo, mi_logo)
 
End Sub
 
Sub imprime_GED(logo, mi_logo)
 
index = ThisWorkbook.Sheets("test_time").Range("E1").Value
 
'   Crée un gedcom dans Word en utilisant Automation (liaison tardive)
    Dim WordApp As Object
    Dim saveasname As String
 
MkDir "E:\" & "3_G_E_N_E_A_L_O_G_I_E\All_GED" & mi_logo & "\"
 
    saveasname = "allged" & logo & "_" & Jour & "_" & Heure & ".doc"
 
'   Lance Word et crée un objet
    Set WordApp = CreateObject("Word.Application")
 
'   Transmet les commandes à Word
        With WordApp
            .Documents.Add
            With .Selection
                .Font.Name = "courier new"
                .Font.Size = 12
                .ParagraphFormat.Alignment = 0
                .Font.Bold = False
                .TypeText TEXT:=GED
            End With
        End With
'   Pour imprimer
        With WordApp
                '.ActiveDocument.PrintOut , Range:=3, From:="1", To:="3"
'   Pour sauvegarder
                .ActiveDocument.SaveAs "E:\" & "3_G_E_N_E_A_L_O_G_I_E\All_GED" & "_" & mi_logo & "\" & saveasname
        End With
 
'   Tuer l'objet
    WordApp.Quit
    Set WordApp = Nothing
End Sub

A noter que
- ce code contient encore beaucoup de scories (p. ex. variables abandonnées datant d'une version antérieure)
- la ligne du PrintOut est mise en commentaire parce qu'elle ne lance pas l'impression (en fait, l'impression démarre quand je ferme le classeur !)
- les '========= marquent des endroits où devrait commencer un nouveau "morceau" de procédure mais il en faudrait d'autres.
- le "mi_logo" (demi-logo) sert à créer des sous-répertoires où les sous-feuilles (suffixes A, B, C etc.) seraient regroupées. Ne fonctionne pas encore.
Quel boulot ! Je n'aurais jamais dû me lancer dans la saisie des données dans Excel !
Merci de ton attention. Prends ton temps, c'est un sacré pensum !
Cordialement
t_a_t

[Invité]

Bonjour,
Tu es avant tout un littéraire et tu te noies parce que tu veux parler informatique !

Le codage n'est que la traduction de ta pensé dans une autre langue.

Tu me fait pense à ces personnes qui n'aime pas le sudocu parce qu'il n'aime pas le math.

La programmation ce n'est que de la description la plus détaillé.

Premièrement je fais ça
En suite si alors si non
En suite
Etc...

[touche_a_tout]

Bonjour D.,
Tu n'as pas tort, mais pour introduire mes trucs Excel dans "Heredis" (mon logiciel), le codage est un passage obligé. Si j'en avais eu les moyens, j'aurais payé quelqu'un pour le faire à ma place. Mais j'aurais d'abord demandé un devis !
Littéraire, et aussi musicien. Et curieux de (presque) tout. Touche à tout. Et au croisement de la musique et de la généalogie, un autre projet VBA en carafe, auquel je ne désespère pas de revenir si je vis assez longtemps.
Merci et bon week-end.
Cordialement
Pierre

[Invité]

ce que je voilais dire c'est qu'en tan que littéraire tu es le plus qualifier pour entreprendre la description détaillé de ta problématique.

éloignes toi du jargon informatique et dessine la trame de ton roman généalogique!

comme disait Descartes un problème compliqué n'est rien que la somme de problèmes simple.

[Pierre Fauconnier]

Je ne peux que plussoyer Robert.

"Tout commence par un dessin", disait Da Vinci. En informatique, tout commence par un schéma, qui va du général au particulier. A la fin, le particulier (la plus petite unité possible) est transformée en code. Le process n'est alors que la colonne vertébrale qui assemble (appelle) ces bouts de code selon les besoins.

On part donc de ce qu'on a (des feuilles avec des données, avec une "structure" qui permet un traitement informatique), on regarde comment traiter telle donnée, puis telle autre, ... au travers de petites procédures/fonctions. Ouvrir un fichier, repérer les limites des données, vérifier les données, en extraire les infos pertinentes, assembler telles données, ..., sont autant de "fonctionnalités" de ton appli qui vont être traduites en petits morceaux de code digestes recevant les données qu'ils doivent traiter en arguments, faciles à tester, à corriger et à faire évoluer. Après, c'est un jeu de Lego. Chaque "brique logicielle" fait sa "petite" part du travail.

Dès lors, le fichier GedCom n'est que la résultante de tous ces traitements, qui seront appelés autant de fois qu'il y a de naissances, de décès, de mariages, ..., pour créer ton fichier final au bon format.

[Invité]

La méthode cartésienne, le doute.

Descartes avait déjà dans les Règles pour la direction de l'esprit fait l'inventaire des moyens de connaître pour établir que l'imagination et la mémoire ne sont pas des moyens de connaissance assurés. Il n'a pas recours à l'expérience mais à l'intuition et à la déduction.

L'intuition : il s'agit de l'intuition intellectuelle c'est-à-dire ce qui est clair et évident à l'esprit, si clair et si distinct que je ne peux en douter. C'est le point de départ à partir de quoi on va déduire tout le reste.

La déduction : je conclus des idées claires et distinctes d'autres idées claires et distinctes et elles deviennent alors claires et distinctes également alors qu'elles ne l'étaient pas auparavant.

Les règles de la méthode, énoncées dans le discours du même nom, sont au nombre de quatre:

Première règle : " Ne recevoir aucune chose pour vraie que je ne la connusse évidemment être telle ". C'est la règle d'évidence. N'admettre pour vrai que l'évident, le certain et non le probable.

Deuxième règle : "Diviser chacune des difficultés que j'examinerais, en autant de parcelles qu'il se pourrait et qu'il serait requis pour les mieux résoudre ". C'est la règle de la division du complexe en éléments simples (analyse). Il faut examiner les objets de la connaissance, voir ce qui est simple et composé, analyser ce qui est composé et l'expliquer par ses constituants simples.

Troisième règle : "conduire par ordre mes pensées, en commençant par les objets les plus simples et les plus aisés à connaître pour monter peu à peu, comme par degrés, jusqu'à la connaissance des plus composés" . C'est la règle de l'ordre. Cet ordre à suivre est l'ordre des raisons. Il faut partir de l'évident et déduire. C'est l'ordre des raisons et non des matières : on ne commence pas nécessairement par le plus important ou le plus fondamental.

Quatrième règle : " faire partout des dénombrements si entiers, et des revues si générales, que je fusse assuré de ne rien omettre ". C'est la règle du dénombrement. Faire une revue entière, générale des objets ce qui fait intervenir la prudence, la circonspection.

Telle est la méthodologie qui sera mise en œuvre dans les Méditations. Il s'agira de remettre en question tout ce qui est donné. La méthode cartésienne suppose alors le doute, doute méthodique qui découle d'ailleurs d'un doute involontaire, sceptique.

[touche_a_tout]

Bonjour,
En réponse à vos deux posts:

Approche cartésienne et vincienne (en toute modestie
Un dessin pourrait ressembler à ça :


La procédure (au sens ordinaire du terme) consiste donc à prélever une donnée brute dans le stock de gauche, à lui adjoindre un contexte rédactionnel et à le déposer dans le « produit » de droite, puis à passer à la donnée suivante.
Qu’il y ait un seul stock de données brutes ou plusieurs est sans grande importance, le codage y pourvoira. Par contre toute la difficulté est liée au fait que les documents à disposition, hormis les actes de l’état-civil « moderne », ne sont pratiquement jamais complets (pour des tas de raisons oiseuses) et que presque toutes les opérations doivent être conditionnelles ; en outre les éléments rédactionnels doivent être modifiés en conséquence.
Quant aux 4 règles de Descartes :
1. L’évidence : sauf dans le cas où l’on copie soi-même un document (registre) original qui a été rédigé/complété il y a un ou plusieurs siècles, il n’y a pas beaucoup d’évidences en généalogie, sinon que
a) On naît, on vit (et on procrée ou pas) et on meurt
b) Pour procréer il faut (en ces époques lointaines) un père et une mère
En revanche, l’ancienne loi donne l’assurance que l’enfant porte le patronyme de son père (c’est la définition du mot patronyme, d’ailleurs).
2. La division du complexe : les caractéristiques de chaque événement sont divisées en parties élémentaires, dont le nombre peut dépasser la centaine. Règle observée.
3. L’ordre : Le recours à un langage informatique impose un tel ordre ; cependant, dans le cas présent, l’évidence est rare. Parlons de fortes probabilités.
4. Le dénombrement : c’est sur ce point qu’un distrait désordonné tel que moi chute. Entre hier et aujourd’hui j’ai constaté que j’avais "oublié" une dizaine de feuilles de données et que quelques-unes étaient à double ! je ne manquerai pas de faire à nouveau une revue entière et générale.
Pour en venir aux aspects informatiques, mon code actuel est déjà balisé par des intertitres mis en commentaires ; il suffit de les remplacer, ou les plus importants, par des départs et des fins de procédures. Comment les faire s’enchaîner ? Appeler chaque procédure à partir de la précédente n’est pas une solution.
Pour finir, deux remarques personnelles :
1. Si j’ai exécuté le dessin en cinq sec, c’est parce qu’il existait dans ma tête depuis pas mal de temps et que mon code actuel en était la transcription.
2. Descartes est aussi l’auteur, semble-t-il, du « Je pense, donc je suis », qui laisse à penser que l’homme est un être exclusivement de raison. Or il n’en est rien, au contraire dirais-je, et je crois que la maxime juste serait plutôt : « J’éprouve, je ressens, donc je suis ». Ce qui perturbe gravement l’application de la méthode ! Elle inspire bien des philosophies extrême-orientales, mais c’est une autre histoire. Totalement HS comme une partie de ce qui précède.
Cordialement à vous deux
Pierre
P. S. Le doute : je n’en ai qu’à l’égard de ma capacité à éviter les erreurs ; je suis certain au contraire qu’avec votre aide je viendrai à bout de ce job.

[Invité]

https://www.visuged.org/arbre_excel.htm

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
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
Sub Creation_Gedcom()
'
' Création d'un fichier Gedcom
' Permet de créer un fichier Gedcom à partir de la généalogie saisie dans les onglets de ce classeur.
' La Boîte à outils du Généalogiste : www.visuged.org
    Const Fichier_Version = "3.1"
    Const Fichier_Date = "28/03/2015"
 
    Dim i As Integer
    Dim Texte As String
    Dim noLigne As Integer
    Dim noEpoux As Integer
    Dim noEpouse As Integer
    Dim noUnion As Integer
    Dim nbEnfants As Integer
    Dim tnoEnfant(10) As Integer
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheets("Gedcom").Select
    'Effacement des lignes
    '---------------------
    For i = 1 To 500
        Range("A" & i).Select: ActiveCell.FormulaR1C1 = ""
    Next i
    'En Tête
    '-------
    noLigne = 0
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "0 HEAD"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 SOUR"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 NAME La Boîte à Outils du Généalogiste"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 VERS " & Fichier_Version
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "3 ADDR www.visuged.org"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 DATE " & Format(Date, "dd ") & Mois_Court(Format(Date, "mmmm")) & Format(Date, " yyyy")
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 TIME " & Format(Time, "hh:mm")
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 GEDC"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 VERS 5.5"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 FORM LINEAGE - LINKED"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 CHAR ANSI"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 PLAC"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 FORM Town , Area code , County , Region , Country, Subdivision"
    '----------------------
    'CREATION DES INDIVIDUS
    '----------------------
    'Individu Probant (Sosa n°1)
    '---------------------------
    Creation_Personne noLigne, 1, "Accueil", IIf(Range("Parents!D29") = "Fils", "M", "F"), "Parents!E29", "Parents!F29", "Parents!G29", "Parents!H29", 1, 0, ""
    'Frères et soeurs du probant
    '---------------------------
    For i = 29 To 38
        'Parcours des enfants des parents
        If Range("Parents!" & "C" & i) <> "" And Range("Parents!" & "C" & i) <> Range("Accueil") Then
            'Création des individus de @I50@ à @I59@
            Creation_Personne noLigne, i + 21, "Parents!" & "C" & i, IIf(Range("Parents!D" & i) = "Fils", "M", "F"), "Parents!E" & i, "Parents!F" & i, "Parents!G" & i, "Parents!H" & i, 1, 0, ""
        End If
    Next i
    'Parents
    '-------
    If Range("Père") <> "" And Range("Père") <> "Père" Then Creation_Personne noLigne, 2, "Père", "M", "NaissancePère", "LieuNaissancePère", "DécèsPère", "LieuDécèsPère", 2, 1, "MétierPère"
    If Range("Mère") <> "" And Range("Mère") <> "Mère" Then Creation_Personne noLigne, 3, "Mère", "F", "NaissanceMère", "LieuNaissanceMère", "DécèsMère", "LieuDécèsMère", 3, 1, "MétierMère"
    'Frères et soeurs du père
    '------------------------
    For i = 30 To 39
        'Parcours des enfants des grands parents paternels
        If Range("Grands_parents_paternels!" & "C" & i) <> "" And Range("Grands_parents_paternels!" & "C" & i) <> Range("Père") Then
            'Création des individus de @I60@ à @I69@
            Creation_Personne noLigne, i + 32, "Grands_parents_paternels!" & "C" & i, IIf("=Grands_parents_paternels!D" & i = "Fils", "M", "F"), "Grands_parents_paternels!E" & i, "Grands_parents_paternels!F" & i, "Grands_parents_paternels!G" & i, "Grands_parents_paternels!H" & i, 2, 0, ""
        End If
    Next i
    'Frères et soeurs de la mère
    '---------------------------
    For i = 30 To 39
        'Parcours des enfants des grands parents maternels
        If Range("Grands_parents_maternels!" & "C" & i) <> "" And Range("Grands_parents_maternels!" & "C" & i) <> Range("Mère") Then
            'Création des individus de @I70@ à @I79@
            Creation_Personne noLigne, i + 42, "Grands_parents_maternels!" & "C" & i, IIf("=Grands_parents_maternels!D" & i = "Fils", "M", "F"), "Grands_parents_maternels!E" & i, "Grands_parents_maternels!F" & i, "Grands_parents_maternels!G" & i, "Grands_parents_maternels!H" & i, 3, 0, ""
        End If
    Next i
    'Grands-parents paternels
    '------------------------
    If Range("GrandPèrePaternel") <> "" And Range("GrandMèrePaternelle") <> "GrandPèrePaternel" Then Creation_Personne noLigne, 4, "GrandPèrePaternel", "M", "NaissanceGrandPèrePaternel", "LieuNaissanceGrandPèrePaternel", "DécèsGrandPèrePaternel", "LieuDécèsGrandPèrePaternel", 4, 2, "MétierGrandPèrePaternel"
    If Range("GrandMèrePaternelle") <> "" And Range("GrandMèrePaternelle") <> "GrandMèrePaternelle" Then Creation_Personne noLigne, 5, "GrandMèrePaternelle", "F", "NaissanceGrandMèrePaternelle", "LieuNaissanceGrandMèrePaternelle", "DécèsGrandMèrePaternelle", "LieuDécèsGrandMèrePaternelle", 5, 2, "MétierGrandMèrePaternelle"
    'Frères et soeurs des grands-parents paternels
    '---------------------------------------------
    For i = 30 To 39
        'Parcours des enfants des grands parents paternels
        If Range("Arrière_grands_parents_pater_1!" & "C" & i) <> "" And Range("Arrière_grands_parents_pater_1!" & "C" & i) <> Range("GrandPèrePaternel") Then
            'Création des individus de @I80@ à @I89@
            Creation_Personne noLigne, i + 52, "Arrière_grands_parents_pater_1!" & "C" & i, IIf("=Arrière_grands_parents_pater_1!D" & i = "Fils", "M", "F"), "Arrière_grands_parents_pater_1!E" & i, "Arrière_grands_parents_pater_1!F" & i, "Arrière_grands_parents_pater_1!G" & i, "Arrière_grands_parents_pater_1!H" & i, 4, 0, ""
        End If
    Next i
    'Frères et soeurs des grands-parents paternels
    '---------------------------------------------
    For i = 30 To 39
        'Parcours des enfants des grands parents maternels
        If Range("Arrière_grands_parents_pater_2!" & "C" & i) <> "" And Range("Arrière_grands_parents_pater_2!" & "C" & i) <> Range("GrandMèrePaternelle") Then
            'Création des individus de @I90@ à @I99@
            Creation_Personne noLigne, i + 62, "Arrière_grands_parents_pater_2!" & "C" & i, IIf("=Arrière_grands_parents_pater_2!D" & i = "Fils", "M", "F"), "Arrière_grands_parents_pater_2!E" & i, "Arrière_grands_parents_pater_2!F" & i, "Arrière_grands_parents_pater_2!G" & i, "Arrière_grands_parents_pater_2!H" & i, 5, 0, ""
        End If
    Next i
    'Grands_parents_maternels
    '------------------------
    If Range("GrandPèreMaternel") <> "" And Range("GrandMèreMaternelle") <> "GrandPèreMaternel" Then Creation_Personne noLigne, 6, "GrandPèreMaternel", "M", "NaissanceGrandPèreMaternel", "LieuNaissanceGrandPèreMaternel", "DécèsGrandPèreMaternel", "LieuDécèsGrandPèreMaternel", 6, 3, "MétierGrandPèreMaternel"
    If Range("GrandMèreMaternelle") <> "" And Range("GrandMèreMaternelle") <> "GrandMèreMaternelle" Then Creation_Personne noLigne, 7, "GrandMèreMaternelle", "F", "NaissanceGrandMèreMaternelle", "LieuNaissanceGrandMèreMaternelle", "DécèsGrandMèreMaternelle", "LieuDécèsGrandMèreMaternelle", 7, 3, "MétierGrandMèreMaternelle"
    'Frères et soeurs des grands-parents maternels
    '---------------------------------------------
    For i = 30 To 39
        'Parcours des enfants des grands parents paternels
        If Range("Arrière_grands_parents_mater_1!" & "C" & i) <> "" And Range("Arrière_grands_parents_mater_1!" & "C" & i) <> Range("GrandPèreMaternel") Then
            'Création des individus de @I100@ à @I109@
            Creation_Personne noLigne, i + 72, "Arrière_grands_parents_mater_1!" & "C" & i, IIf("=Arrière_grands_parents_mater_1!D" & i = "Fils", "M", "F"), "Arrière_grands_parents_mater_1!E" & i, "Arrière_grands_parents_mater_1!F" & i, "Arrière_grands_parents_mater_1!G" & i, "Arrière_grands_parents_mater_1!H" & i, 6, 0, ""
        End If
    Next i
    'Frères et soeurs des grands-parents maternels
    '---------------------------------------------
    For i = 30 To 39
        'Parcours des enfants des grands parents maternels
        If Range("Arrière_grands_parents_mater_2!" & "C" & i) <> "" And Range("Arrière_grands_parents_mater_2!" & "C" & i) <> Range("GrandMèreMaternelle") Then
            'Création des individus de @I110@ à @I119@
            Creation_Personne noLigne, i + 82, "Arrière_grands_parents_mater_2!" & "C" & i, IIf("=Arrière_grands_parents_mater_2!D" & i = "Fils", "M", "F"), "Arrière_grands_parents_mater_2!E" & i, "Arrière_grands_parents_mater_2!F" & i, "Arrière_grands_parents_mater_2!G" & i, "Arrière_grands_parents_mater_2!H" & i, 7, 0, ""
        End If
    Next i
    'Arrière-grands-parents paternels 1
    '----------------------------------
    If Range("ArrièreGrandPèrePaternel1") <> "" And Range("ArrièreGrandPèrePaternel1") <> "Arrière-grand-père paternel 1" Then Creation_Personne noLigne, 8, "ArrièreGrandPèrePaternel1", "M", "NaissanceArrièreGrandPèrePaternel1", "LieuNaissanceArrièreGrandPèrePaternel1", "DécèsArrièreGrandPèrePaternel1", "LieuDécèsArrièreGrandPèrePaternel1", 8, 4, "MétierArrièreGrandPèrePaternel1"
    If Range("ArrièreGrandMèrePaternelle1") <> "" And Range("ArrièreGrandMèrePaternelle1") <> "Arrière-grand-mère paternelle 1" Then Creation_Personne noLigne, 9, "ArrièreGrandMèrePaternelle1", "F", "NaissanceArrièreGrandMèrePaternelle1", "LieuNaissanceArrièreGrandMèrePaternelle1", "DécèsArrièreGrandMèrePaternelle1", "LieuDécèsArrièreGrandMèrePaternelle1", 9, 4, "MétierArrièreGrandMèrePaternelle1"
    'Arrière-grands-parents paternels 1
    '----------------------------------
    If Range("ArrièreGrandPèrePaternel2") <> "" And Range("ArrièreGrandPèrePaternel2") <> "Arrière-grand-père paternel 2" Then Creation_Personne noLigne, 10, "ArrièreGrandPèrePaternel2", "M", "NaissanceArrièreGrandPèrePaternel2", "LieuNaissanceArrièreGrandPèrePaternel2", "DécèsArrièreGrandPèrePaternel2", "LieuDécèsArrièreGrandPèrePaternel2", 10, 5, "MétierArrièreGrandPèrePaternel2"
    If Range("ArrièreGrandMèrePaternelle2") <> "" And Range("ArrièreGrandMèrePaternelle2") <> "Arrière-grand-mère paternelle 2" Then Creation_Personne noLigne, 11, "ArrièreGrandMèrePaternelle2", "F", "NaissanceArrièreGrandMèrePaternelle2", "LieuNaissanceArrièreGrandMèrePaternelle2", "DécèsArrièreGrandMèrePaternelle2", "LieuDécèsArrièreGrandMèrePaternelle2", 11, 5, "MétierArrièreGrandMèrePaternelle2"
    'Arrière-Grands_parents_maternels 2
    '----------------------------------
    If Range("ArrièreGrandPèreMaternel1") <> "" And Range("ArrièreGrandPèreMaternel1") <> "Arrière-grand-père maternel 1" Then Creation_Personne noLigne, 12, "ArrièreGrandPèreMaternel1", "M", "NaissanceArrièreGrandPèreMaternel1", "LieuNaissanceArrièreGrandPèreMaternel1", "DécèsArrièreGrandPèreMaternel1", "LieuDécèsArrièreGrandPèreMaternel1", 12, 6, "MétierArrièreGrandPèreMaternel1"
    If Range("ArrièreGrandMèreMaternelle1") <> "" And Range("ArrièreGrandMèreMaternelle1") <> "Arrière-grand-mère maternelle 1" Then Creation_Personne noLigne, 13, "ArrièreGrandMèreMaternelle1", "F", "NaissanceArrièreGrandMèreMaternelle1", "LieuNaissanceArrièreGrandMèreMaternelle1", "DécèsArrièreGrandMèreMaternelle1", "LieuDécèsArrièreGrandMèreMaternelle1", 13, 6, "MétierArrièreGrandMèreMaternelle1"
    'Arrière-Grands_parents_maternels 2
    '----------------------------------
    If Range("ArrièreGrandPèreMaternel2") <> "" And Range("ArrièreGrandPèreMaternel2") <> "Arrière-grand-père maternel 2" Then Creation_Personne noLigne, 14, "ArrièreGrandPèreMaternel2", "M", "NaissanceArrièreGrandPèreMaternel2", "LieuNaissanceArrièreGrandPèreMaternel2", "DécèsArrièreGrandPèreMaternel2", "LieuDécèsArrièreGrandPèreMaternel2", 14, 7, "MétierArrièreGrandPèreMaternel2"
    If Range("ArrièreGrandMèreMaternelle2") <> "" And Range("ArrièreGrandMèreMaternelle2") <> "Arrière-grand-mère maternelle 2" Then Creation_Personne noLigne, 15, "ArrièreGrandMèreMaternelle2", "F", "NaissanceArrièreGrandMèreMaternelle2", "LieuNaissanceArrièreGrandMèreMaternelle2", "DécèsArrièreGrandMèreMaternelle2", "LieuDécèsArrièreGrandMèreMaternelle2", 15, 7, "MétierArrièreGrandMèreMaternelle2"
    'Arrière-arrière-grand-parents
    '-----------------------------
    If Range("ArrièreArrièreGrandPèrePaternel1") <> "" And Range("ArrièreArrièreGrandPèrePaternel1") <> "Arrière-arrière-grand-père paternel 1" Then Creation_Personne noLigne, 16, "ArrièreArrièreGrandPèrePaternel1", "M", "", "", "", "", 0, 8, ""
    If Range("ArrièreArrièreGrandMèrePaternelle1") <> "" And Range("ArrièreArrièreGrandMèrePaternelle1") <> "Arrière-arrière-grand-mère paternelle 1" Then Creation_Personne noLigne, 17, "ArrièreArrièreGrandMèrePaternelle1", "F", "", "", "", "", 0, 8, ""
    If Range("ArrièreArrièreGrandPèrePaternel2") <> "" And Range("ArrièreArrièreGrandPèrePaternel2") <> "Arrière-arrière-grand-père paternel 2" Then Creation_Personne noLigne, 18, "ArrièreArrièreGrandPèrePaternel2", "M", "", "", "", "", 0, 9, ""
    If Range("ArrièreArrièreGrandMèrePaternelle2") <> "" And Range("ArrièreArrièreGrandMèrePaternelle2") <> "Arrière-arrière-grand-mère paternelle 2" Then Creation_Personne noLigne, 19, "ArrièreArrièreGrandMèrePaternelle2", "F", "", "", "", "", 0, 9, ""
 
    If Range("ArrièreArrièreGrandPèrePaternel3") <> "" And Range("ArrièreArrièreGrandPèrePaternel3") <> "Arrière-arrière-grand-père paternel 3" Then Creation_Personne noLigne, 20, "ArrièreArrièreGrandPèrePaternel3", "M", "", "", "", "", 0, 10, ""
    If Range("ArrièreArrièreGrandMèrePaternelle3") <> "" And Range("ArrièreArrièreGrandMèrePaternelle3") <> "Arrière-arrière-grand-mère paternelle 3" Then Creation_Personne noLigne, 21, "ArrièreArrièreGrandMèrePaternelle3", "F", "", "", "", "", 0, 10, ""
    If Range("ArrièreArrièreGrandPèrePaternel4") <> "" And Range("ArrièreArrièreGrandPèrePaternel4") <> "Arrière-arrière-grand-père paternel 4" Then Creation_Personne noLigne, 22, "ArrièreArrièreGrandPèrePaternel4", "M", "", "", "", "", 0, 11, ""
    If Range("ArrièreArrièreGrandMèrePaternelle4") <> "" And Range("ArrièreArrièreGrandMèrePaternelle4") <> "Arrière-arrière-grand-mère paternelle 4" Then Creation_Personne noLigne, 23, "ArrièreArrièreGrandMèrePaternelle4", "F", "", "", "", "", 0, 11, ""
 
    If Range("ArrièreArrièreGrandPèreMaternel1") <> "" And Range("ArrièreArrièreGrandPèreMaternel1") <> "Arrière-arrière-grand-père maternel 1" Then Creation_Personne noLigne, 24, "ArrièreArrièreGrandPèreMaternel1", "M", "", "", "", "", 0, 12, ""
    If Range("ArrièreArrièreGrandMèreMaternelle1") <> "" And Range("ArrièreArrièreGrandMèreMaternelle1") <> "Arrière-arrière-grand-mère maternelle 1" Then Creation_Personne noLigne, 25, "ArrièreArrièreGrandMèreMaternelle1", "F", "", "", "", "", 25, 12, ""
    If Range("ArrièreArrièreGrandPèreMaternel2") <> "" And Range("ArrièreArrièreGrandPèreMaternel2") <> "Arrière-arrière-grand-père maternel 2" Then Creation_Personne noLigne, 26, "ArrièreArrièreGrandPèreMaternel2", "M", "", "", "", "", 0, 13, ""
    If Range("ArrièreArrièreGrandMèreMaternelle2") <> "" And Range("ArrièreArrièreGrandMèreMaternelle2") <> "Arrière-arrière-grand-mère maternelle 2" Then Creation_Personne noLigne, 27, "ArrièreArrièreGrandMèreMaternelle2", "F", "", "", "", "", 0, 13, ""
 
    If Range("ArrièreArrièreGrandPèreMaternel3") <> "" And Range("ArrièreArrièreGrandPèreMaternel3") <> "Arrière-arrière-grand-père maternel 3" Then Creation_Personne noLigne, 28, "ArrièreArrièreGrandPèreMaternel3", "M", "", "", "", "", 0, 14, ""
    If Range("ArrièreArrièreGrandMèreMaternelle3") <> "" And Range("ArrièreArrièreGrandMèreMaternelle3") <> "Arrière-arrière-grand-mère maternelle 3" Then Creation_Personne noLigne, 29, "ArrièreArrièreGrandMèreMaternelle3", "F", "", "", "", "", 29, 14, ""
    If Range("ArrièreArrièreGrandPèreMaternel4") <> "" And Range("ArrièreArrièreGrandPèreMaternel4") <> "Arrière-arrière-grand-père maternel 4" Then Creation_Personne noLigne, 30, "ArrièreArrièreGrandPèreMaternel4", "M", "", "", "", "", 0, 15, ""
    If Range("ArrièreArrièreGrandMèreMaternelle4") <> "" And Range("ArrièreArrièreGrandMèreMaternelle4") <> "Arrière-arrière-grand-mère maternelle 4" Then Creation_Personne noLigne, 31, "ArrièreArrièreGrandMèreMaternelle4", "F", "", "", "", "", 0, 15, ""
    '-------------------
    'CREATION DES UNIONS
    '-------------------
    'Unions des parents
    '------------------
    noUnion = 1: noEpoux = 2: noEpouse = 3
    If Range("Père") = "" And Range("Père") = "Père" Then noEpoux = 0
    If Range("Mère") = "" And Range("Mère") = "Mère" Then noEpouse = 0
    'Enfants des parents
    nbEnfants = 0
    For i = 29 To 38
        'Parcours des enfants des parents
        If Range("Parents!" & "C" & i) = Range("Accueil") Then
            'Création enfant : @I1@
            nbEnfants = nbEnfants + 1
            tnoEnfant(nbEnfants) = 1 '"@I1@ Probant
        Else
            If Range("Parents!" & "C" & i) <> "" Then
                'Création enfants des parents : de @I50@" à @I59@
                nbEnfants = nbEnfants + 1
                tnoEnfant(nbEnfants) = i + 21
            End If
        End If
    Next i
    Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "MariageParents", "LieuMariageParents"
    'Union des grands-parents
    '------------------------
    noUnion = 2: noEpoux = 4: noEpouse = 5
    If Range("GrandPèrePaternel") = "" Or Range("GrandPèrePaternel") = "GrandPèrePaternel" Then noEpoux = 0
    If Range("GrandMèrePaternelle") = "" Or Range("GrandMèrePaternelle") = "GrandMèrePaternelle" Then noEpouse = 0
    'Enfants des grands-parents paternels frères et soeurs du père
    nbEnfants = 0
    For i = 30 To 39
        'Parcours des enfants des grands parents paternels
        If Range("Grands_parents_paternels!" & "C" & i) = Range("Père") Then
            'Création enfant : @I2@
            nbEnfants = nbEnfants + 1
            tnoEnfant(nbEnfants) = 2 '"@I2@ Père
        Else
            If Range("Grands_parents_paternels!" & "C" & i) <> "" Then
                'Création enfants des grands parents paternels : de @I60@" à @I69@
                nbEnfants = nbEnfants + 1
                tnoEnfant(nbEnfants) = i + 32
            End If
        End If
    Next i
    Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "MariageGrandsParentsPaternels", "LieuMariageGrandsParentsPaternels"
 
    noUnion = 3: noEpoux = 6: noEpouse = 7
    If Range("GrandPèreMaternel") = "" Or Range("GrandPèreMaternel") = "GrandPèreMaternel" Then noEpoux = 0
    If Range("GrandMèreMaternelle") = "" Or Range("GrandMèreMaternelle") = "GrandMèreMaternelle" Then noEpouse = 0
    'Enfants des grands-parents maternels frères et soeurs de la mère
    nbEnfants = 0
    For i = 30 To 39
        'Parcours des enfants des grands parents maternels
        If Range("Grands_parents_maternels!" & "C" & i) = Range("Mère") Then
            'Création enfant : @I3@
            nbEnfants = nbEnfants + 1
            tnoEnfant(nbEnfants) = 3 '"@I3@ Mère
        Else
            If Range("Grands_parents_maternels!" & "C" & i) <> "" Then
                'Création enfants des grands parents maternels  : de @I70@" à @I79@
                nbEnfants = nbEnfants + 1
                tnoEnfant(nbEnfants) = i + 42
            End If
        End If
    Next i
    Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "MariageGrandsParentsMaternels", "LieuMariageGrandsParentsMaternels"
    'Union des arrières-grands-parents
    '---------------------------------
    noUnion = 4: noEpoux = 8: noEpouse = 9: nbEnfants = 1: tnoEnfant(1) = 4
    If Range("ArrièreGrandPèrePaternel1") = "" Or Range("ArrièreGrandPèrePaternel1") = "Arrière-grand-père paternel 1" Then noEpoux = 0
    If Range("ArrièreGrandMèreMaternelle1") = "" Or Range("ArrièreGrandMèreMaternelle1") = "Arrière-grand-mère maternelle 1" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "MariageArrièreGrandsParentsPaternels1", "LieuMariageArrièreGrandsParentsPaternels1"
 
    noUnion = 5: noEpoux = 10: noEpouse = 11: tnoEnfant(1) = 5
    If Range("ArrièreGrandPèrePaternel2") = "" Or Range("ArrièreGrandPèrePaternel2") = "Arrière-grand-père paternel 2" Then noEpoux = 0
    If Range("ArrièreGrandMèreMaternelle2") = "" Or Range("ArrièreGrandMèreMaternelle2") = "Arrière-grand-mère maternelle 2" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "MariageArrièreGrandsParentsPaternels2", "LieuMariageArrièreGrandsParentsPaternels2"
 
    noUnion = 6: noEpoux = 12: noEpouse = 13: tnoEnfant(1) = 6
    If Range("ArrièreGrandPèreMaternel1") = "" Or Range("ArrièreGrandPèreMaternel1") = "Arrière-grand-père maternel 1" Then noEpoux = 0
    If Range("ArrièreGrandMèreMaternelle1") = "" Or Range("ArrièreGrandMèreMaternelle1") = "Arrière-grand-mère maternelle 1" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "MariageArrièreGrandsParentsMaternels1", "LieuMariageArrièreGrandsParentsMaternels1"
 
    noUnion = 7: noEpoux = 14: noEpouse = 15: tnoEnfant(1) = 7
    If Range("ArrièreGrandPèreMaternel2") = "" Or Range("ArrièreGrandPèreMaternel2") = "Arrière-grand-père maternel 2" Then noEpoux = 0
    If Range("ArrièreGrandMèreMaternelle2") = "" Or Range("ArrièreGrandMèreMaternelle2") = "Arrière-grand-mère maternelle 2" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "MariageArrièreGrandsParentsMaternels2", "LieuMariageArrièreGrandsParentsMaternels2"
    'Union des arrières-arrières-grands-parents
    '------------------------------------------
    noUnion = 8: noEpoux = 16: noEpouse = 17: tnoEnfant(1) = 8
    If Range("ArrièreArrièreGrandPèreMaternel1") = "" Or Range("ArrièreArrièreGrandPèreMaternel1") = "Arrière-arrière-grand-père maternel 1" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèreMaternelle1") = "" Or Range("ArrièreArrièreGrandMèreMaternelle1") = "Arrière-arrière-grand-mère maternelle 1" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "", ""
 
    noUnion = 9: noEpoux = 18: noEpouse = 19: tnoEnfant(1) = 9
    If Range("ArrièreArrièreGrandPèrePaternel4") = "" Or Range("ArrièreArrièreGrandPèrePaternel4") = "Arrière-arrière-grand-père paternel 4" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèrePaternelle4") = "" Or Range("ArrièreArrièreGrandMèrePaternelle4") = "Arrière-arrière-grand-mère paternelle 4" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, nbEnfants, tnoEnfant, "", ""
 
    noUnion = 10: noEpoux = 20: noEpouse = 21: tnoEnfant(1) = 10
    If Range("ArrièreArrièreGrandPèrePaternel3") = "" Or Range("ArrièreArrièreGrandPèrePaternel3") = "Arrière-arrière-grand-père paternel 3" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèrePaternelle3") = "" Or Range("ArrièreArrièreGrandMèrePaternelle3") = "Arrière-arrière-grand-mère paternelle 3" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, 1, tnoEnfant, "", ""
 
    noUnion = 11: noEpoux = 22: noEpouse = 23: tnoEnfant(1) = 11
    If Range("ArrièreArrièreGrandPèrePaternel4") = "" Or Range("ArrièreArrièreGrandPèrePaternel4") = "Arrière-arrière-grand-père paternel 4" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèrePaternelle4") = "" Or Range("ArrièreArrièreGrandMèrePaternelle4") = "Arrière-arrière-grand-mère paternelle 4" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, 1, tnoEnfant, "", ""
 
    noUnion = 12: noEpoux = 24: noEpouse = 25: tnoEnfant(1) = 12
    If Range("ArrièreArrièreGrandPèreMaternel1") = "" Or Range("ArrièreArrièreGrandPèreMaternel1") = "Arrière-arrière-grand-père maternel 1" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèreMaternelle1") = "" Or Range("ArrièreArrièreGrandMèreMaternelle1") = "Arrière-arrière-grand-mère maternelle 1" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, 1, tnoEnfant, "", ""
 
    noUnion = 13: noEpoux = 26: noEpouse = 27: tnoEnfant(1) = 13
    If Range("ArrièreArrièreGrandPèreMaternel2") = "" Or Range("ArrièreArrièreGrandPèreMaternel2") = "Arrière-arrière-grand-père maternel 2" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèreMaternelle2") = "" Or Range("ArrièreArrièreGrandMèreMaternelle2") = "Arrière-arrière-grand-mère maternelle 2" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, 1, tnoEnfant, "", ""
 
    noUnion = 14: noEpoux = 28: noEpouse = 29: tnoEnfant(1) = 14
    If Range("ArrièreArrièreGrandPèreMaternel3") = "" Or Range("ArrièreArrièreGrandPèreMaternel3") = "Arrière-arrière-grand-père maternel 3" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèreMaternelle3") = "" Or Range("ArrièreArrièreGrandMèreMaternelle3") = "Arrière-arrière-grand-mère maternelle 3" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, 1, tnoEnfant, "", ""
 
    noUnion = 15: noEpoux = 30: noEpouse = 31: tnoEnfant(1) = 15
    If Range("ArrièreArrièreGrandPèreMaternel4") = "" Or Range("ArrièreArrièreGrandPèreMaternel4") = "Arrière-arrière-grand-père maternel 4" Then noEpoux = 0
    If Range("ArrièreArrièreGrandMèreMaternelle4") = "" Or Range("ArrièreArrièreGrandMèreMaternelle4") = "Arrière-arrière-grand-mère maternelle 4" Then noEpouse = 0
    If noEpoux > 0 Or noEpouse > 0 Then Creation_Union noLigne, noUnion, noEpoux, noEpouse, 1, tnoEnfant, "", ""
    'Fin du Gedcom
    '-------------
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "0 TRLR"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Function Mois_Court(Mois As String)
'
' Recherche du mois court en anglais pour associer à la balise date
'
    Select Case UCase(Mois)
    Case "JANVIER", "JAN", "JANV", "JANUARY": Mois_Court = "JAN"
    Case "FEVRIER", "FÉVRIER", "FEV", "FEBRUARY":        Mois_Court = "FEB"
    Case "MARS", "MARCH":                                Mois_Court = "MAR"
    Case "AVRIL", "APRIL":                               Mois_Court = "APR"
    Case "MAI", "MAY":                                   Mois_Court = "MAY"
    Case "JUIN", "JUNE":                                 Mois_Court = "JUN"
    Case "JUILLET", "JUIL", "JULY":                      Mois_Court = "JUL"
    Case "AOUT", "AOÛT", "AUGUST":                       Mois_Court = "AUG"
    Case "SEPTEMBRE", "SEPT", "SEPTEMBER":               Mois_Court = "SEP"
    Case "OCTOBRE", "OCT", "OCTOBER":                    Mois_Court = "OCT"
    Case "NOVEMBRE", "NOV", "NOVEMBER":                  Mois_Court = "NOV"
    Case "DECEMBRE", "DÉCEMBRE", "DEC", "DECEMBER":      Mois_Court = "DEC"
    Case Else:                                           Mois_Court = Mois
    End Select
End Function
Sub Creation_Personne(noLigne As Integer, NoIndividu As Integer, Nom As String, Sexe As String, DateNaissance As String, LieuNaissance As String, DateDeces As String, LieuDeces As String, NoUnionParents As Integer, NoUnionCouple As Integer, Metier As String)
    '
    'Création d'une personne : Père, Mère, Grand-père, Grand-mère, etc
    '
    Dim PosEspace As Integer
    Dim NomAffiche As String
 
    'Nom de l'individu
    PosEspace = InStr(Range(Nom), Space(1))
    If PosEspace = 0 Then
        NomAffiche = "/" & Range(Nom) & "/"
    Else
        NomAffiche = Left(Range(Nom), PosEspace - 1) & "/" & Right(Range(Nom), Len(Range(Nom)) - PosEspace) & "/"
    End If
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "0 @I" & NoIndividu & "@ INDI"
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 NAME " & NomAffiche
    'Sexe de l'individu
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 SEX " & Sexe
    'Métier de la personne
    If Metier <> "" Then
        If Range(Metier) <> "" Then
            noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 OCCU " & Range(Metier)
        End If
    End If
    'Naissance de la personne
    If DateNaissance <> "" Then
        If Range(DateNaissance) <> "" And Range(LieuNaissance) <> "" Then
            noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 BIRT"
            If Range(DateNaissance) <> "" Then
                noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 DATE " & DateEven(DateNaissance)
            End If
            If Range(LieuNaissance) <> "" Then
                noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 PLACE " & Range(LieuNaissance)
            End If
        End If
    End If
    'Décès de la personne
    If DateDeces <> "" Then
        If Range(DateDeces) <> "" And Range(LieuDeces) <> "" Then
            noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 DEAT"
            If Range(DateDeces) <> "" Then
                noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 DATE " & DateEven(DateDeces)
            End If
            If Range(LieuDeces) <> "" Then
                noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 PLACE " & Range(LieuDeces)
            End If
        End If
    End If
    'Union des parents
    If NoUnionParents > 0 Then noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 FAMC @U" & NoUnionParents & "@"
    'Union du couple
    If NoUnionCouple > 0 Then noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 FAMS @U" & NoUnionCouple & "@"
End Sub
Sub Creation_Union(noLigne As Integer, noUnion As Integer, noEpoux As Integer, noEpouse As Integer, nbEnfant As Integer, tnoEnfant() As Integer, DateMariage As String, LieuMariage As String)
    '
    'Création d'une union
 
    Dim i As Integer
 
    noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "0 @U" & noUnion & "@ FAM"
    'Couple
    If noEpoux > 0 Then noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 HUSB @I" & noEpoux & "@"
    If noEpouse > 0 Then noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 WIFE @I" & noEpouse & "@"
    'Mariage
    If DateMariage <> "" Then
        If Range(DateMariage) <> "" And Range(LieuMariage) <> "" Then
            noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 MARR"
            If Range(DateMariage) <> "" Then
                noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 DATE " & DateEven(DateMariage)
            End If
            If Range(LieuMariage) <> "" Then
                noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "2 PLACE " & Range(LieuMariage)
            End If
        End If
    End If
    'Enfants
    For i = 1 To nbEnfant
        If tnoEnfant(i) > 0 Then noLigne = noLigne + 1: Range("A" & noLigne).Select: ActiveCell.FormulaR1C1 = "1 CHIL @I" & tnoEnfant(i) & "@"
    Next i
End Sub
Function DateEven(DateLue As String) As String
    'Mise en forme de la date
 
    Dim DateComplete As String
 
    If Len(Range(DateLue)) = 4 And IsNumeric(Range(DateLue)) Then
       DateEven = Range(DateLue)
    Else
       If Not IsDate(Range(DateLue)) Then
          DateEven = Range(DateLue)
       Else
          DateEven = Format(Range(DateLue), "dd ") & Mois_Court(Format(Range(DateLue), "mmmm")) & Format(Range(DateLue), " yyyy")
       End If
    End If
End Function

[touche_a_tout]

Bonjour Dysorthographie,
Avec tout le respect que je te dois (et je n'emploie pas ce terme à la légère), le code que tu me transmets ne répond pas à mes besoins (je connais Visuged et je sais qu'ils font - qu'il fait - du bon boulot). Mais avec ce code il vise à créer une généalogie de toutes pièces avec parents, enfants, grands-parents, mariages, naissances, etc .
Dans mon logiciel, j'ai déjà tout ça sur 6 ou 7 générations; je ne dois entrer que des sources. Pour quoi faire ? Parce qu'un quidam, voyant par exemple que je dis dans ma généalogie que le mariage de Sylvestre Tartemplume avec Isabeau Tartenplomb a eu lieu en date du tant et tant dans telle ou telle commune, il est en droit de me dire: "Prouve-le". C'est à ça que servent les sources. A chaque événement, non seulement naissance, mariage, décès, mais la simple constatation que tel ou tel(le) est vivant à telle date, ou mieux, qu'il a tel âge à cette date (ce qui permet d'estimer son année de naissance), qu'il hérite de telle personne, etc., correspond un lien "Source" auquel on peut rattacher un ou plusieurs documents à l'appui de ce qu'affirme la généalogie.
En pratique, sur les conseils d'un généalogiste très ferré sur le gedcom, je devrai - si j'arrive à en faire un seul long document de 300 ou 400 sources - créer un individu fictif auquel ces sources seront liées, introduire le tout dans mon logiciel en rattachant l'individu bidon à ma propre généalogie, supprimer l'individu bidon puis relier chaque source à l'événement - aux événements, plutôt - qu'elle justifie. Et je peux le faire avec 70 individus bidon selon la même méthode, si je n'arrive pas à fusionner mes gedcoms, ce que je ne cherche d'ailleurs pas à faire à tout prix.

N'étaient mes maladresses de codage et mes lourdeurs qui te hérissent certainement, je pense pouvoir terminer cette appli en décomposant, suivant le conseil de Pierre, mes 400 et quelques lignes de code en blocs plus courts, plus maniables, plus lisibles et plus faciles de maintenance. Ma seule question concerne la manière de faire s'enchaîner l'exécution de ces blocs a priori indépendants les uns des autres. En outre j'ai lu dans un mel de P.F. qu'il fallait privilégier les variables locales; je n'ai pas bien vu pourquoi, d'autant que des strings comme SOUR, TITL, TEXT, CONT, MEDI, et probablement quelques autres apparaissent dans absolument toutes les sections du code. Si je pouvais avoir votre avis sur ces 2 points, je serais ravi.
Bien à toi et bonne fin de semaine
touche_a_tout

[Invité]

Désolé si je t'es offensés, mais ce code contient,a mon avis, intrinsèquement tout ce dont tu as besoin!

Je l'ai utilisé moi même pour tout autres choses, vraiment désolé oublis ce que j'ai écris.

[Pierre Fauconnier]

Pour chainer les différents bouts de code, tu peux les appeler comme tu le faisais avec Call, bien que ce mot-clé ne soit pas utile.

Voici un petit exemple qui illustre comment travailler avec du code segmenté en procédures/fonctions courtes avec des arguments.

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
Sub Main()
  Dim Gen As String
  Dim GenTitle As String
  Dim LongTitle As String
 
  Gen = "Généalogie"
  GenTitle = "Pierre Ruel"
  AfficherTitre GenTitle
  LongTitle = CreerLongTitre(Gen, GenTitle)
  MsgBox LongTitle
End Sub
 
Sub AfficherTitre(Title As String)
  MsgBox Title
End Sub
 
Function CreerLongTitre(Gen As String, Title As String)
  CreerLongTitre = Gen & " - " & Title
End Function

Je ne suis pas fan des variables globales, mais c'est ma religion . Je préfère donc me passer des variables publiques déclarées au début d'un module standard et utiliser les arguments de procédure/fonction/propriété. Je ne vais pas entrer ici dans une longue explication sur les variables globales parce qu'il me faudrait parler des arguments ByRef et ByVal, de la durée de vie et de la portée des variables. Ces notions sont très importantes pour créer du code de qualité, mais on peut y aller pas à pas. Je ne développerai donc pas ici tous mes arguments, mais je vais en citer un, qui est directement lié au fait de créer de petites briques de code (des procédures ou fonctions courtes qui ont une responsabilité.

Si tu regardes le code que j'ai donné plus haut, on voit que chaque procédure/fonction est indépendante des autres. Chaque brique reçoit les données nécessaires à son fonctionnement et fait son job. Elle est donc indépendante du reste du code. Cela signifie que tu peux la tester dans tous les sens sans avoir besoin d'autre chose qu'une procédure de test qui l'appelle en lui fournissant les arguments nécessaires.

Si j'avais utilisé des variables globales, je ne pourrais pas tester les procédures AfficherTitre et CreerLongTitre sans que ces variables aient été au préalables valorisées, parfois par un enchaînement important d'autres procédures/fonctions. Or, c'est un problème car si, pour une raison ou l'autre, tu dois stopper l'exécution de ton code (debogage, stop du code sur ligne jaune, ...), les variables globales sont remises à zéro... Tu ne sais donc plus tester tes briques sans relancer tout le process.

Voilà une des raisons qui fait que je n'aime pas les variables globales déclarées comme publiques au début d'un module standard.

[touche_a_tout]

Bonjour,
Merci à vous deux.
Robert, je ne me suis pas senti offensé du tout, j'ai regretté que tu fasses des efforts qui dépassent de loin mes besoins. Je vais regarder ce code de plus près pour voir ce qui peut m'être utile. Je crois reconnaître des instructions de mise en pages dont je n'ai absolument pas l'emploi mais je me concentrerai sur le reste.
Les arguments de Pierre sont en grande partie convaincants et surtout il produit (tout comme Robert) un code léger, bien plus élégant que mes balbutiements. Mais bon, la vitesse d'écriture du code et d'exécution n'est pas un objectif essentiel ici.
A propos des variables, c'est vrai que mon système m'oblige à faire repartir toute la mécanique à chaque bug local, c'est assez irritant. Mais tout de même: l'autre formule oblige à recopier les variables en local au début de chaque sub partielle; en plus il n'y a pas une seule donnée brute qui ne soit pas définie par une ligne et une colonne: pourquoi ne pas mettre au moins ces 2 integer en Public ?
Ton insistance m'a amené à examiner mon bloc de "Public" qui compte 12 lignes. J'ai déjà pu virer deux ou trois variables qui ne sont pas/plus utilisées mais surtout je me suis rendu compte (la honte) que TEXT, ABBR et consorts ne sont pas des variables du tout. Elles figurent dans mon code comme des éléments de la rédaction écrits entre guillemets.
Cela dit, il y a quand même des variables qui se retrouvent à presque toutes les étapes:

Code :

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

1
2
Public domicile As String, lieu As String, parenté As String
Public son_age  As Variant, annee  As Variant

A répéter à chaque "sous-sub" ?
Je dois vous avouer que mon code est celui du dossier new_consolidation.xlsm mais que j'en suis déjà à new_new_consolidation.xlsm qui fait la distinction entre naissances, mariages et décès au niveau des sub, mais il n'est pas présentable pour le moment. J'ai pris note des conseils de Pierre pour l'enchaînement. Donnez-moi deux-trois jours et je devrais pouvoir vous donner de meilleures nouvelles et un classeur propre-en-ordre (expression du dialecte helvétique généralisée par le service militaire).
Merci encore et bon week-end
Cordialement,
touche_a_tout

[touche_a_tout]

@Pierre Fauconnier,
Dans ton exemple de code, est-ce que, dans la 2ème sub et la fonction il ne faudrait pas Gentitle au lieu de Title ? Ou alors je ne pige rien ! ne cherche pas:

Code :

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

1
2
3
4
5
6
7
Sub AfficherTitre(Title As String)
  MsgBox Title
End Sub
 
Function CreerLongTitre(Gen As String, Title As String)
  CreerLongTitre = Gen & " - " & Title
End Function

Merci d'avance.
Cordialement
t_a_t

[Invité]

c'est juste pour donner un ordre d’idées!

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
Type Personne
    Nom As String
    INDI As Integer
    domicile As String
    lieu As String
    parenté As String
    son_age  As Integer
    annee  As Integer
End Type
Sub test()
Dim pers As Personne
FicheSinaletique pers
FichierText Environ("UserProfile") & "\Desktop\Gedcom.txt", Gedcom(pers)
End Sub
 
Sub FicheSinaletique(ByRef pers As Personne)
pers.INDI = 1
pers.Nom = " dysorthographie"
End Sub
Function Gedcom(pers As Personne) As String
'0 @I001@ IN
'1 NAME André /JARRET/
'1 SEX M  as Object,
'1 Chr
'2 DATE  9 AUG 1642
'2 PLAC Vignieu, Isère, France
'2 SOUR Copie du registre, fonds André Beauregard
'1 DEAT
'2 DATE ABT 1690
'2 PLAC Verchères, Verchères, Québec
'2 NOTE Entre 9 mois avant la naissance de son cadet et la 1re fois où son épouse est dite veuve
'1 FAMS @F0001@
'1 FAMC @F0002@
Gedcom = "0 @" & Format(pers.INDI, "000") & "@ INDI" & vbCrLf
Gedcom = Gedcom & "1 NAME " & pers.Nom & vbCrLf
End Function
 
Sub FichierText(Fichier As String, Text As String, Optional Ecraser As Boolean = False)
Dim fso As Object, NewFichier As Object
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
If Ecraser Then
    Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
Else
    If Dir(Fichier) <> "" Then
        Set NewFichier = fso.OpenTextFile(Fichier, 8)
    Else
        Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
    End If
End If
NewFichier.Write Text
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Sub

[touche_a_tout]

Bonsoir,
Points de vue divergents !
J'ai passé pas mal de temps sur ce projet depuis le début de notre dernier échange et j'arrive à une conclusion assez déprimante. A vous lire, surtout Pierre Fauconnier qui est plus explicite que Dysorthographie, je me rends compte que nous visons, vous et moi, des objectifs complétement différents. C'est hélas déjà arrivé entre Robert et moi à propos de généalogie musicale, ce qui a jeté un froid qui a duré plusieurs mois.
Pour revenir à ce projet-ci en relation avec la généalogie et compte tenu de vos conseils: oublier le code et repartir d'un dessin, observer les règles de Descartes, utiliser les variables tout différemment etc., il est clair que votre but est, au gré de ce travail, de me faire progresser en programmation, ce qui est tout à fait louable et découle naturellement de votre fonction de formateurs.
Mais là, je dois rappeler ce que j'ai déjà dit à Robert. J'ai une généalogie qui s'étend sur 7 ou 8 générations et qui me donne toute satisfaction, sauf qu'il lui manque toutefois les sources. J'ai indiqué leur rôle dans le post de 15 h 52 aujourd'hui.
Cela posé, ce qui m'importe, ce n'est pas la qualité de ma programmation (facteur que je ne sous-estime pas) mais d'introduire mes sources dans cette généalogie. Le voilà, mon but à moi. en pratique il est tout différent du vôtre. Le projet traîne depuis trop longtemps (voir la date du copyright pour le code, qui n'en marque pas le début, loin de là !).
Je viens d'avoir 85 ans, ce qui signifie deux choses: primo mes capacités d'apprentissage ne sont plus ce qu'elles étaient et secundo si je veux atteindre mon but de mon vivant, je dois me bouger et donc le faire en utilisant les outils que je maîtrise plus ou moins actuellement afin de régler les quelques problèmes posés par le projet en l'état. Je suis arrivé depuis des mois à imprimer, donc à sauvegarder, des gedcoms utilisables mais contenant encore des coquilles que j'aimerais arriver à éliminer. Le but ne m'est donc pas inaccessible, même si mon codage donnerait la nausée à plus d'un membre de ce club. Si vous me faites changer mon fusil d'épaule, je peux dire adieu à une généalogie fiable, faute de preuves, c'est-à-dire de sources. C'est aussi simple que cela.
Pour paraphraser ce qu'écrit Pierre au bas de tous ses posts: Ces remarques sceptiques sont purement pragmatiques et il ne faut pas y voir d'attaques contre vos personnes ni vos prestations.
Sur ma flûte, je peux jouer l'air des Champs-Elysées tiré d'Orphée, de Gluck, mais pas le concerto de Katchaturian que Pahud interprète avec maestria. Nous ne jouons pas dans la même ligue. Vous et moi non plus. Il vient un moment où il faut se faire une raison. Je ne trouve pas particulièrement rigolo de vieillir mais je dois mesurer mes ambitions à l'aune de mes capacités. Vous montez toujours les escaliers quatre à quatre, vous deux ? Moi pas.
Cordialement
touche_a_tout