Un classique : Erreur 1004 - Erreur définie par l'application ou l'objet

Le 03/05/2021 à 12:14

Bonjour à toutes et à tous,

Je me retrouve bien embêté car un code VBA a cessé de fonctionner, que ce n'est pas le mien et que ce n'est même pas moi qui l'utilise. Le voici :

Option Explicit

Sub Copie_Tab_Der_Sheet(TabSource As Variant)

Dim CptCol As Long          'Compteur Colonnes, pour la boucle d'inscription des données d'ENTÊTE sur la feuille destination
Dim LngEntete As Integer    'Numéro de ligne d'entête temporaire, pour l'inscription des données d'ENTÊTE sur la feuille destination
Dim NumOnglet As Integer    'Numéro d'onglet temporaire, pour l'inscription des données d'ENTÊTE sur la feuille destination
    '*****-----*****-----*****-----*****-----
Dim NbColMax As Long        'Nb de colonnes qui sera copiée au total (sur tous les onglets cochés)
    '*****-----*****-----*****-----*****-----
Dim NbCol As Long   'Nb de Colonnes dans la BdD
Dim NbLngl As Long  'Nb de Lignes dans la BdD
    '*****-----*****-----*****-----*****-----
Dim TxtRange As String  'Texte Adresse range temporaire
'*****-----**********----------**********----------**********-----*****

'Creation d'une nouvelle feuille, sur laquelle on copie l'intégralité de la BdD
'With ThisWorkbook
With ClasseurSource
    .Sheets.Add After:=.Worksheets(.Worksheets.Count)   'Création d'une nouvelle feuille à la fin

'NbLngl = UBound(TabSource, 1)
NbLngl = UBound(TabSource, 2)
'NbCol = UBound(TabSource, 2)
NbCol = UBound(TabSource, 1)

'NB : Ajout d'1 à NbLngl et NbCol pour tenir compte de la Base 0 des variables tableaux
TxtRange = Range(Cells(1, 1), Cells(NbLngl + 1, NbCol + 1)).Address
TxtRange = Range(Cells(1, 1), Cells(NbLngl, NbCol)).Address

'TRANSPOSITION DU TABLE AVANT SA COPIE
Dim Table1, Table2()
Dim A As Long, B As Long

'Table1 = Range("A1:A10")
Table1 = TabSource
ReDim Table2(1 To UBound(Table1, 2), 1 To UBound(Table1, 1))
    For A = 1 To UBound(Table1, 1)
        For B = 1 To UBound(Table1, 2)
        Table2(B, A) = Table1(A, B)
        Next
    Next
'Range("B1").Resize(UBound(Table2, 1), UBound(Table2, 2)) = Table2

    'Copie de la BdD sur la Feuille destination Créée
    '.Worksheets(.Worksheets.Count).Range(TxtRange) = TabSource
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual

    .Worksheets(.Worksheets.Count).Range(TxtRange) = Table2
    '.Worksheets(.Worksheets.Count).Columns(1).Delete Shift:=xlToLeft

'MsgBox TabSource(1, NbCol)
'NbColMax = DerColSheets(CStr(TabSource(1, NbCol)))
'LngEntete = Lng_Entete_Sheets(CStr(TabSource(1, NbCol)))

'NumOnglet = ThisWorkbook.Worksheets(CStr(TabSource(1, NbCol))).Index

'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
    'Inscription des entêtes
'    For CptCol = 1 To NbColMax
'        .Worksheets(.Worksheets.Count).Cells(1, CptCol).Value = ThisWorkbook.Worksheets(NumOnglet).Cells(LngEntete, CptCol).Value
'    Next CptCol
'    .Worksheets(.Worksheets.Count).Cells(1, NbCol).Value = "Onglets Sources"
'Application.ScreenUpdating = True
'Application.EnableEvents = True
'Application.Calculation = xlCalculationAutomatic

End With

End Sub

Sub Copie_BdD_Der_Sheet()
'*****-----**********----------**********----------**********-----*****
Dim CptCol As Long          'Compteur Colonnes, pour la boucle d'inscription des données d'ENTÊTE sur la feuille destination
Dim LngEntete As Integer    'Numéro de ligne d'entête temporaire, pour l'inscription des données d'ENTÊTE sur la feuille destination
Dim NumOnglet As Integer    'Numéro d'onglet temporaire, pour l'inscription des données d'ENTÊTE sur la feuille destination
    '*****-----*****-----*****-----*****-----
Dim NbColMax As Long        'Nb de colonnes qui sera copiée au total (sur tous les onglets cochés)
    '*****-----*****-----*****-----*****-----
Dim NbCol As Long   'Nb de Colonnes dans la BdD
Dim NbLngl As Long  'Nb de Lignes dans la BdD
    '*****-----*****-----*****-----*****-----
Dim TxtRange As String  'Texte Adresse range temporaire
'*****-----**********----------**********----------**********-----*****

    'Call Alimentation_TabBdD

'Creation d'une nouvelle feuille, sur laquelle on copie l'intégralité de la BdD
With ThisWorkbook
    .Sheets.Add After:=.Worksheets(.Worksheets.Count)   'Création d'une nouvelle feuille à la fin

NbLngl = UBound(TabBdD, 1)
NbCol = UBound(TabBdD, 2)

'NB : Ajout d'1 à NbLngl et NbCol pour tenir compte de la Base 0 des variables tableaux
TxtRange = Range(Cells(1, 1), Cells(NbLngl + 1, NbCol + 1)).Address
    'Copie de la BdD sur la Feuille destination Créée
    .Worksheets(.Worksheets.Count).Range(TxtRange) = TabBdD
    .Worksheets(.Worksheets.Count).Columns(1).Delete Shift:=xlToLeft

'MsgBox TabBdD(1, NbCol)
'NbColMax = DerColSheets(CStr(TabBdD(1, NbCol)))
'MsgBox TabBdD(1, NbCol-2)
NbColMax = DerColSheets(CStr(TabBdD(1, NbCol - 2)))
'LngEntete = Lng_Entete_Sheets(CStr(TabBdD(1, NbCol)))
LngEntete = Lng_Entete_Sheets(CStr(TabBdD(1, NbCol - 2)))

'NumOnglet = ThisWorkbook.Worksheets(CStr(TabBdD(1, NbCol))).Index
NumOnglet = ThisWorkbook.Worksheets(CStr(TabBdD(1, NbCol - 2))).Index

'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
    'Inscription des entêtes
    For CptCol = 1 To NbColMax
        .Worksheets(.Worksheets.Count).Cells(1, CptCol).Value = ThisWorkbook.Worksheets(NumOnglet).Cells(LngEntete, CptCol).Value
    Next CptCol
    .Worksheets(.Worksheets.Count).Cells(1, NbCol - 2).Value = "Onglets Sources"
    .Worksheets(.Worksheets.Count).Cells(1, NbCol - 1).Value = "Num Ligne"
    .Worksheets(.Worksheets.Count).Cells(1, NbCol).Value = "Id"
'Application.ScreenUpdating = True
'Application.EnableEvents = True
'Application.Calculation = xlCalculationAutomatic

End With

End Sub

Lors du débogage, une ligne s'affiche en surbrillance, vers le début du code. Il s'agit de la dernière ligne affichée dans cet encart :

Option Explicit

Sub Copie_Tab_Der_Sheet(TabSource As Variant)

Dim CptCol As Long          'Compteur Colonnes, pour la boucle d'inscription des données d'ENTÊTE sur la feuille destination
Dim LngEntete As Integer    'Numéro de ligne d'entête temporaire, pour l'inscription des données d'ENTÊTE sur la feuille destination
Dim NumOnglet As Integer    'Numéro d'onglet temporaire, pour l'inscription des données d'ENTÊTE sur la feuille destination
    '*****-----*****-----*****-----*****-----
Dim NbColMax As Long        'Nb de colonnes qui sera copiée au total (sur tous les onglets cochés)
    '*****-----*****-----*****-----*****-----
Dim NbCol As Long   'Nb de Colonnes dans la BdD
Dim NbLngl As Long  'Nb de Lignes dans la BdD
    '*****-----*****-----*****-----*****-----
Dim TxtRange As String  'Texte Adresse range temporaire
'*****-----**********----------**********----------**********-----*****

'Creation d'une nouvelle feuille, sur laquelle on copie l'intégralité de la BdD
'With ThisWorkbook
With ClasseurSource
    .Sheets.Add After:=.Worksheets(.Worksheets.Count)   'Création d'une nouvelle feuille à la fin

'NbLngl = UBound(TabSource, 1)
NbLngl = UBound(TabSource, 2)
'NbCol = UBound(TabSource, 2)
NbCol = UBound(TabSource, 1)

'NB : Ajout d'1 à NbLngl et NbCol pour tenir compte de la Base 0 des variables tableaux
TxtRange = Range(Cells(1, 1), Cells(NbLngl + 1, NbCol + 1)).Address
TxtRange = Range(Cells(1, 1), Cells(NbLngl, NbCol)).Address

Avez-vous une idée de ce qui se passe ?

Merci à vous !

Le 03/05/2021 à 12:32

Bonjour,

Vous pourriez faire le ménage dans votre code avant de le poster, c'est pas évident de s'y retrouver avec un code rempli à moitié de commentaires...

La macro en question dépend du paramètre TabSource. Elle doit donc être appelée par une autre macro qui lui rentrera ce fameux TabSource en argument. J'ai peut-être lu un peu vite mais je n'ai pas l'endroit dans le code où a lieu cet appel ni celui où TabSource est chargé...

Cdlt,

Le 03/05/2021 à 12:52

Bonjour,

Ce n'est pas moi qui ai rédigé ce code et, n'y connaissant pas grand chose, je préfère poster sans l'altérer.

Voici une autre macro contenant TabSource :

Option Explicit

Sub Ajout_Ligne_Tab(TabSource As Variant, NumLngSource As Long, TabCible As Variant)
Dim DerLngTabCible As Long
Dim NbCol As Long
Dim CptCol As Long

Dim NbColTab As Long
    NbColTab = UBound(TabSource, 2)

    'MsgBox "Stop "
    'MsgBox TabSource(NumLngSource, 3)   'Valeur Inscrite

'Redimensionne la Table Cible (Ajout d'une ligne)
DerLngTabCible = UBound(TabCible, 2)
    DerLngTabCible = DerLngTabCible + 1
    ReDim Preserve TabCible(0 To NbColTab, 0 To DerLngTabCible)

'Ajout des valeurs dans la dernière ligne de TabCible redimensionnée
For CptCol = 1 To NbColTab
    'MsgBox TabSource(NumLngSource, CptCol)
    'TabCible(CptCol, DerLngTabCible) = ""
    TabCible(CptCol, DerLngTabCible) = TabSource(NumLngSource, CptCol)
Next CptCol

'MsgBox "Fin Copie Ligne"

End Sub
Le 03/05/2021 à 15:17

Encore une fois, TabSource est un des paramètres de la macro et les macros paramétrées ne peuvent pas s'exécuter seules.. Il faut donc retrouver la macro exécutante, celle de départ, où TabSource est alimenté.

Edit : et le problème principal, c'est qu'on dirait que votre code est la superposition de 2 macros, une macro de départ avec des éléments en dur à laquelle s'est rajoutée des paramètres variables qui ont remplacé certains éléments en dur mais qui n'ont pas tous été passés en paramètres de la macro. Et c'est ça qui fait un peu foutoir au premier coup d'oeil.

Cdlt,

Le 03/05/2021 à 15:28

Merci !

J'ai donc trouvé une macro qui "appelle" la première via la ligne suivante :

Call Copie_Tab_Der_Sheet(TabDoublons)

L'intégralité ici :

Option Explicit

Public ClasseurDesti As Workbook    'Classeur où on se trouve
Public ClasseurSource As Workbook   'Classeur qui sera Ouvert

Public NomClasseur_Compare As String   'Nom du Classeur + Chemin Accès Cible
Public NomClasseur_ExportZMIR As String   'Nom du Classeur + Chemin Accès Cible

Public Nb_Onglet As Long

'*****-----**********----------**********----------**********-----*****
'Table qui contient les données rassemblées des onglets ciblés
'Normalement, les onglets contiennt => 15 => Colonnes
'On garder ces 15 Colonnes (déterminées par le plus grand nombre de colonne trouvé !!)
'Et on ajoute => 2 => Colonnes
    '1 => Pour indiquer, dans cette colonne supplémentaire, les onglets dont sont issues les données de la BdD
    '2 => Pour indiquer, dans cette colonne supplémentaire, les lignes (sur l'onglet ciblé) dont sont issues les données de la BdD
    '3 => Pour indiquer, un ID unique, constitué des 2 données ci-dessus...
'Les dernières colonnes sont déterminées par la plus grande colonne entre les lignes 1 et 2 => ENTÊTES A REVOIR !!
Public TabBdD() As Variant
'*****-----**********----------**********----------**********-----*****

'*****-----**********----------**********----------**********-----*****
Public TabSansDoublons() As Variant
Public TabDoublons() As Variant
'*****-----**********----------**********----------**********-----*****

'*****-----**********----------**********----------**********-----*****
'Public TabSFOui_SansDoublons() As Variant
'Public TabSFNon_SansDoublons() As Variant
'*****-----**********----------**********----------**********-----*****

'*****-----**********----------**********----------**********-----*****
'Public TabAnnulation_SansDoublons() As Variant
'Public TabSuspension_SansDoublons() As Variant
'*****-----**********----------**********----------**********-----*****

Sub Lancement_Comparaison()

Nb_Onglet = 0
Click_Sur_Annuler = False
Click_Sur_OK = False

Set ClasseurDesti = ThisWorkbook
Set ClasseurSource = Nothing

NomClasseur_Compare = ""
NomClasseur_ExportZMIR = ""

'MsgBox "Sélectionner le fichier Export ZMIR6"
'Call Utilisation_FileDialog_SelectionFichier("Sélectionner le fichier Export ZMIR6")

'MsgBox Utilisation_FileDialog_SelectionFichier("Sélectionner le fichier Export ZMIR6")
NomClasseur_ExportZMIR = Utilisation_FileDialog_SelectionFichier("Sélectionner le fichier Export ZMIR6")
'MsgBox NomClasseurCible

If NomClasseur_ExportZMIR = "" Then Exit Sub

Select_Onglets.Show

If Click_Sur_OK = False Or Click_Sur_Annuler = True Then
    'MsgBox "Il faut quitter, car l'utilisateur a :" & vbCrLf & _
        " - Soit cliqué sur la croix pour fermer," & vbCrLf & _
        " - Soit cliqué sur le bouton Annuler."
    Unload Select_Onglets
    Exit Sub
Else
    'MsgBox "Puis sélectionner l'onglet ciblé sur le fichier sélectionné"
    'MsgBox "Récupérer les infos et lancer les recherches ! ICI !"
    Call Comparaison_Export_ZMIR6_Suivi_Factures
    'Puis Fermer l'UseForm qui n'a été QUE Caché auparavant !!
    Unload Select_Onglets
End If

End Sub

Sub Comparaison_Export_ZMIR6_Suivi_Factures()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

    'Création d'une variable tableau avec toutes les données de "Suivi Factures"
    Call Alimentation_TabBdD

    Call Traitement_Doublons_BdD

'Copie la BdD sur une nouvelle feuille
    'Call Copie_BdD_Der_Sheet

'Copie_de la Table SANS DOUBLON sur une nouvelle feuille
    'Call Copie_Tab_Der_Sheet(TabSansDoublons)

    Call OuvertureClasseurSource(NomClasseur_ExportZMIR)
    Call Mise_en_Forme_Export

'Copie_de la Table SANS DOUBLON sur une nouvelle feuille
    Call Copie_Tab_Der_Sheet(TabDoublons)

'Renomme la feuille en "Doublons_Erreurs" ou  en "Doublons_Erreurs (1)"
        If FeuilExisteClasseur("Doublons_Erreurs", ClasseurSource) Then
            'MsgBox "Problème ?!?" => Solution :
Dim NumIncrem As Long, NewName As String
NumIncrem = 1: NewName = "Doublons_Erreurs (" & NumIncrem & ")"
        Do While FeuilExisteClasseur(NewName, ClasseurSource)
            NumIncrem = NumIncrem + 1
            NewName = "Doublons_Erreurs_" & NumIncrem
        Loop
        ClasseurSource.Sheets(Sheets.Count).Name = NewName
        Else
            ClasseurSource.Sheets(Sheets.Count).Name = "Doublons_Erreurs"
        End If

    Call Comparaison_ZMIR6_TabBdD_TabPropre

    Call Comparaison_ZMIR6_TabBdD_TabDoublons

    'Suppression des variables tableaux créées
    Erase TabBdD

    Erase TabSansDoublons
    Erase TabDoublons

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub
Le 03/05/2021 à 15:55

Là, ça devient compliqué, vous avez des procédures dans tous les sens avec des variables tableaux publiques. Donc pour l'instant, on ne sait toujours pas comment est alimenté TabDoublons puisqu'il est probablement dans une des procédures...

J'ai commencé à modifier votre premier code puis j'ai malencontreusement fermé la fenêtre donc je vais attendre un peu avant de m'y remettre mais j'aurais tendance à tout raser ! Par exemple, pour la première macro :

Sub macrotest()
TabDoublons = range("A1:D4").value
Copie_Tab_Der_Sheet thisworkbook, TabDoublons '<<< APPEL DE LA MACRO
end sub

Sub Copie_Tab_Der_Sheet(ClasseurSource as workbook, TabSource As Variant)
With ClasseurSource
    with .Sheets.Add(After:=.Worksheets(.Worksheets.Count))   'Création d'une nouvelle feuille à la fin
        .cells(1, 1).resize(ubound(TabSource, 2), ubound(TabSource)) = application.transpose(TabSource)
    end with
End With
End Sub

Il faut savoir ce qu'il reste à y faire.

Et à moins que ce soit nécessaire, je privilégierais les macros dépendant de paramètres aux variables publiques. On s'y retrouve plus facilement et c'est moins une source de problèmes.

Le 03/05/2021 à 17:35

Merci !

Alors là ça devient bizarre : j'ai trouvé le moyen de refaire fonctionner la macro, mais si j'applique un tri (du plus ancien au plus récent par exemple) sur la colonne des dates, alors la macro ne fonctionne plus...

Le 03/05/2021 à 23:48

Alors là, je ne saurais pas vous dire, il y a bien trop d'inconnus dans le code (il s'agit pas d'une petite macro de 4 lignes en plus), pour que j'y comprenne quelque chose en l'état.

J'ai remarqué qu'il y avait une transposition et aussi une colonne (nbcol - 2) qui serait déterminante (si l'on parle du même code). Ces éléments, en fonction de l'ordre des valeurs (consécutif à un tri) peuvent tout changer, notamment si une colonne contient 2 types de données, des dates et du texte par exemple.

Je vous conseille de bien retrouver l'ordre des actions et éventuellement de les écrire sur papier pour mieux comprendre leur enchainement et les éventuelles sources d'erreurs d'une procédure à l'autre. Il sera possible d'intégrer un tri avant d'exécuter la procédure bloquante pour s'assurer de son bon fonctionnement.

Mais comme je vous ai dit, c'est trop abstrait pour moi comme ceci.

Cdlt,

Rechercher des sujets similaires à "classique erreur 1004 definie application objet"