PROBLEME Macro personnal.xlsb et WorkBook_Open

Bonjour,

Dans le cadre d'une macro qui doit ouvrir tous les liens d'un classeur lorsque celui ci viens d'être ouvert si il se trouve dans un chemin spécifique, je rencontre un problème à l'ouverture.

Lorsque j'ouvre directement un classeur cela fonctionne cependant lorsque j'ouvre excel vierge sans classeur d'ouvert il lance quand même la macro et m'affiche le message d'erreur 91"bloc with non défini" sur la ligne "Chemin = ActiveWorkbook.Path"

Cela me parait logique car aucun classeur n'est actif cependant la macro personnal.xlsb ne devrait pas se lancer.

Je cherche donc une solution à mon problème pour pas que la macro se lance à l'ouverture simple d'excel.

Voici le code de ThisWorkBook :

Public WithEvents AppX As Application
Private Sub Workbook_Open()
        Set AppX = Application
End Sub

Private Sub AppX_WorkbookOpen(ByVal wb As Workbook)
   Application.OnTime Now + TimeValue("00:00:05"), "Ouverture"
End Sub

Voici le code de la fonction qui est appelé :

Sub Ouverture()
    Dim ihyperLink As Hyperlink
    Dim wSh As Worksheet
    Dim Chemin As String, CheminValide As String
    Chemin = ActiveWorkbook.Path
    'MsgBox (Chemin)
    Chemin = Left(Chemin, 13)

    'MsgBox (Chemin)

    CheminValide = "T:\Métallerie"

    If Chemin = CheminValide Then
    MsgBox ("yes")
        For Each wSh In ActiveWorkbook.Worksheets
            For Each ihyperLink In wSh.Hyperlinks
                ihyperLink.Follow
            Next
        Next
    End If

End Sub

Cordialement,

UP

UP

bonjour,

Je suis toujours mal à l'aise avec les personnal.xlsb qu'on sème un peu n'importe ou...

Mettre la Sub Ouverture bien que crosoft ait rajouté cette possibilité

Personnellement j'utilise les xlam classique et dans ce cas en mettant la Sub ouverture dans un module standard de mon xlam et une gestion d'erreur ça fonctionne sans problème.

Sub Ouverture()
    Dim ihyperLink As Hyperlink
    Dim wSh As Worksheet
    Dim Chemin As String, CheminValide As String
    On Error GoTo GESTERR ' à rajouter
    Chemin = ActiveWorkbook.Path
    Chemin = Left(Chemin, 13)
CheminValide = "T:\Métallerie"    
    If Chemin = CheminValide Then
    MsgBox ("yes")
        For Each wSh In ActiveWorkbook.Worksheets
            For Each ihyperLink In wSh.Hyperlinks
                ihyperLink.Follow
            Next
        Next
    End If
Exit Sub ' à rajouter
GESTERR: ' à rajouter
End Sub

A+

Bonjour,

Utilises l'erreur pour sortir de la macro :

[code]
Sub Ouverture()
    Dim ihyperLink As Hyperlink
    Dim wSh As Worksheet
    Dim Chemin As String, CheminValide As String
    On Error GoTo ErrorHandler  ' Si erreur se rendre à ErrorHandler
    Chemin = ActiveWorkbook.Path
    'MsgBox (Chemin)
    Chemin = Left(Chemin, 13)

    'MsgBox (Chemin)

    CheminValide = "T:\Métallerie"

    If Chemin = CheminValide Then
    MsgBox ("yes")
        For Each wSh In ActiveWorkbook.Worksheets
            For Each ihyperLink In wSh.Hyperlinks
                ihyperLink.Follow
            Next
        Next
    End If

ErrorHandler:   ' Fin d'instruction Erreur sortir de la macro
Exit Sub 

End Sub

Bonjour Galopin

Même solution GESTERR ou ErrorHandler

Merci à vous pour vos réponse mais cependant j'ai déjà remédié à mon problème par une alternative qui permet de faire une deuxième vérification car j'avais les liens qui s'ouvraient 2 fois, voici le code :

Sub Ouverture()
    Static Ouvert As Boolean
    Dim ihyperLink As Hyperlink
    Dim wSh As Worksheet
    Dim Chemin As String, CheminValide As String

    If Not ActiveWorkbook Is Nothing Then
        If Not Ouvert Then
            Ouvert = True

            Chemin = ActiveWorkbook.Path
            'MsgBox (Chemin)

            Chemin = Left(Chemin, 13)
            'MsgBox (Chemin)
            CheminValide = "T:\Métallerie"

            If Chemin = CheminValide Then
                'MsgBox ("yes")
                For Each wSh In ActiveWorkbook.Worksheets
                    For Each ihyperLink In wSh.Hyperlinks
                        ihyperLink.Follow
                    Next
                Next
            End If

        Else
          Ouvert = False
        End If
    End If

End Sub

Sujet résolu !