XL 2019 importer gedcom en masse dans excel

[steph_29120]

Bonjour à tous,

je recherche une solution peut-être une macro (je n'y connais rien) pour importer en une seule fois des fichiers gedcom (généalogie) dans excel.

j'ai plus de 500 fichiers et je souhaiterais qu'une seule base excel au final. et le mieux c'est si on pouvait supprimer les doublon mais cela est accessoire....

je ne peux pas vous joindre un fichier gedcom le site refuse le format...

cordialement
Stéphane

 

[dg62]

Bonsoir,
Oxy-gen vous permet de transformer un fichier ged en csv qui vous permet l'intégration dans Excel.

 

[steph_29120]

bonsoir DG62.

malheureusement non il peut le faire mais que un fichier par un fichier
c'est pour cela que je cherche une alternative.

merci
Stéphane

 

[dg62]

bonsoir DG62.

malheureusement non il peut le faire mais que un fichier par un fichier
c'est pour cela que je cherche une alternative.

merci
Stéphane

Oui, je suis d'accord c'était simplement pour signaler que le fichier ged n'est pas exploitable directement par Excel. A moins d'écrire une procédure pour lire directement le ged et l'intégrer.
Par contre si vous transformez vos fichiers en csv il est relativement simple d'écrire une procédure d'intégration.

 

[steph_29120]

1/ transformation gedcom en csv
2/ intégration par macro des csv dans excel

si la transformation du fichier gedcom en csv est automatisable pourquoi pas ?

merci

 

[dg62]

Un petit tour ici https://www.geneanet.org/forum/viewtopic.php?f=50&t=563053&hilit Peut-être une solution existante.

 

[dg62]

oxy-gen d'après sa doc est capable de gérer tous les fichiers d'un répertoire automatiquement.

 

[dg62]

Bonjour,
Une procédure encore incomplète qui récupère l'ensemble des individus d'un fichier GED.
Optimisation largement possible.
code modifié

Sub ExtractionGED()

Application.ScreenUpdating = False
On Error GoTo Erreur
Dim adresse() As String
Dim j As Integer
Dim Index As Integer
Dim MonFichier As String
Dim Ligne As String
Dim i As Integer
Dim Llig As Integer
Dim PNf As Integer
Dim Pind
Dim naiss As Byte
Dim deces As Byte
Dim Ladr As String
Dim mar As Byte
Dim Fichier As Variant
  ' le fichier GED original est au format Unix (LF)
  ' il faut le convertir en windows (CR/ LF)
  ' une méthode simple est de l'ouvrir avec excel une première fois et de l'enregistrer dans ce format
 Fichier = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")
 If Fichier = False Then Exit Sub
MonFichier = Fichier
Index = FreeFile()
Open MonFichier For Input As #Index
While Not EOF(Index) '
    Line Input #Index, Ligne
   Llig = Len(Ligne)
   PNf = InStr(1, Ligne, "/")
   Pind = InStr(1, Ligne, "@")
   ' N° individu
   If Right(Ligne, 6) = "@ INDI" Then
   i = i + 1
    Range("A" & i).Value = Mid(Ligne, Pind + 1, InStr(1, Ligne, "N") - 7)
   End If
   ' prénom et nom
   If Left(Ligne, 6) = "1 NAME" Then
    Range("B" & i).Value = Mid(Ligne, 8, PNf - 9)
    Range("C" & i).Value = Mid(Ligne, PNf + 1, Llig - PNf - 1)
   End If
   ' date de naissance
   If Left(Ligne, 6) = "1 BIRT" Then
   naiss = 1
   deces = 0
   End If
        
   If Left(Ligne, 6) = "2 DATE" And naiss = 1 Then
   Range("D" & i).Value = Mid(Ligne, 7, 12)
  
   End If
   ' Date de décés
   If Left(Ligne, 6) = "1 DEAT" Then
   deces = 1
   naiss = 0
   End If
      
   If Left(Ligne, 6) = "2 DATE" And deces = 1 Then
   Range("M" & i).Value = Mid(Ligne, 7, 12)
  
   End If
  ' lieu de naissance
   If Left(Ligne, 6) = "2 PLAC" And naiss = 1 Then
   Ladr = Mid(Ligne, 8)
   adresse = Split(Ladr, ",")
   For j = 0 To UBound(adresse)
   Range("F" & i).Offset(0, j) = adresse(j)
   Next j
   End If
   ' lieu décés
 If Left(Ligne, 6) = "2 PLAC" And deces = 1 Then
   Ladr = Mid(Ligne, 8)
   adresse = Split(Ladr, ",")
   For j = 0 To UBound(adresse)
   Range("N" & i).Offset(0, j) = adresse(j)
   Next j
   End If
 If Left(Ligne, 7) = "1 SEX M" Then
  
    Range("K" & i).Value = "M"
   End If
 ' sexe
 If Left(Ligne, 7) = "1 SEX F" Then
  
    Range("K" & i).Value = "F"
   End If
 ' profession
 If Left(Ligne, 6) = "1 OCCU" Then
  
    Range("L" & i).Value = Mid(Ligne, 7)
   End If
   ' Famille
  If Left(Ligne, 6) = "1 FAMC" Then

    Range("S" & i).Value = "FAMC"
    Range("T" & i).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)
   End If
   If Left(Ligne, 6) = "1 FAMS" Then
  
    Range("U" & i).Value = "FAMS"
    Range("V" & i).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)
   End If
 
Wend
Close #Index ' ferme le fichier
    Application.ScreenUpdating = True
    Exit Sub


Erreur:
MsgBox Ligne
Application.ScreenUpdating = True
End Sub

 

[steph_29120]

bonjour dg 62.

merci beaucoup je vais tester.

j'ai une personne qui a développé une macro pour import gedcom dans excel mais elle n'est pas faite pour w10 64 bits mais seulement pour 32 bits.

j'aimerais vous joindre le fichier mais il est refusé en PJ car trop volumineux.

je travail sous w10 64bits
cordialement

Stéphane

 

[dg62]

bonjour,
une procédure qui extrait la composition des familles par numéro avec date du mariage

Sub famille()

Application.ScreenUpdating = False
On Error GoTo Erreur

Dim Index As Integer
Dim MonFichier As String
Dim Ligne As String
Dim i As Integer
Dim Llig As Integer
Dim Pind
Dim mar As Byte
Dim chil As Integer
Dim marie As Byte
chil = 0
Dim Fichier As Variant
  ' le fichier GED original est au format Unix (LF)
  ' il faut le convertir en windows (CR/ LF)
  ' une méthode simple est de l'ouvrir avec excel une première fois et de l'enregistrer dans ce format
 Fichier = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")
 If Fichier = False Then Exit Sub
MonFichier = Fichier

Index = FreeFile()
Open MonFichier For Input As #Index
While Not EOF(Index) '
    Line Input #Index, Ligne
   Llig = Len(Ligne)

   Pind = InStr(1, Ligne, "@")
   ' identification famille
   If Right(Ligne, 3) = "FAM" Then
    i = i + 1
    chil = 0
    marie = 0
    Range("A" & i).Value = Mid(Ligne, Pind + 1, InStr(1, Ligne, "A") - 7)
   End If
   ' date mariage
   If Right(Ligne, 4) = "MARR" Then
   marie = 1
   End If
   If Left(Ligne, 6) = "2 DATE" And marie = 1 Then
   Range("D" & i).Value = Mid(Ligne, 7, 12)

   End If
  ' mari
If Left(Ligne, 6) = "1 HUSB" Then
    Range("B" & i).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)

End If
' épouse
If Left(Ligne, 6) = "1 WIFE" Then
    Range("C" & i).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)
  
End If
' enfants
If Left(Ligne, 6) = "1 CHIL" Then
chil = chil + 1
    Range("E" & i).Offset(0, chil).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)
  
End If

Wend
Close #Index ' ferme le fichier
    Application.ScreenUpdating = True
    Exit Sub
Erreur:
MsgBox "erreur sur la ligne " & Ligne
Application.ScreenUpdating = True
End Sub

 

[Hasco]

Bonjour,

Puisque vous avez excel 2019 avez-vous essayer d'importer avec power query : Onglet 'données'/A partir d'un fichier / A partir d'un répertoire.

Powerquery est prévu pour importer/transformer/consolider des données et peut le faire à partir d'un répertoire.

je ne peux pas vous joindre un fichier gedcom le site refuse le format...

Il suffit de changer son extension en extension acceptée (.zip) et de le signaler dans le post.

Cordialement

 

[dg62]

Bonjour Roblochon,
La structure d'un fichier Ged est très particulière.
https://www.francogene.com/internet/gedcom.php
mais je n'ai pas encore utilisé Powerquery' peut-être possible.

 

[Hasco]

Re,

Oui j'avais lu ce lien avant de poster. A partir du moment où il s'agit de texte, voyez ce que vous pouvez faire pour les importer/transformer par powerquery.

Cordialement

 

[dg62]

Re,
pour les curieux
un exemple, extrait fichier GED avec les traitements effectués par les deux procédures.
Les données sont réelles mais publiques sur le site geneanet.

 

[steph_29120]

bonjour,
une procédure qui extrait la composition des familles par numéro avec date du mariage

Sub famille()

Application.ScreenUpdating = False
On Error GoTo Erreur

Dim Index As Integer
Dim MonFichier As String
Dim Ligne As String
Dim i As Integer
Dim Llig As Integer
Dim Pind
Dim mar As Byte
Dim chil As Integer
Dim marie As Byte
chil = 0
Dim Fichier As Variant
  ' le fichier GED original est au format Unix (LF)
  ' il faut le convertir en windows (CR/ LF)
  ' une méthode simple est de l'ouvrir avec excel une première fois et de l'enregistrer dans ce format
Fichier = Application.GetOpenFilename("Tous les fichiers (*.txt),*.txt")
If Fichier = False Then Exit Sub
MonFichier = Fichier

Index = FreeFile()
Open MonFichier For Input As #Index
While Not EOF(Index) '
    Line Input #Index, Ligne
   Llig = Len(Ligne)

   Pind = InStr(1, Ligne, "@")
   ' identification famille
   If Right(Ligne, 3) = "FAM" Then
    i = i + 1
    chil = 0
    marie = 0
    Range("A" & i).Value = Mid(Ligne, Pind + 1, InStr(1, Ligne, "A") - 7)
   End If
   ' date mariage
   If Right(Ligne, 4) = "MARR" Then
   marie = 1
   End If
   If Left(Ligne, 6) = "2 DATE" And marie = 1 Then
   Range("D" & i).Value = Mid(Ligne, 7, 12)

   End If
  ' mari
If Left(Ligne, 6) = "1 HUSB" Then
    Range("B" & i).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)

End If
' épouse
If Left(Ligne, 6) = "1 WIFE" Then
    Range("C" & i).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)
 
End If
' enfants
If Left(Ligne, 6) = "1 CHIL" Then
chil = chil + 1
    Range("E" & i).Offset(0, chil).Value = Mid(Ligne, Pind + 1, InStr(Pind + 1, Ligne, "@") - Pind - 1)
 
End If

Wend
Close #Index ' ferme le fichier
    Application.ScreenUpdating = True
    Exit Sub
Erreur:
MsgBox "erreur sur la ligne " & Ligne
Application.ScreenUpdating = True
End Sub

bonjour,

s'il faut modifier les fichiers gedcom en txt en les important dans excel autant le faire immédiatement sans la macro.

je souhaite vous faire parvenir une macro. si je mets un line dans Méga vous pourrez le récupérer ?

cordialement
Stéphane