Discussion :

[PierreE_67207]

Bonjour le forum,

J'espère que vous vous portez pour le mieux pendant cette dure période ! Le confinement est propice à l'amélioration de ses outils !

Et c'est pour cela justement que je vous contacte. Dans la procédure ci-dessus, le gestionnaire d'erreur "On Error Resume Next" sur la ligne 18 ne fonctionne pas (ou plus, car il a fonctionné !!), et le code plante sur la ligne juste en-dessous (ligne 20), dans les cas où la procédure événementielle "Worksheet_Change" n'existe pas... Je ne comprends pas pourquoi ! y aurait-il des référence à activer, et que j'aurais peut-être désactiver par erreur ?

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
Sub Insertion_Code_Alinéa_Automatique() '(Feuille As Worksheet)
 
    Dim Début As Long, Fin As Long, l As Long
    Dim Code_Existant As Boolean
    Dim x As String
 
    '-> Ajout de la référence " Microsoft Visual Basic for Applications Extensibility 5.3" nécessaire pour manipuler l'éditeur de macros Excel
    x = "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
    On Error GoTo Ligne_Suivante '-> Permet de traiter l'erreur générée dans le cas où la référence est déjà chargée
    ThisWorkbook.VBProject.References.AddFromFile x
Ligne_Suivante:
 
 
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        Début = 0
 
        '-> Pour traiter l'erreur générée dans le cas où la procédure "Worksheet_Change" n'existe pas
        On Error Resume Next
 
        Début = .ProcStartLine("Worksheet_Change", vbext_pk_Proc)
 
        On Error GoTo 0
 
        If Début = 0 Then   '-> La procédure "Worksheet_Change" n'existe pas
            Début = .CountOfLines
 
                .InsertLines Début + 1, ""
                .InsertLines Début + 2, "Private Sub Worksheet_Change(ByVal Target As Range)"
                .InsertLines Début + 3, ""
                .InsertLines Début + 4, "'-> Mise en forme automatique - énumération avec alinéa :"
                .InsertLines Début + 5, "    Application.Run " & """" & "PERSONAL.XLSB!Alinéa_automatique""" & ", Target, 2, 4, 6, , False"
                .InsertLines Début + 6, ""
                .InsertLines Début + 7, "End sub"
 
        Else                '-> La procédure "Worksheet_Change" existe
            Fin = Début + .ProcCountLines("Worksheet_Change", vbext_pk_Proc)
            Code_Existant = .Find("Application.Run " & """" & "PERSONAL.XLSB!Alinéa_automatique" & "", Début, 1, Fin, -1)
 
            If Code_Existant = False Then
                '   -> On recherche d'abord le numéro de ligne où est écrit "Private Sub Worksheet_Change", car la propriété "ProcCountLines" renvoie à la première ligne de la procédure,
                '      c'est-à-dire la ligne après le trait horizontal de fin de procédure précédente
                For l = Début To Fin
                    If .Find("Private Sub Worksheet_Change", Début, 1, Fin, -1) Then l = Début: Exit For
                Next l
 
                .InsertLines Début + 1, ""
                .InsertLines Début + 2, "'-> Mise en forme automatique - énumération avec alinéa :"
                .InsertLines Début + 3, "    Application.Run " & """" & "PERSONAL.XLSB!Alinéa_automatique""" & ", Target, 2, 4, 6, , False"
 
            End If
        End If
 
    End With
 
End Sub

Merci par avance pour vos retours !

PE

[Patrice740]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
    On Error GoTo Ligne_Suivante '-> Permet de traiter l'erreur générée dans le cas où la référence est déjà chargée
    ThisWorkbook.VBProject.References.AddFromFile x
Ligne_Suivante:

Il faudrait arrêter le gestionnaire précédent !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
    On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromFile x
    On Error GoTo 0

Et traiter le cas où elle n'existe pas.

EDIT : il est préférable d'utiliser le GUID {0002E157-0000-0000-C000-000000000046} pour activer la référence.

[PierreE_67207]

Merci beaucoup Patrice740,

C'était exactement ça ! je n'avais pas fait le lien que le problème était survenu depuis l'ajout de ces lignes sur l'ajout de la référence... comme quoi c'est toujours utile d'avoir un regard extérieur, surtout quand on se focalise sur quelque chose qui n'est pas la source du problème

Je suis en intéressé par ta dernière remarque :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

EDIT : il est préférable d'utiliser le GUID {0002E157-0000-0000-C000-000000000046} pour activer la référence.

Peux-tu développer ou me renvoyer vers un post traitant du sujet ? je ne connais pas le "GUID".

Merci encore et bonne journée !

[Patrice740]

Re,

Un code pour lister les références du classeur actif et leurs propriétés :

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
Option Explicit
Option Private Module
Sub ListerRéferences()
' Liste les références du Projet
' 11/07/10  Patrice33740  V1-0-00
Const nomMsg$ = "Lister les références"
Const errWbk$ = "Ouvrir un classeur avant d'éxécuter cette commande."
Const errRef$ = "Ce classeur ne contient aucune reference."
Dim wbkCible As Excel.Workbook            'Classeur à examiner
Dim wbkRapport As Excel.Workbook          'Rapport
Dim cell As Excel.Range                   'Cellule rapport
Dim références As VBIDE.References        'Collection des références
Dim Référence As VBIDE.Reference          'Référence
 
  'Vérifier le classeur
  If Application.ActiveWorkbook Is Nothing Then
    MsgBox errWbk, vbCritical, nomMsg
    Exit Sub
  End If
  Set wbkCible = Application.ActiveWorkbook
  'Vérifier la collection de références
  Set références = wbkCible.VBProject.References
  If références Is Nothing Then
    MsgBox errRef, vbCritical, nomMsg
    Exit Sub
  End If
  'Ajouter le rapport
  Set wbkRapport = Application.Workbooks.Add(xlWBATWorksheet)
  Set cell = wbkRapport.Worksheets(1).Range("A1")
  cell.Offset(, 1).Formula = "Fichier"
  cell.Offset(1, 1).Formula = "Chemin"
  cell.Offset(, 2).Formula = wbkCible.Name
  cell.Offset(, 2).Font.Bold = True
  cell.Offset(1, 2).Formula = wbkCible.Path
  Set cell = cell.Offset(3)
  'Titres de colonne
  cell.Offset(, 0).Formula = "Name"
  cell.Offset(, 1).Formula = "IsBroken"
  cell.Offset(, 2).Formula = "FullPath"
  cell.Offset(, 3).Formula = "GUID"
  cell.Offset(, 4).Formula = "Minor"
  cell.Offset(, 5).Formula = "Major"
  cell.Offset(, 6).Formula = "BuiltIn"
  cell.Offset(, 7).Formula = "Description"
  cell.CurrentRegion.Font.Bold = True
  Set cell = cell.Offset(1)
  'Lister les propiétes des références
  For Each Référence In références
    On Error Resume Next
    cell.Offset(, 0).Formula = Référence.Name
    cell.Offset(, 1).Formula = Référence.IsBroken
    cell.Offset(, 2).Formula = Référence.FullPath
    cell.Offset(, 3).Formula = Référence.GUID
    cell.Offset(, 4).Formula = Référence.Minor
    cell.Offset(, 5).Formula = Référence.Major
    cell.Offset(, 6).Formula = Référence.BuiltIn
    cell.Offset(, 7).Formula = Référence.Description
    On Error GoTo 0
    Set cell = cell.Offset(1)
  Next Référence
  cell.CurrentRegion.EntireColumn.AutoFit
 
End Sub

Et pour ajouter une référence au classeur actif :

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
Sub AjoutRéférence()
'Exemple pour ajouter une référence
Dim Référence
  For Each Référence In ActiveWorkbook.VBProject.References
    If Référence.GUID = "{0002E157-0000-0000-C000-000000000046}" Then Exit Sub
  Next
  On Error GoTo fin
  ActiveWorkbook.VBProject.References.AddFromGuid _
    GUID:="{0002E157-0000-0000-C000-000000000046}", Major:=5, Minor:=0
Exit Sub
fin:
  On Error GoTo 0
  MsgBox "Impossible d'activer la référence" & vbLf & _
         "Microsoft Visual Basic for Applications Extensibility"
  End
End Sub