Not Application.Intersect + Hyperlinks : erreur 1004

[benjaminxls]

Bonjour à tous !

J'ai trouvé beaucoup de solutions en naviguant sur ce forum mais là je sèche pour mon projet de bons de commande avec archivage.

J'arrive vers la fin mais l'ajout d'une ligne de code pour ajouter un lien hypertexte (pour ouvrir ultérieurement le fichier PDF exporté) dans l'onglet "Archivage" :

Sub CommandButton_commande_Click()

...

'archiver commande
    Sheets("Archivage").Select
    ActiveSheet.Unprotect
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Sheets("Archivage").Range("A2").Value = Sheets("Bon de commande").Range("T2").Value
    MsgBox (filename_bc)
    Sheets("Archivage").Hyperlinks.Add Anchor:=Sheets("Archivage").Range("A2"), Address:=filename_bc 'L'AJOUT SEULE DE CETTE LIGNE PROVOQUE LE PROBLEME
    Sheets("Archivage").Range("B2").Value = Sheets("Bon de commande").Range("V17").Value
    Sheets("Archivage").Range("C2").Value = Sheets("Bon de commande").Range("H9").Value
    If Sheets("Archivage").Range("C2").Value <> 0 Then
        Sheets("Archivage").Range("D2").Value = Evaluate("VLookup(C2, Tableau_Chantiers, 2)")
    ElseIf Sheets("Archivage").Range("C2").Value = 0 Then
        Sheets("Archivage").Range("D2").Value = "Imputation manquante"
    End If
    Sheets("Archivage").Range("E2").Value = Sheets("Bon de commande").Range("R4").Value
    Sheets("Archivage").Range("F2").Value = Left(Sheets("Bon de commande").Range("R9"), Len(Sheets("Bon de commande").Range("R9")) - 2)
    Sheets("Archivage").Range("G2").Value = Sheets("Bon de commande").Range("V47")
    Sheets("Archivage").Range("A1:G" & Range("G65536").End(xlUp).Row).Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Key2:=Range("B1") _
       , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
    Sheets("Archivage").Range("A1").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("Bon de commande").Select
    Range("R4").MergeArea.ClearContents 'effacer fournisseur
    Range("H9:K9,R9:T9,R10:V10,R11:V11,R12:V12,R13:V13").Select
    Selection.ClearContents 'effacer imputation et livraison en même temps
    Range("R15").MergeArea.ClearContents 'effacer contact
    Range("C22:V45").Select
    Selection.ClearContents ' effacer liste des produits
    Range("F47:I47,L47,E49:L50,N49:N50,P50:R50,V47:W48,G52:R52").Select
    Selection.ClearContents 'effacer zone du bas
    Range("V47:W48").FormulaR1C1 = "=SUM(R22C22:R45C23)"
    Range("H9").Select

...

fonctionne bien (on peut cliquer sur le lien pour ouvrir le PDF) mais amène une "Erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet" dans le code de l'onglet principal "Bon de commande" où se trouve aussi le Userform avec le CommandButton pour passer la commande :

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False 'désactiver le rafraîchissement de l'écran avant exécution de la macro

'Gestion du remplissage des cellules pour la zone fournisseur
    If Not Application.Intersect(Target, Range("R4")) Is Nothing And Range("R4").Value <> "" Then
        Range("R5").Formula = "=IF(R4C18<>0,INDEX(Tableau_Fournisseurs,MATCH(R4C18,Liste_Noms_Fournisseurs,0),2),"""")"
        Range("R6").Formula = "=IF(R4C18="""","""",IF(AND(R4C18<>0,INDEX(Tableau_Fournisseurs,MATCH(R4C18,Liste_Noms_Fournisseurs,0),3)<>0),INDEX(Tableau_Fournisseurs,MATCH(R4C18,Liste_Noms_Fournisseurs,0),3),INDEX(Tableau_Fournisseurs,MATCH(R4C18,Liste_Noms_Fournisseurs,0),4)))"
        Range("R7").Formula = "=IF(R4C18="""","""",IF(AND(R4C18<>0,INDEX(Tableau_Fournisseurs,MATCH(R4C18,Liste_Noms_Fournisseurs,0),3)<>0),INDEX(Tableau_Fournisseurs,MATCH(R4C18,Liste_Noms_Fournisseurs,0),4),""""))"
    End If
    If Not Application.Intersect(Target, Range("R4")) Is Nothing And Range("R4").Value = "" Then
        Range("R5:R7").Value = ""
    End If
   
'Gestion du remplissage des cellules pour la zone livraison
    'Si on sélectionne "SUR SITE :", remplissage des champs de l'adresse en-dessous
    If Not Application.Intersect(Target, Sheets("Bon de commande").Range("H9, R9")) Is Nothing And Sheets("Bon de commande").Range("R9").Value = "SUR SITE :" Then 'PROBLEME ICI
        Range("R10").Formula = "=IF(VLOOKUP(R9C8,Tableau_Chantiers,2)<>"""",VLOOKUP(R9C8,Tableau_Chantiers,2),"""")"
        Range("R11").Formula = "=IF(VLOOKUP(R9C8,Tableau_Chantiers,3)<>"""",VLOOKUP(R9C8,Tableau_Chantiers,3),"""")"
        Range("R12").Formula = "=IF(VLOOKUP(R9C8,Tableau_Chantiers,4)<>"""",VLOOKUP(R9C8,Tableau_Chantiers,4),"""")"
        Range("R13").Formula = "=IF(VLOOKUP(R9C8,Tableau_Chantiers,5)<>"""",VLOOKUP(R9C8,Tableau_Chantiers,5),"""")"
        If Range("R12").Value = "" Then
            Range("R12").Formula = "=IF(VLOOKUP(R9C8,Tableau_Chantiers,5)<>"""",VLOOKUP(R9C8,Tableau_Chantiers,5),"""")"
            Range("R13").Value = ""
        End If
    End If

[...]
   
    Application.ScreenUpdating = True 'réactiver le rafraîchissement de l'écran avant exécution de la macro
   
End Sub

La fonction "If Not Application. Intersect (...) Is Nothing" reste difficile à comprendre et à appréhender.
Je pense qu'il y a une piste de ce côté-là à creuser.

Merci par avance.

 

[Dudu2]

Bonjour,
Faut-il qu'on réplique le code dans un classeur avec tout l'environnement et qu'on reproduise l'erreur ? Ou bien tu as des infos concernant l'instruction qui plante ?

Si l'erreur se trouve dans un UserForm qui plante à l'initialisation (UserForm_Initialize), je ne connais pas d'autre solution que de tracer, par un MsgBox par exemple, des blocs d'instructions, en resserrant les blocs au fur et à mesure que l'on identifie la localisation de l'erreur, jusqu'à cerner l'instruction en cause.

MsgBox "1"
<bloc d'instructions>
MsgBox "2"
<bloc d'instructions>
MsgBox "3"

 

[benjaminxls]

Bonjour,
Merci pour ta réactivité.

Alors dans la macro du CommandButton, c'est l'ajout de cette ligne :

Sheets("Archivage").Hyperlinks.Add Anchor:=Sheets("Archivage").Range("A2"), Address:=filename_bc 'L'AJOUT SEULE DE CETTE LIGNE PROVOQUE LE PROBLEME

Qui provoque le problème dans la Private Sub Worksheet_Change(ByVal Target As Range) de l'onglet "Bon de commande" à cet endroit :

If Not Application.Intersect(Target, Sheets("Bon de commande").Range("H9, R9")) Is Nothing And Sheets("Bon de commande").Range("R9").Value = "SUR SITE :" Then 'PROBLEME ICI

 

[Dudu2]

Je ne vois pas de relation entre les Ranges utilisés par ces 2 instructions.
Sinon que l'ajout de l'hyperlien va déclencher un évènement Change dans la feuille à supposer que le
Sub Worksheet_Change() soit sur la feuille "Archivage" ce qu'on ne peut pas savoir.

Si c'est le cas (?), la solution consiste à protéger l'ajout de l'hyperlien pour ne pas déclencher d'évènement:

    Application.EnableEvents = False
    Sheets("Archivage").Hyperlinks.Add Anchor:=Sheets("Archivage").Range("A2"), Address:=filename_bc
    Application.EnableEvents = True

 

[benjaminxls]

Dans la feuille "Bon de commande", il y a :
-Le Private Sub Worksheet_Change(ByVal Target As Range) avec le Application.Intersect
-Le userform pour passer la commande avec le Sub CommandButton_commande_Click()

Dans la feuille "Archivage", il n'y a rien.

C'est pour cela que je ne comprends pas le lien entre eux.

 

[benjaminxls]

C'est incroyable : je viens de faire tous le processus à coups de F8 pour le pas à pas détaillé et tout fonctionne. J'ai refait par la suite en mode normal via le Userform et le CommandButton et de nouveau le bug apparaît.
J'ai fait ça 2 fois et 2 fois les mêmes résultats.
Du coup, je sais encore moins où chercher.

Il y a peut-être des questions de temporalité dans l'exécution des macros ? Si c'est exécuté trop vite ou pas à pas ?

 

[benjaminxls]

J'ai réussi pour ceux que ça intéresse en contournant le problème en insérant une formule dans la cellule tout simplement :

With Sheets("Archivage").Range("A2")
        .Formula = "=HYPERLINK(""" & filename_bc & """,""" & Sheets("Bon de commande").Range("T2").Value & """)"
        .Characters.Font.Name = "Century Gothic"
End With