Bonjour,
Lorsque l'on fait du Late Binding, on peut rencontrer des erreurs du fait des constantes qui ne sont pas connues.
En gras ci-dessous les erreurs, dé-commentez Option explicit et compilez pour vous en assurer.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 'early binding dim oApp as Word.application set oApp = word.application
lire early ou late binding
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 'Option Explicit Sub LateBinding_ConstantesAbsentes() Dim oApp As Object Set oApp = CreateObject("Word.Application") oApp.Visible = True oApp.documents.Add oApp.Selection.TypeText Text:="Je devrais être en orange" oApp.Selection.HomeKey Unit:=5, Extend:=1 With oApp.Selection.Font .Name = "Tahoma" .Size = 20 .Underline = wdUnderlineDouble .UnderlineColor = wdColorBlue .Color = wdColorOrange .Animation = wdAnimationLasVegasLights End With End Sub
Voici un code pour récupérer une énumération des constantes.
Cela nécessite la DLL tlbinf32.dll,fournie avec Visual Studio ou certaines versions de Office.
(j'utilise une version du 22/02/2004 CHECKSUM MD5= 62CC2C6B200D995791ACFC527CA4CC58)
vous n'avez plus qu'à coller les lignes de la colonne D dans un nouveau module de votre projet.
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 '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
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 'on peut toutes les mettre bien sûr Public Const wdUnderlineDouble = 3 Public Const wdColorBlue = 16711680 Public Const wdColorOrange = 26367 Public Const wdAnimationLasVegasLights = 1 'etc...
Partager