memoprog

Sub CREER_GRAPHIQUE()
' à partir d'un fichier à 5 colonnes
' ( 1 = identifiant serie,
'   2 = titre graphique,
'   3 = titre des abcisses,
'   4 = date,
'   5 = valeur)
' contenant n séries triées
' découpe les données par série, et pour chaque série :
' - copie les valeurs sur une nouvelle feuille
' - crée un graphique à partir de ces valeurs (avec le titre)
' - enregistre ce graphique au format pdf dans un répertoire donné
'   avec comme nom l'identifiant de la série
Dim WS As Worksheet
Dim i, k, l As Integer
Dim IdSerie As String

' k enregistre la ligne de début d'une série
k = 3

' WS est le feuille d'origine qui contient ttes les données
Set WS = ActiveWorkbook.ActiveSheet

' IdSerie contient la série en cours - permet de tester si on change de série
'
IdSerie = WS.Cells(2, 1)
' lecture de l'ensemble des données
' - préciser le nb de lignes et mettre FIN dans la dernière ligne du fichier
'   dans la 1ère col
'
For i = 3 To 17132
'
' sélection de la ligne
  WS.Rows(i).Select
'
' test du changement de série : dans ce cas il y a action
  If IdSerie <> WS.Cells(i, 1) Or WS.Cells(i, 1) = "FIN" Then
  '
  ' sélection des valeurs la série (col D et E)
  '
    Range("D" & k & ":E" & (i - 1)).Select
    WS.Range("D" & k & ":E" & (i - 1)).Copy
    ' ajout d'une feuille - nommée par l'id (col A)
    '
    Sheets.Add
    ActiveSheet.Name = IdSerie
    ' copie de la sélection
    ActiveSheet.Paste
    ' copie en ligne 1 des infos de titres
    WS.Range("A" & k & ":C" & k).Copy
    Selection.EntireRow.Insert
    '
    ' création et export du graphique en pdf
    '
    Charts.Add
    With ActiveChart
     .ChartType = xlLineMarkers
     .SetSourceData Source:=WS.Range("D" & k & ":E" & (i - 1)), PlotBy _
        :=xlColumns
        .Name = IdSerie & "_graph"
        .HasDataTable = False
        .HasTitle = True
        .ChartTitle.Characters.text = WS.Cells((i - 1), 2)
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.text = "date"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.text = WS.Cells((i - 1), 3)
        .Export Filename:="Q:\GRAPH\" & IdSerie & ".jpg", FilterName:="JPEG"
    End With
    ' mise à jour des variables pour la série suivante
    '
    k = i
    IdSerie = WS.Cells(i, 1)
    ' repositionnement sur la feuille initiale
    '
    WS.Activate
End If
Next
End Sub
'
'
'

select  'Alter '||OBJECT_TYPE||' '||OBJECT_NAME||' compile;'  from  user_objects
where  status ='INVALID' and LAST_DDL_TIME>sysdate-365 order by object_type desc;

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