Exporting data to a graph-like diagram as a family tree

[ksor]

I have made my own system in Access for my genealogic research.



Originaly I planned using Excel SmartArt for making Family trees - but it's way too slow when 100+ nodes

AND

It's a challenge to find an algorythm for generating such a tree structure showing Father & Mother and their children for many instances of families.

I then found some links to GRAPH-database called Neo4j, but unfortunately too old and a little tricky because it used CVS-files imported in Excel, some calculations in Excel and then importing in Neo4j - simply too much for generating a Family tree.

I remember once seeing some MS product Graph-DB but is it still a running product stable enough to use in this case ?

Have you any experience programming VBA into Neo4j by some API or some king of "automation-link" ?

Please - give me some advice here !

[ranman256]

i think Visio can do this too. You submit it a datasheet and it will build the tree.
I liked it.

[ksor]

If I had Visio I would prefere to dump the data by some "automation" or so ... but I don't have Visio ;-((

But ofcause I would prefere a MS-product instead of some 3-partySW

[ranman256]

Visio IS a microsoft product.

[ksor]

Visio IS a microsoft product.

I know ... that's why I just says I would prefere it

[June7]

Found Visio on Amazon selling for $45.99. But it's a download only. This is not an endorsement, I haven't tried it, just saying it may be out there somewhere at a reasonable cost.

[ksor]

Found Visio on Amazon selling for $45.99. But it's a download only. This is not an endorsement, I haven't tried it, just saying it may be out there somewhere at a reasonable cost.

Yeah, but I don't know if it can do the job and how fast i will do it when 100+ nodes are there ;-((

[Micron]

If you Google, it you might find this https://blogs.technet.microsoft.com/...ge-with-visio/ and similar references. I got 130,000 results and pretty much stopped at that one. It looks promising if you have Visio and Excel and the writer provides some detail as to the struggle experienced beforehand. Such a search might help you decide whether or not Visio would be worth the money. I have version 2007 and use it for practically every new woodworking project I start. There are better options for that it seems, but I haven't coerced myself into learning Sketchup.

In case you're wondering about the MasterShape spreadsheet column in that post, Visio comes with a set of stencils, so I figure you just have to decide which shapes you'd want to use and enter their names. If you want to try it I would be willing to attempt to dump your spreadsheet into Visio and see what happens, but I can't promise to spend a lot of time trouble shooting or formatting it. If it works, it would simply aid in your Visio purchase decision.

[orange]

Neo4J is not a graphing package such as Visio or Dia.

You might find some free Family Tree maker software. I found this via Google, but have not used it nor reviewed it.
Here is another.

Gedcom is a format used by many Genealogy related programs.

I found this forum via Google --seems to have a variety of info/questions/posts about different products (not necessarily free).


You are really looking for something that can import data from some file/format structure (csv, text, .[gedcom], ..other) and has the ability to produce a graph/report/chart.

Good luck with your project.

[ksor]

I know all these programs but I already HAVE the most of what they can = my own, more simple, more strait forward Access system integrating Access/Word.

I even have some macros that can generate nodes in Excel graph - but the hard challenge to organize the graph so it looks "nice" - that's the problem I need solved.

So a SIMPLE module taking some simple data in and outputing a family tree ... that's what I need.

[orange]

Can you show us some of the code and data of what you have? And what you're getting with Excel that isn't as pretty as you would like? Readers may have some ideas/advice if they can see what you are working with.

[ksor]

Can you show us some of the code and data of what you have? And what you're getting with Excel that isn't as pretty as you would like? Readers may have some ideas/advice if they can see what you are working with.

I see two paths to solve my problem:

1) find that "3-party simple now unknown module" that can take in some data and produce the tree I want !
2) I have to figure out a algorithm that can organize my nodes in Excel so they look "nice" !

If 1) was avable that would be nice and easy but NOT as these programs already show in the earlier postings ;-((


Solution 2) has nothing to do with coding in the first place - it's just some words leading to - maybe a recursive - method that can ensure a flat graph with no - or at least as few as possible - crossing arrows in the end ;-))

Most of the family trees I've found take the easy solution and is NOT showing nodes for BOTH mother AND father - that's a major request for me.

I just generate a reactangles with an ID and some data for each person, move and connect them with simple code, shown here:

Option Explicit
Dim myShape As Excel.Shape
Dim Conn As Shape
    Public Type TopLeft
        Y As Long
        X As Long
    End Type

' light blur for male and light red for female
Const Mcolor = 16758883             'RGB(99, 184, 255)
Const Kcolor = 12957183             'RGB(255, 181, 197)
Const Ucolor = 10025880             'RGB(152, 251, 152)
Const ParSammen = ColorConstants.vbGreen
Const ParSkilt = ColorConstants.vbRed

' sizes for the node-shapes
Const Pbredde = 250
Const Phøjde = 50
Const W3kant = 45
Const H3kant = 38.9711431702997
Public Sub danPar(Id1 As Long, Id2 As Long)
    'Connect Id1 and Id2, move Id2 if necessary
    setSammeTop Id1, Id2: setSammeLeft Id1, Id2
    flytShape Trim(Str(Id2)), 1, "R"
    make3kant Id1, Id2, "G"
End Sub
Public Function getXY(ID As Long) As TopLeft
    ' return (Left,Top) as (X,Y) for ID
    Dim tl As TopLeft
    If Excel.ActiveSheet.Shapes.Count > 0 Then
        Excel.ActiveSheet.Shapes(Trim(Str(ID))).Select
        tl.X = Excel.Selection.left
        tl.Y = Excel.Selection.top
        getXY = tl
    End If
End Function

Public Sub setSammeTop(Id1 As Long, Id2 As Long)
    ' make Top for Id2 = Top for Id1
    Dim tl As TopLeft
    If Excel.ActiveSheet.Shapes.Count > 0 Then
        tl = getXY(Id1)
        Excel.ActiveSheet.Shapes(Trim(Str(Id2))).Select
        Excel.Selection.top = tl.Y
    End If
End Sub

Public Sub setSammeLeft(Id1 As Long, Id2 As Long)
    ' make Left for Id2 = Left for Id1
    Dim tl As TopLeft
    If Excel.ActiveSheet.Shapes.Count > 0 Then
        tl = getXY(Id1)
        Excel.ActiveSheet.Shapes(Trim(Str(Id2))).Select
        Excel.Selection.left = tl.X
    End If
End Sub

Public Sub visEnPerson(ID As Long, MK As String, Navn As String, Fdato As String, FSted As String, Ddato As String, DSted As String)
    ' Show a person with some data in a box
    makeBox ID, MK
    With myShape.TextFrame
        .Characters.Font.Color = vbBlack
        .Characters.Text = ID & " " & Navn & vbCrLf & _
                           "Født: " & Fdato & " " & FSted & vbCrLf & _
                           "Død : " & Ddato & " " & DSted
        .Characters(1, Len(ID & " " & Navn)).Font.Bold = True
    End With
End Sub

Public Sub make3kant(PId1 As Long, PId2 As Long, RGcolor As String)
    ' Make a triangle
    ' Tegner en 3kant med farve RGColor lige under PId2 (= moderen).
    ' Lidt nedrykket og med sort ramme
    ' Hvis PId1 allerede indgår i et andet forhold, tegnes en 3kant med
    ' farve RGColor lige under PId2 (= moderen) - ydeligere nedrykket
    Dim left As Long, top As Long
    ' left = ved venstre kan af PId2
    left = getXY(PId2).X - W3kant / 2           ' lige midt imellem = (getXY(PId1).X + getXY(PId2).X) / 2 + Pbredde / 2 - W3kant / 2
    ' top = 1,5 personhøjde under - Id1 og Id2 forudsættes på samme niveau
    ' men hvis PId1 allerede ingår i et forhold - flyttes 1,5 persomhøjde mere ned
    top = getXY(PId1).Y + Phøjde * 1.5
    setSammeTop PId1, PId2
    Set myShape = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, left, top, W3kant, H3kant)
    With myShape
        .Line.ForeColor.RGB = RGB(0, 0, 0) ' rammefarve
        .Line.Weight = 2                   ' rammetykkelse
        If RGcolor = "R" Then              'Fyldfarve
            .Fill.ForeColor.RGB = ParSkilt
        Else: .Fill.ForeColor.RGB = ParSammen
        End If
        .Name = PId1 & "+" & PId2
    End With
    setArrowsOn PId1, PId2
    Set myShape = Nothing
End Sub
Public Sub setArrowsOn(PId1 As Long, PId2 As Long)
    ' Connect PId1 and PId2 and triangle named PId1+PId2 with arrows
    Set Conn = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100)
    With Conn
        .Line.EndArrowheadStyle = msoArrowheadOpen
        .ConnectorFormat.BeginConnect ActiveSheet.Shapes(Trim(Str(PId1))), 3
        .ConnectorFormat.EndConnect ActiveSheet.Shapes(PId1 & "+" & PId2), 2
    End With
    Set Conn = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100)
    With Conn
        .Line.EndArrowheadStyle = msoArrowheadOpen
        .ConnectorFormat.BeginConnect ActiveSheet.Shapes(Trim(Str(PId2))), 3
        .ConnectorFormat.EndConnect ActiveSheet.Shapes(PId1 & "+" & PId2), 6
    End With
    Set Conn = Nothing
End Sub

Public Sub arrowToChild(PId1 As Long, PId2 As Long, PIdC As Long)
    ' Connects triangle for parents PId1+PId2 with child PIdC
    Set Conn = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100)
    With Conn
        .Line.EndArrowheadStyle = msoArrowheadOpen
        .ConnectorFormat.BeginConnect ActiveSheet.Shapes(PId1 & "+" & PId2), 4
        .ConnectorFormat.EndConnect ActiveSheet.Shapes(Trim(Str(PIdC))), 2
    End With
    Set Conn = Nothing
End Sub

Public Sub makeBox(PId As Long, MK As String)
    ' Makes a rectangle in sex color
    ' Tegner en personbox med farve efter køn og sort ramme
    ' M/m giver lyseblå, K/k giver lyserød baggrundsfarve
    Set myShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, Pbredde, Phøjde)
    With myShape
        ' rammefarve
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        ' rammetykkelse
        .Line.Weight = 2
        If MK = "M" Or MK = "m" Then
            .Fill.ForeColor.RGB = Mcolor 'RGB(202, 225, 255)
        Else
            .Fill.ForeColor.RGB = Kcolor 'RGB(255, 230, 255)
        End If
        .Name = PId
    End With
End Sub

Public Sub flytShape(Navn As String, ant As Long, LRUD As String)
    'Moves shape named Navn some units LRUD = Left right Up Down
    ' Flytter shapen med NAVNET Navn (ikke Id'en) et ant
    ' Left/Right (generationer) eller Up/down (personer)
    ActiveSheet.Shapes(Navn).Select
    Select Case LRUD
        Case "l", "L"
            Excel.Selection.left = Excel.Selection.left - 300 * ant
        Case "r", "R"
            Excel.Selection.left = Excel.Selection.left + 300 * ant
        Case "d", "D"
            Excel.Selection.top = Excel.Selection.top + 70 * ant
        Case "u", "U"
            Excel.Selection.top = Excel.Selection.top - 70 * ant
    End Select
End Sub

Public Sub insertSpace()
    Rows("1:5").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'    Columns("A:A").Select
'    Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
End Sub

The tree shown in the attached file is VERY SMALL and made manually with the macros in the intermediate window - the ID's is in the upper left corner of the rectangles and the triangles have just the ID's from the parents with a + in between.

BUT ...

I just need an ALGORYTHM not some code ;-))

[orange]

I am not an Excel person, so can not offer advice on that aspect.
I did some more searching re MS Access and the only link I really found was from about 2010 and was about using MS Access and ODBC to SQLLite to interface with RootsMagic which doesn't seem very helpful.

You have done a lot of work and there may be Excel-experienced readers that could offer help.
Paul Kelly has many free webinars and articles on Excel. He offers a selection of Excel applications for a fee. I have no idea if he can assist/advise/respond to questions, but he has questions/answer session at the end of webinars.

UPDATE:
Sounds like Visio could be a viable option.
I also found this link for free software products that have Visio like features (but not all) --I have not tried any of these, nor am I associated with any of these.