Discussion :

[marot_r]

Bonjour à tous.

Récement j'ai développé une application avec pas mal de tables. Je me suis encore retrouvé face au vieux problème de l'abscence de zoom dans la fenètre des relations et j'ai eu une inspiration. Access n'offre pas de fonction de zoom mais Excel le fait donc une solution simple est de "copier" les relations dans Excel et de zoomer en Excel.

Voici comment j'ai procédé :

Récupérer les informations sur la disposition des tables dans la fenêtre de relation via le code situé ici :

http://www.lebans.com/saverelationshipview.htm choix A2KSave-Restore-ModifyRelationshipWindow.zip

La seule adaptation que j'ai du faire au formulaire est de changer le nom de la fenêtre de "Relationship" à "Relations" car mon Access est en français.

Grace à ce code on obtient une table qui donne la position de chacune des tables.

En me basant sur cette table j'ai créé le code suivant qui génère un fichier Excel avec un textBox par table et des traits qui les relient.

Ce code n'est pas parfait et en voici les limites :

• Il n'indique pas les clefs primaire en gras.
• Les jointures sont faites de table à table avec un seul trait sans pointer sur les champs concernés.
• Il n'indique pas les cardinalités des relations.
  J'ai triché en utilisant une flèche : le côté sans flèche est 1, le côté avec flèche devrait être N en supposant que la relation 1 à N a bien été créée en partant de la table 1 et en allant vers la table N.
  Si c'est une relation 1 à il y aura quand même une flèche.
• Il ne gère pas des autojointures de plus d'une table.
• Les TextBoxs sont trop grands pour le texte qu'on a y mettre.
• Il n'a été utilisé qu'avec Access 2007 et Excel 2003.

Voici le code

Code :

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

1
2
Option Compare Database
Option Explicit

Code :

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

1
2
3
4
5
6
7
8
9
Private Const msoTextOrientationHorizontal As Long = 1
Private Const msoArrowheadNone As Long = 1
Private Const msoArrowheadTriangle As Long = 2
 
Private Enum MsoConnectorType
    msoConnectorCurve = 3
    msoConnectorElbow = 2
    msoConnectorStraight = 1
End Enum

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
Private Sub CreerExcel()
    'Ne gère pas plus d'une auto-jointure par table
    Dim db As DAO.Database: Set db = CurrentDb
    Dim r As DAO.Recordset: Set r = db.OpenRecordset("select * from tblRelationshipViews order by x, y", dbOpenDynaset) 'Force la création à commencer par en haut et à gauche
    Dim t As DAO.TableDef
    Dim f As DAO.Field
    Dim listeChamp As String
 
    Dim xls As Object: Set xls = CreateObject("Excel.Application") 'Excel
    xls.Visible = True
    Dim ws As Object: Set ws = xls.Workbooks.Add 'Excel Workbook
    Dim s As Object: Set s = ws.worksheets(1) 'Excel Worksheet
    Dim shp As Object 'Excel Shape
 
    Dim X As Long
    Dim Y As Long
    Dim h As Long 'hauteur
    Dim w As Long 'largeur
 
    Dim offsetX As Long: offsetX = DMin("X", "tblRelationshipViews")
    Dim offsetY As Long: offsetY = DMin("Y", "tblRelationshipViews")
 
    If offsetX < 0 Then
        offsetX = Abs(offsetX) 'il y a des coordonnées négatives
    End If
 
    If offsetY < 0 Then
        offsetY = Abs(offsetY) 'il y a des coordonnées négatives
    End If
 
    Do While Not r.EOF
        X = r![X] + offsetX + 10
        Y = r![Y] + offsetY + 10
        w = (r![X1] + offsetX) - (r![X] + offsetX)
        h = (r![Y1] + offsetY) - (r![Y] + offsetY)
 
        If Not r![WinName] Like "*_?" Then
                Set t = db.TableDefs(r![WinName])
            Else
                Set t = db.TableDefs(Left(r![WinName], InStr(r![WinName], "_") - 1))
        End If
 
        listeChamp = r![WinName]
 
        For Each f In t.Fields
            listeChamp = listeChamp & vbLf
            listeChamp = listeChamp & f.Name
        Next f
 
        Set shp = s.Shapes.AddTextBox(msoTextOrientationHorizontal, X, Y, w, h)
        shp.TextFrame.Characters.Text = listeChamp
        shp.TextFrame.Characters(1, Len(r![WinName])).Font.Underline = True
 
        shp.Name = r![WinName]
 
        r.MoveNext: DoEvents
    Loop
 
    Dim shp1 As Object
    Dim shp2 As Object
 
    Dim uneRelation As Relation: For Each uneRelation In db.Relations
        Debug.Print uneRelation.Name, uneRelation.Table, uneRelation.ForeignTable
 
        Set shp1 = s.Shapes(uneRelation.Table)
        Set shp2 = s.Shapes(uneRelation.ForeignTable)
 
        If uneRelation.Table = uneRelation.ForeignTable Then
            Set shp2 = s.Shapes(uneRelation.ForeignTable & "_1") 'Attention si plus d'une auto-relation, çela ne fonctionnera pas
        End If
 
        Call AddConnectorBetweenShapes(xls, s, msoConnectorStraight, shp1, shp2)
    Next uneRelation
 
    Set shp1 = Nothing
    Set shp2 = Nothing
 
    Set s = Nothing
    Call ws.SaveAs(CurrentProject.Path & "\Relation")
    ws.Close: Set ws = Nothing
    xls.Quit: Set xls = Nothing
    r.Close: Set r = Nothing
    db.Close: Set db = Nothing
End Sub

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
Private Function AddConnectorBetweenShapes( _
         prmExcel As Object, _
         prmFeuille As Object, _
         prmConnectorType As MsoConnectorType, _
         prmBeginShape As Object, prmEndShape As Object) As Object
'Basé sur du code trouvé ici : http://peltiertech.com/programming-excel-2007-2010-autoshapes-with-vba/
    Const TOP_SIDE As Integer = 1
    Const BOTTOM_SIDE As Integer = 3
    Dim oConnector As Object
    Dim X1 As Single
    Dim x2 As Single
    Dim Y1 As Single
    Dim y2 As Single
 
    With prmBeginShape
        X1 = .Left + .Width / 2
        Y1 = .Top + .Height
    End With
 
    With prmEndShape
        x2 = .Left + .Width / 2
        y2 = .Top
    End With
 
    If Val(prmExcel.Version) < 12 Then
        x2 = x2 - X1
        y2 = y2 - Y1
    End If
 
    Set oConnector = prmFeuille.Shapes.AddConnector(prmConnectorType, X1, Y1, x2, y2)
    oConnector.ConnectorFormat.BeginConnect prmBeginShape, BOTTOM_SIDE
    oConnector.ConnectorFormat.EndConnect prmEndShape, TOP_SIDE
    oConnector.Line.BeginArrowheadStyle = msoArrowheadNone
    oConnector.Line.EndArrowheadStyle = msoArrowheadTriangle
    oConnector.RerouteConnections
 
    Set AddConnectorBetweenShapes = oConnector
 
    Set oConnector = Nothing
End Function

Les améliorations les plus imporantes à apporter sont d'après moi :

• Indiquer proprement les cardinalités.
  Se baser sur le sens de la création de la relation n'est pas fiable.
• Faire pointer les traits qui matérialisent les relations sur les champs qu'elles utilisent.

Si quelqu'un est tenté.

A+

[loufab]

Bon ! C'est quand que tu nous fait un super complément avec tous tes supers outils ?!!!

Bravo ! Excellent... c'est vrai qu'il y pas mal de chose qui manque pour les gros dev. Tant dans le VBE que pour la gestion de version ou pour des outils usuels comme celui dont tu nous fait bénéficier. Avec le 64bits on se retrouve en plus amputé de MZ Tools et Smart indenter. Il va falloir que MS fasse quelque chose pour ça !