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
| 'Nécessite la DLL tlbinf32.dll
' fournie avec Visual Studio ou certaines version de Office
'Ajoutez la référence : TypeLib Information (c:\windows\system32\TLBINF32.DLL)
'inspiré de http://officesystemaccess.seneque.net/vba/tableconstantes.htm
Option Explicit
Dim fName As String
Dim TLInfo As TypeLibInfo
Dim CSTInfo As ConstantInfo
Dim MbrInfo As MemberInfo
Dim Db As Workbook
Dim tblDef As Worksheet
Public Sub getTLInfo()
On Error Resume Next
Set Db = ActiveWorkbook
Dim NomDefault
NomDefault = Application.Path & "\*.olb"
choix:
'sous programme : http://excel.developpez.com/faq/?page=FenetresExcel#FileDialog
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boîte de dialogue
.Title = "Choix de la librairie"
'Autorise la multi-sélection
.AllowMultiSelect = False
'Définit un nom de fichier par défaut
.InitialFileName = NomDefault
'Efface les filtres existants.
.Filters.Clear
'Définit une liste de filtres pour le champ "Type de fichiers".
.Filters.Add "Librairie(*.olb)", "*.olb"
.FilterIndex = 1
'Indique le type d'affichage dans la boîte de dialogue
.InitialView = msoFileDialogViewList
'Affiche la boîte de dialogue
.Show
fName = .SelectedItems(1)
End With
If fName = "" Then GoTo choix
Dim tableName
tableName = Right(fName, Len(fName) - InStrRev(fName, "\", -1, vbTextCompare))
If Db.Worksheets(tableName).Name = tableName Then
If Err <> 0 Then Db.Worksheets.Add after:=Db.Worksheets(1)
ActiveSheet.Name = tableName
Err.Clear
Db.Worksheets(tableName).cells.Clear
End If
Set tblDef = Db.Worksheets(tableName)
tblDef.Range("a1:D1").Font.Bold = True
tblDef.Range("a1").Value = "CONST_CONSTANTE"
tblDef.Range("B1").Value = "CONST_MEMBRE"
tblDef.Range("C1").Value = "CONST_VALEUR"
tblDef.Range("D1").Value = "DECLARATION"
Dim Ligne
Ligne = 2
Set TLInfo = TypeLibInfoFromFile(fName)
For Each CSTInfo In TLInfo.Constants
For Each MbrInfo In CSTInfo.Members
tblDef.Cells(Ligne, 1).Value = CSTInfo.Name
tblDef.Cells(Ligne, 2).Value = MbrInfo.Name
tblDef.Cells(Ligne, 3).Value = MbrInfo.Value
tblDef.Cells(Ligne, 4).Value = "Public Const " & MbrInfo.Name & "=" & MbrInfo.Value
Ligne = Ligne + 1
Next MbrInfo
Next CSTInfo
Cells.Columns.AutoFit
Set TLInfo = Nothing
Set CSTInfo = Nothing
Set MbrInfo = Nothing
MsgBox "terminé"
End Sub |
Partager