Erreur d'exécution '-2147221080 (800401a8)'...

A

Angy1105

XLDnaute Junior
Bonjour le forum,

Je rencontre un problème lorsque j'appuie sur le bouton de transfert de données dans mon fichier, l'erreur d'exécution '-2147221080 (800401a8)' Erreur Automation apparaît.
Je sait que le problème vient de mon code mais je ne sais pas d'où exactement. J'utilise le code suivant :
Code: 
Private Sub Transfertdonnées_Click()
    Dim wk As Workbook
    Dim Plage As Range, c As Range
    Dim Lig As Long
    Dim i As Byte
      
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    On Error Resume Next
    Set wk = Workbooks("SYNTHESE.xls")
    If Err > 0 Then
        Err.Clear
        Set wk = Workbooks.Open(ThisWorkbook.Path & "\SYNTHESE.xls")
    End If
    ThisWorkbook.Activate
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
    If Err.Number > 0 Then
        MsgBox "Erreur lors de l'ouverture du fichier SYNTHESE.xls", vbCritical, "Exportation"
        Exit Sub
    End If

    On Error GoTo 0
    Lig = wk.Sheets("Secteur").Range("A500").End(xlUp).Row + 1
    For i = 1 To 4
        wk.Sheets("Secteur").Cells(Lig, i + 3) = Sheets("Trame").Range("J24,L24,L26,J26").Areas(i)(1)
    Next i

    On Error GoTo 0
    Lig = wk.Sheets("Secteur").Range("A500").End(xlUp).Row + 1
    For i = 1 To 2
        wk.Sheets("Secteur").Cells(Lig, i) = Sheets("Trame").Range("D3,D5").Areas(i)(1)
    Next i
    
  If Not wk Is Nothing Then
       wk.Save
       wk.Close
  End If

    On Error Resume Next
    Set wk = Workbooks("SUIVI.xls")
    If Err > 0 Then
        Err.Clear
        Set wk = Workbooks.Open(ThisWorkbook.Path & "\SUIVI.xls")
    End If
    ThisWorkbook.Activate
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
    If Err.Number > 0 Then
        MsgBox "Erreur lors de l'ouverture du fichier SUIVI.xls", vbCritical, "Exportation"
        Exit Sub
    End If

    On Error GoTo 0
        Set Plage = Sheets("Trame").Range("E11:E20")
        For Each c In Plage
            If UCase(c.Text) = "X" Then
                With wk.Sheets("Suivi")
                    Lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    .Range("A" & Lig) = Sheets("Trame").Range("D3")
                    .Range("B" & Lig) = Sheets("Trame").Range("D5")
                    .Range("C" & Lig) = Sheets("Trame").Range("B" & c.Row)
                    .Range("D" & Lig) = Sheets("Trame").Range("F" & c.Row)
                    .Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
                    .Range("F" & Lig) = Sheets("Trame").Range("J" & c.Row)
                    .Range("G" & Lig) = Sheets("Trame").Range("K" & c.Row)
                    .Range("H" & Lig) = .Range("A" & Lig) = Sheets("Trame").Range("D3") + .Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
                End With
            End If
        Next c
        
  If Not wk Is Nothing Then
       wk.Save
  End If

     On Error Resume Next
    Set wk = Workbooks("HIPO.xls")
    If Err > 0 Then
        Err.Clear
        Set wk = Workbooks.Open(ThisWorkbook.Path & "\HIPO.xls")
    End If
    ThisWorkbook.Activate
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
    If Err.Number > 0 Then
        MsgBox "Erreur lors de l'ouverture du fichier HIPO.xls", vbCritical, "Exportation"
        Exit Sub
    End If

    On Error GoTo 0
        Set Plage = Sheets("Trame").Range("M11:M20")
        For Each c In Plage
            If UCase(c.Text) = "VRAI" Then
                With wk.Sheets("suivi")
                    Lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    .Range("A" & Lig) = Sheets("Trame").Range("D3")
                    .Range("B" & Lig) = Sheets("Trame").Range("D5")
                    .Range("C" & Lig) = Sheets("Trame").Range("B" & c.Row)
                    .Range("D" & Lig) = Sheets("Trame").Range("F" & c.Row)
                    .Range("E" & Lig) = Sheets("Trame").Range("J" & c.Row)
                    
                End With
            End If
        Next c

  If Not wk Is Nothing Then
       wk.Save
       wk.Close
  End If
   
End Sub

Il est très long mais l'erreur vient au début, je pense. Quand j'ouvre Microsoft Visual Basic, la macro marche a merveille.

Quelqu'un peut-il me dire d'où vient l'erreur ?

Merci d'avance et bonne journée
 
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Salut Angy1105,

Sans les vrais fichiers, à tester comme ça, ça à l'air de fonctionner :confused:
Manque peut être un "wk.close" pour le Workbook "SUIVI.xls"

Mais sinon ça tourne sans message

Alors à voir si tu peux nous mettre les fichiers ou non

A+
 
Vote positif 0 Vote négatif
A

Angy1105

XLDnaute Junior
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Bonjour BrunoM45,

Désolé pour le retard, j'étais en vacances ...:D
Voici les fichiers excel que j'ai réalisé, le mot de passe est SSE.
Je voudrais garder le fichier Suivi ouvert après le transfert.

Je vous remercie pour votre aide.

Bonne journée.
 

Pièces jointes

  • TRAME IGP.zip
    39.3 KB · Affichages: 29
  • SYNTHESE.zip
    11.6 KB · Affichages: 30
  • SUIVI.zip
    24.7 KB · Affichages: 33
  • REPORTING.zip
    13.8 KB · Affichages: 19
  • TRAME IGP.zip
    39.3 KB · Affichages: 28
  • SYNTHESE.zip
    11.6 KB · Affichages: 28
  • SUIVI.zip
    24.7 KB · Affichages: 35
  • REPORTING.zip
    13.8 KB · Affichages: 26
  • TRAME IGP.zip
    39.3 KB · Affichages: 26
  • SYNTHESE.zip
    11.6 KB · Affichages: 28
  • SUIVI.zip
    24.7 KB · Affichages: 39
  • REPORTING.zip
    13.8 KB · Affichages: 24
Vote positif 0 Vote négatif
A

Angy1105

XLDnaute Junior
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Bonjour le forum,

Quelqu'un peut-il m'aider ? Je ne comprends pas le problème...
J'ai envoyer les fichiers concernés plus haut.

Je vous remercie d'avance.

Bonne journée à tous et à toutes.

Angy
 
Vote positif 0 Vote négatif
A

Angy1105

XLDnaute Junior
Re : Erreur d'exécution '-2147221080 (800401a8)'...

J'avance à petits pas mais j'avance est c'est l'essentiel.
L'erreur provient de cette ligne de code
Code: 
 On Error GoTo 0
        Set Plage = Sheets("Trame").Range("E11:E20")
        For Each c In Plage
            If UCase(c.Text) = "X" Then
                [COLOR="Red"]With wk.Sheets("Liste")[/COLOR]
                    Lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    .Range("A" & Lig) = Sheets("Trame").Range("D3")
                    .Range("B" & Lig) = Sheets("Trame").Range("D5")
                    .Range("C" & Lig) = Sheets("Trame").Range("B" & c.Row)
                    .Range("D" & Lig) = Sheets("Trame").Range("F" & c.Row)
                    .Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
                    .Range("F" & Lig) = Sheets("Trame").Range("J" & c.Row)
                    .Range("G" & Lig) = Sheets("Trame").Range("K" & c.Row)
                    .Range("H" & Lig) = .Range("A" & Lig) = Sheets("Trame").Range("D3") + .Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
                End With
            End If
        Next c

J'ai vérifié s'il y avait aucune erreur dans le nom de l'objet, j'ai même modifier le nom pour être sûr. J'ai refais un test ça marchait mais quand je reouvre mon fichier, j'ai la même erreur.

Là je sèche...
Est-il possible que quelqu'un m'aide ?

Bonne journée.
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Salut Angy1105,

Pas d'erreur chez moi, en revanche une référence manquante "Citrix ICA Client"

A vérifier chez toi, une référence manquante peut être ma cause de nombreux bugs "imaginaires"

Chose constatée également pense à effacer tes variables objet après les avoir utilisées
Code: 
 Set wk = Workbooks("SYNTHESE.xls")
...
wk.close
[COLOR=blue][B]Set wk = Nothing[/B][/COLOR]
Cela économise de la ressource et de la mémoire

En tout cas, joli boulot ;)

A+
 
Vote positif 0 Vote négatif
A

Angy1105

XLDnaute Junior
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Merci pour le compliment mais c'est grâce au forum que mon fichier à vu le jour donc merci à vous.

Oui, je travaille sur version Citrix depuis le 27 février 2009.
Comment puis-je l'intégrer dans mes codes ?

Merci d'avance et bonne après-midi.
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Re,

Pas besoin de l'intégrer, apparemment la référence est déjà cochée ;)

Donc ton problème ne vient pas de là :(
As-tu essayer de faire un pas à pas lors de l'éxécution de ton code ?

A+
 
Vote positif 0 Vote négatif
A

Angy1105

XLDnaute Junior
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Lorsque je fais un pas à pas détaillé, l'erreur d'éxécution '91' ; variable de bloc with non définie apparaît pour la ligne de code suivant :

Code: 
With wk.Sheets("Liste")

dans le code :
Code: 
On Error GoTo 0
        Set Plage = Sheets("Trame").Range("E11:E20")
        For Each c In Plage
            If UCase(c.Text) = "X" Then
                With wk.Sheets("Liste")
                    Lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    .Range("A" & Lig) = Sheets("Trame").Range("D3")
                    .Range("B" & Lig) = Sheets("Trame").Range("D5")
                    .Range("C" & Lig) = Sheets("Trame").Range("B" & c.Row)
                    .Range("D" & Lig) = Sheets("Trame").Range("F" & c.Row)
                    .Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
                    .Range("F" & Lig) = Sheets("Trame").Range("J" & c.Row)
                    .Range("G" & Lig) = Sheets("Trame").Range("K" & c.Row)
                    .Range("H" & Lig) = .Range("A" & Lig) = Sheets("Trame").Range("D3") + .Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
                End With
            End If
        Next c

Je ne comprends pas...
en tout cas merci BrunoM45 de ton aide.
 
Vote positif 0 Vote négatif
A

Angy1105

XLDnaute Junior
Re : Erreur d'exécution '-2147221080 (800401a8)'...

J'ai effacé le contenu de mon tableau "Trame IGP" que j'avais rempli pour un test et j'ai refais la manip. Le transfert se fait correctement. Il n'a peut-être pas aimé que j'utilise les mêmes données.
Mystère et boule de gomme!!
J'espère que le problème est résolu. Je vais faire de multiple test pour vérifier.


Merci pour tout BrunoM45.

Bonne journée à tous et à toutes.

@+
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re : Erreur d'exécution '-2147221080 (800401a8)'...

Re,

Pour info
erreur d'éxécution '91' ; variable de bloc with non définie
Cliquez pour agrandir...
Voudrait dire que plus haut ton code
Code: 
On Error Resume Next
    Set wk = Workbooks("SUIVI.xls")
    If Err > 0 Then
        Err.Clear
        Set wk = Workbooks.Open(ThisWorkbook.Path & "\SUIVI.xls")
    End If
n'est pas pris correctement en compte !?

Ou alors que ta variable "wk" est effacée.

Peut être en ajoutant
Code: 
Set Plage = ThisWorkbook.Sheets("Trame").Range("E11:E20")
Pour que le code ne confonde pas de classeur (bien que ce soit impossible)

A+
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
185
Francky79
F
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
184
Le Rouky
L
C
  • Question
Autres Enregistrer un code barre dans la cellule avant le titre qui est déja enregistré
Réponses
11
Affichages
496
Chatron
C
P
  • Question
Microsoft 365 Problème de destination à l'exécution d'une macro
Réponses
2
Affichages
283
Pimpon974
P
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
235
florian50470
F
Regueiro
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
295
sylvanu
sylvanu
S
  • Question
XL 2019 Problème dans un code vba
Réponses
2
Affichages
422
snoopy07
S
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
932
thivame
T
C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
641
TooFatBoy
TooFatBoy
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
546
halecs93
halecs93

Membres actuellement en ligne

16 membres et 123 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 218
Messages
2 086 366
Membres
103 197
dernier inscrit
sandrine.lacaussade@orang