Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Not Application.Intersect + Hyperlinks : erreur 1004

B

benjaminxls

XLDnaute Nouveau
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" :

VB: 
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 :

VB: 
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.
 
Trier par date Trier par votes

Dudu2

XLDnaute Barbatruc
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.
VB: 
MsgBox "1"
<bloc d'instructions>
MsgBox "2"
<bloc d'instructions>
MsgBox "3"
 
Dernière édition:
Vote positif 0 Vote négatif
B

benjaminxls

XLDnaute Nouveau
Bonjour,
Merci pour ta réactivité.

Alors dans la macro du CommandButton, c'est l'ajout de cette ligne :
VB: 
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 :
VB: 
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
 
Vote positif 0 Vote négatif

Dudu2

XLDnaute Barbatruc
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:
VB: 
    Application.EnableEvents = False
    Sheets("Archivage").Hyperlinks.Add Anchor:=Sheets("Archivage").Range("A2"), Address:=filename_bc
    Application.EnableEvents = True
 
Vote positif 0 Vote négatif
B

benjaminxls

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif
B

benjaminxls

XLDnaute Nouveau
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 ?
 
Vote positif 0 Vote négatif
B

benjaminxls

XLDnaute Nouveau
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 :
VB: 
With Sheets("Archivage").Range("A2")
        .Formula = "=HYPERLINK(""" & filename_bc & """,""" & Sheets("Bon de commande").Range("T2").Value & """)"
        .Characters.Font.Name = "Century Gothic"
End With
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
429
florian50470
F
N
  • Question
Microsoft 365 Imbrication de deux formule Worksheet_BeforeDoubleClick
Réponses
1
Affichages
312
Nathan027
N
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
914
Phil69970
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
  • Résolu(e)
XL 2021 Filtrage que je ne parviens pas à faire
Réponses
6
Affichages
561
Usine à gaz
  • Question
XL 2010 Erreur en VBA > Cdbl
Réponses
9
Affichages
873
herve62
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
789
Oneida
R
  • Résolu(e)
XL 2016 Erreur 1004 - Erreur définie par l'application ou par l'objet
2
Réponses
19
Affichages
1 K
ReneDav14000
R
A
  • Question
Microsoft 365 Retourner message si compteur 0
Réponses
4
Affichages
491
AD95
A
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
493
un internaute
U
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…