Articles

Utilisation avancée des scripts VBS dans Power AMC : construction d’un dictionnaire de données sous Excel

Dernier script vbs sous Power AMC proposé, la construction d’un dictionaire Power AMC à partir des fichiers modèles physiques (*.mpd) de Power AMC. Le dictionnaire ainsi construit est très complet, il comprend la description de toutes les tables, et toutes les colonnes des modèles, avec leurs définitions, formats, et les jointures (ou foreign key) sont également de la partie.

Une fois construit, la puissance de navigation d’Excel, avec les filtres automatiques (positionnés automatiquement par le script) permet une utilisation très efficace du dictionnaire de données, bien plus que sur un intranet par exemple.

Voici le code du script :

'******************************************************************************
'* Fichier: Export_repertoire_contenant_mpd_vers_excel.vbs
'******************************************************************************
Option Explicit
'SAISIE DU REPERTOIRE A ANALYSER
Dim repertoire
repertoire = InputBox("Veuillez saisir le répertoire contenant les fichiers *.mpd", "Répertoire")
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Erreur
Erreur = False
If FSO.FolderExists(repertoire) = False Then
Erreur = True
End If
 
 
If Erreur = False then
ShowMode = True
InteractiveMode = im_Batch
 
 
'CREATION INITIALISATION FICHIER EXCEL
Dim nb, i
Dim XLS_APP
Set XLS_APP = CreateObject("Excel.Application")
XLS_APP.Visible = True
XLS_APP.Application.ScreenUpdating = False
XLS_APP.DisplayAlerts = False
XLS_APP.Workbooks.Add
Dim XLS
Set XLS = XLS_APP.ActiveWorkbook
For i = 1 to 2
XLS.sheets.Add
Next
 
 
XLS.sheets(1).name = "tables"
XLS.sheets(2).name = "colonnes"
XLS.sheets(3).name = "references"
nb = XLS.Sheets.Count
For i = 4 To (nb)
XLS.Sheets(4).Delete
Next
Dim colonnes, tables, references
Set tables = XLS.Sheets("tables")
Set colonnes = XLS.Sheets("colonnes")
Set references = XLS.Sheets("references")
 
 
tables.Cells.ClearContents
tables.Cells(1, 1).Value = "Fichier"
tables.Cells(1, 2).Value = "Modele"
tables.Cells(1, 3).Value = "Name"
tables.Cells(1, 4).Value = "Code"
tables.Cells(1, 5).Value = "Parent"
tables.Cells(1, 6).Value = "DisplayName"
tables.Cells(1, 7).Value = "ObjectType"
tables.Cells(1, 8).Value = "Comment"
tables.Cells(1, 9).Value = "Description"
 
 
colonnes.Cells.ClearContents
colonnes.Cells(1, 1).Value = "Fichier"
colonnes.Cells(1, 2).Value = "Modele"
colonnes.Cells(1, 3).Value = "Table Code"
colonnes.Cells(1, 4).Value = "Table Name"
colonnes.Cells(1, 5).Value = "Code"
colonnes.Cells(1, 6).Value = "Name"
colonnes.Cells(1, 7).Value = "Format"
colonnes.Cells(1, 8).Value = "Clé"
colonnes.Cells(1, 9).Value = "Description"
 
 
references.Cells.ClearContents
references.Cells(1, 1).Value = "Reference"
references.Cells(1, 2).Value = "Table enfant"
references.Cells(1, 3).Value = "Table parent"
references.Cells(1, 4).Value = "Jointure"
 
 
'LECTURE DES FICHIERS DU REPERTOIRE
Dim FSOrep
Set FSOrep = FSO.GetFolder(repertoire)
Dim file
Dim package
Dim packages
Dim ligne_table
ligne_table = 2
Dim ligne_colonne
ligne_colonne = 2
Dim ligne_reference
ligne_reference = 2
dim Model
 
 
'ON BALAYE LES FICHIERS DU REPERTOIRE ET ON OUVRE LE MODELE
For Each file In FSOrep.files
OpenModel File.Path
Dim modele
Set modele = ActiveDiagram.Parent
LISTE_OBJETS (modele)
modele.Close
Next
 
 
'MISE EN FORME DU FICHIER EXCEL
Dim feuille
For Each feuille in XLS.Sheets
feuille.Select
With feuille.Rows("1:1").Interior
.Pattern = 1
.PatternColorIndex = -4105
.ThemeColor = 10
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With feuille.Rows("1:1").Font
.ThemeColor = 1
.TintAndShade = 0
End With
feuille.Rows("1:1").Font.Bold = True
feuille.Rows("1:1").AutoFilter
With XLS_APP.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
XLS_APP.ActiveWindow.FreezePanes = True
XLS_APP.Cells.Select
XLS_APP.Cells.EntireColumn.AutoFit
Next
XLS_APP.Application.ScreenUpdating = True
Dim NomFichier, NomCourt
NomCourt = "export_repertoire_mpd_excel.xls"
NomFichier = XLS_APP.GetSaveAsFileName(NomCourt)
If NomFichier <> False then
XLS_APP.ActiveWorkBook.SaveAs NomFichier
End If
Else
MsgBox("Erreur de saisie répertoire")
End if
 
 
Sub LISTE_OBJETS (modele)
Dim objet
Dim colonne
For Each objet In modele.children
If objet.ObjectType = "Table" then
tables.Cells(ligne_table,1).Value = File.Name
tables.Cells(ligne_table,2).Value = modele.Name
tables.Cells(ligne_table,3).Value = objet.Name
tables.Cells(ligne_table,4).Value = objet.Code
tables.Cells(ligne_table,5).Value = objet.Parent.Name
tables.Cells(ligne_table,6).Value = objet.DisplayName
tables.Cells(ligne_table,7).Value = objet.ObjectType
tables.Cells(ligne_table,8).Value = objet.Comment
tables.Cells(ligne_table,9).Value = Rtf2Ascii(objet.Description)
ligne_table= ligne_table + 1
For each colonne in objet.Columns
colonnes.Cells(ligne_colonne, 1).Value = File.Name
colonnes.Cells(ligne_colonne, 2).Value = modele.Name
colonnes.Cells(ligne_colonne, 3).Value = objet.Code
colonnes.Cells(ligne_colonne, 4).Value = objet.Name
colonnes.Cells(ligne_colonne, 5).Value = colonne.Code
colonnes.Cells(ligne_colonne, 6).Value = colonne.Name
colonnes.Cells(ligne_colonne, 7).Value = colonne.DataType
colonnes.Cells(ligne_colonne, 8).Value = colonne.Primary
colonnes.Cells(ligne_colonne, 9).Value = Rtf2Ascii(colonne.Description)
ligne_colonne = ligne_colonne + 1
next
End if
If objet.ObjectType = "Reference" then
On Error Resume Next
references.Cells(ligne_reference, 1).Value = objet.Name
references.Cells(ligne_reference, 2).Value = objet.ChildTable.Code
references.Cells(ligne_reference, 3).Value = objet.ParentTable.Code
references.Cells(ligne_reference, 4).Value = objet.JoinExpression
ligne_reference = ligne_reference + 1
End if
Next
'EXPLORATION DES SOUS-PACKAGES
Dim sous_modele
For Each sous_modele In modele.Packages
LISTE_OBJETS (sous_modele)
Next
End Sub
Top

Laisser un commentaire

Required fields are marked *.


 

Top

Contactez-nous contact@expert-data.fr

EXPERT data, solutions pour TPE/PME et grands comptes