Generation d'un script (vb word) de creation de base

ce script par d'un format précis des tables dans le doc :
-chaque table est dans un tableau
le tableau est comme suit : - ligne 1 : nom de la table en col 2, comment en col 3
ligne suivantes : nom col en col 2, comment en col 3, 'O' en col 4 si obligatoire, 'PK' en col 5 si primary key,
' FK : ' suivi de la reference si FK en col 6 ou 'CK' suivi de la condition si Check, Type col en col 7 (V=varchar2,N=number, DATE pour DATE)

T	OBS_PLA	PLATEFORME LIEE A L’‘OBSERVATOIRE	O	PK	O/PK/FK	Taille
	OPL_COBS	Code observatoire référencé la table OBS		PK	FK : OBS ( OBS_COBS)	N(9)
	OPL_NOM	Nom plateforme		PK	CK : in ('A','B')	V(50)

Dim Gligne As Integer
Dim Gdoc As Integer


Sub SInsert(txt As String)
' insert le texte en fin de fichier
     With Application.Documents(Gdoc).Paragraphs(Gligne).Range
     .Text = Replace(txt, Chr(13), "")
     .InsertParagraphAfter
     End With
     Gligne = Gligne + 1
End Sub

Sub Commentaire(txt As String)
' insert un commentaire encadré de lignes de tirets
SInsert (String(80, "-"))
SInsert ("-- " & txt)
SInsert (String(80, "-"))
SInsert ("")
End Sub


Sub GenerationScriptSql()
'
' Génération du script de création de table
' Macro créée le 03/02/2010 par sgouzien
'
Dim objDoc As Document, Phrase As Range
Dim vTab As String
Dim vCons As String

Set objDoc = ActiveDocument
 
'création de 2 documents (un pour les tables EDIOS, l'autre pour les tables SDN)
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0

' preparation de l'entete du premier fichier
 Gdoc = 1
 Gligne = 1
 Commentaire ("Création des tables pour EDIOS - Généré le " & Date)
 
 ' boucle de génération des DROP
 For j = 1 To objDoc.Tables.Count
  Set objT = objDoc.Tables(j)
  If Mid(objT.Cell(1, 1), 1, 1) = "T" Then
    vTab = objT.Cell(1, 2)
    SInsert ("DROP TABLE " & vTab & " CASCADE CONSTRAINT;")
  End If
 Next
 
 ' boucle sur les tableaux du document
 For j = 1 To objDoc.Tables.Count
  Set objT = objDoc.Tables(j)
 
  'les tableaux concernant des tables sont identifiés par un "T" en (1,1)
  If Mid(objT.Cell(1, 1), 1, 1) = "T" Then
    vTab = objT.Cell(1, 2)
    vCons = "ALTER TABLE " & vTab & " ADD ( CONSTRAINT "
   
  ' fermeture du premier fichier et preparation de l'entete du second fichier
    If Mid(vTab, 1, 3) = "SDN" And Gdoc = 1 Then
        Documents(1).SaveAs FileName:="CreEdios.sql", FileFormat:=wdFormatText
        Gdoc = 2
        Gligne = 1
        Commentaire ("Création des tables Seadatanet pour EDIOS - Généré le " & Date)
    End If
   
    ' creation des tables
    Commentaire ("Table " & vTab & " - " & objT.Cell(1, 3))
    SInsert ("CREATE TABLE " & vTab & " (")
    For i = 2 To objT.Rows.Count
       Select Case Mid(objT.Cell(i, 7), 1, 1)
       Case "V"
            taille = "VARCHAR2" & Mid(objT.Cell(i, 7), 2)
       Case "N"
            taille = "NUMBER" & Mid(objT.Cell(i, 7), 2)
       Case "D"
            taille = "DATE"
       End Select
       If i = objT.Rows.Count Then
         SInsert (objT.Cell(i, 2) & " " & taille)
       Else
         SInsert (objT.Cell(i, 2) & " " & taille & ",")
       End If
    Next
    SInsert (");")
    SInsert ("")
   
    ' creation des Index et contraintes
    Commentaire ("Index et contraintes sur " & vTab)
    For i = 2 To objT.Rows.Count
   
    ' creation des PRIMARY KEY
      If Mid(objT.Cell(i, 5), 1, 2) = "PK" Then
        If i = 2 Then
          SInsert (vCons)
          SInsert ("PK_" & vTab & " PRIMARY KEY (" & objT.Cell(i, 2))
          If Mid(objT.Cell(i + 1, 5), 1, 2) = "PK" Then
            SInsert (",")
          Else
            SInsert ("));")
          End If
        Else
            SInsert (objT.Cell(i, 2))
            If i = objT.Rows.Count Then
              SInsert ("));")
            ElseIf Mid(objT.Cell(i + 1, 5), 1, 2) = "PK" Then
              SInsert (",")
            Else
              SInsert ("));")
          End If
        End If
      End If
    Next
    SInsert ("")
    ' creation des CHECK CONSTRAINTES (NULL)
    For i = 2 To objT.Rows.Count
      If Mid(objT.Cell(i, 4), 1, 1) = "O" Then
        SInsert (vCons)
        SInsert ("CK_" & objT.Cell(i, 2) & "_O CHECK (")
        SInsert (objT.Cell(i, 2)) & " IS NOT NULL ));"
        SInsert ("")
      End If
    ' creation des CHECK CONSTRAINTES (AUTRE)
      If Mid(objT.Cell(i, 6), 1, 2) = "CK" Then
        SInsert (vCons)
        SInsert ("CK_" & objT.Cell(i, 2) & " CHECK (")
        SInsert (objT.Cell(i, 2) & " " & Mid(objT.Cell(i, 6), 5) & "));")
        SInsert ("")
      End If
    Next
   
    ' creation des FOREIGN KEY
    For i = 2 To objT.Rows.Count
      If Mid(objT.Cell(i, 6), 1, 2) = "FK" Then
        SInsert (vCons)
        SInsert ("FK_" & objT.Cell(i, 2) & " FOREIGN KEY (" & objT.Cell(i, 2)) & ")"
        SInsert ("REFERENCES " & Mid(objT.Cell(i, 6), 5) & ");")
        SInsert ("")
      End If
    Next

    ' creation des Commentaires
    Commentaire ("Commentaires sur " & vTab)
    SInsert ("COMMENT ON TABLE " & vTab & " IS '" & objT.Cell(1, 3) & "';")
    For i = 2 To objT.Rows.Count
      SInsert ("COMMENT ON COLUMN  " & vTab & "." & objT.Cell(i, 2) & _
      " IS '" & objT.Cell(i, 3) & "';")
    Next
   
  End If
Next
'Set def off
Rem (Set def off permet de faire passer les " & " en caracteres normaux)


Documents(2).SaveAs FileName:="CreEdiosSdn.sql", FileFormat:=wdFormatText
MsgBox ("fini")

End Sub