Erreur d'éxécution '91' variable objet ou variable de bloc with non définie

Version imprimable

Bonjour les amis,

Le fichier sur lequel je travail est finalisé pratiquement, j'ai un plantage à la fin du traitement (Erreur d'éxécution '91' variable objet ou variable de bloc with non définie), je ne vois vraiment pas à quoi ça correspond. Si quelqu'un pourrais m'aider ça serait magnifique

Voilà le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 
 
Sub ExtraireParGroupeColonneB()
 
 
Dim O As Long, NbLg As Long
Dim n As Integer
Dim H1 As Worksheet
Dim Mondico As Object
Dim Tablo
Dim Interdits
Dim ligne
 
Call RegrouperLesBD
 
  Interdits = Array("&", ":", "/", "\", "~?", "~*", "[", "]", Chr(34))
 
  Application.ScreenUpdating = False
 
  Application.DisplayAlerts = False
 
 
  Application.DisplayAlerts = True
 
  Call SupprimeFeuille
 
  Set H1 = Sheets("BD")
  If H1.FilterMode = True Then H1.ShowAllData
  NbLg = H1.Range("A" & Rows.Count).End(xlUp).Row
 
rep = InputBox("Choisir la lettre de la colonne pour la création de fiches", "CREATION DE FICHES PAR GROUPES", "B")
 
  H1.Columns(rep).Copy H1.Columns("O")
 
  With H1.Range("O2:O" & NbLg)
    For n = 0 To UBound(Interdits)
      .Replace what:=Interdits(n), replacement:="_", lookat:=xlPart
    Next n
 
  End With
 
  Set Mondico = CreateObject("Scripting.dictionary")
  For O = 2 To NbLg
    Mondico(H1.Range("O" & O).Value) = ""
  Next O
 
  H1.Range("O1:P1") = "XYZ"
 
  Tablo = Mondico.keys
  For n = 0 To UBound(Tablo)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(n)
    Sheets("Modèle").UsedRange.Copy
    Sheets(Tablo(n)).Range("A1").PasteSpecial
 
 
    With Sheets(Tablo(n))
      .Range("A2") = Tablo(n)
      H1.Range("P2") = Tablo(n)
 
        For Each cel In H1.Range("G2:G" & NbLg) 'pour chaque cellule de G2 à G_DernièreLigne
            r = cel.Row
            noms = H1.Range("C" & r)
            If H1.Range(rep & r) = Tablo(n) Then
                c = .Range("A1000").End(xlUp).Row + 1
                If .Range("A9") = "" Then
                    H1.Range("C" & r & ":H" & r).Copy 'Copie de C à H feuille BD
                    .Range("A" & c).PasteSpecial xlPasteValues 'Colle depuis A feuille modèle
                End If
 
                If Not .Range("E9:E" & c).Find(cel) Is Nothing And Not .Range("A9:A" & c).Find(noms) Is Nothing Then
                'Si le numero de pièce existe déjà dans la feuille modèle alors...
                Set ligne = .Range("E9:E" & c).Find(cel) 'on trouve la ligne correspondante
                    If Not ligne Is Nothing And .Range("A" & ligne.Row) <> noms Then
                        Flig = ligne.Row
                        Do
                            cel.Value = cel
                            Set ligne = .Range("E9:E" & c).FindNext(.Range("E" & Flig))
                            ligne = ligne.Row
                        Loop While ligne = Flig And .Range("A" & ligne) <> noms
                    Else
                    ligne = ligne.Row
                    End If
remp:
                    'On prend chaque cas de compte et on vient mettre le débit et crédit dans les colonnes correspondantes
                    If H1.Range("A" & r) = "VACANCES - COLOS" Then .Range("G" & ligne) = .Range("G" & ligne) + H1.Range("I" & r): .Range("H" & ligne) = .Range("H" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "ALIMENTATION A L'EXTERIEUR." Then .Range("I" & ligne) = .Range("I" & ligne) + H1.Range("I" & r): .Range("J" & ligne) = .Range("J" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "AUTRES REMB.FRAIS GR 1" Then .Range("N" & ligne) = .Range("N" & ligne) + H1.Range("J" & r): .Range("M" & ligne) = .Range("M" & ligne) + H1.Range("I" & r)
                Else
                    H1.Range("C" & r & ":H" & r).Copy
                    .Range("A" & c).PasteSpecial xlPasteValues
                    ligne = c
                    GoTo remp
                End If
 
            End If
 
 
        Next cel
 
           ActiveWindow.DisplayOutline = False
 
 
 
    End With
 
      'ICI AJUSTER LIGNES ET COLONNES
    Call MiseEnPageFeuilleModeleColonnesEtLignes
 
  Next n
 
  H1.Columns("O:P").Clear
  H1.Select
 
  Call consolidation
 
 
End Sub

22/06/2018, 12h10
Menhir

Citation:

Envoyé par Stéphanie57

j'ai un plantage à la fin du traitement

Si tu pouvais être un poil plus précise en donnant la ligne de code signalée par le débugueur, ce serait quand même plus pratique.
22/06/2018, 12h15
Stéphanie57

Ligne qui pose soucis :

ligne = ligne.Row

Lorsque je fais passer la souris dessus, il me met, ligne=nothing
22/06/2018, 15h28
Menhir

Citation:

Envoyé par Stéphanie57

Ligne qui pose soucis :
ligne = ligne.Row

Row est de type Long.
L'objet parent doit être de type Range.

Il est donc impossible qu'on puisse matérialiser par la même variable le parent de Row et son résultat.

Déclare te type de tes variables et les explication du débugueur pour ce type d'erreur seront plus claires.
25/06/2018, 11h58
Stéphanie57

fichier trop gros

Je vais retravailler le fichier pour qu'il puisse être téléchargeable, il est clair que comme ça, ce n'est pas évident à traiter.

A très vite les amis

1 pièce(s) jointe(s)

En image c'est peut être plus compréhensible

L'idée de ce module qui ne fonctionne pas comme je le souhaite, est qu'à partir de l'onglet "BD" il créer les fiches automatiquement et que surtour il réparti dans la colonne vacances colo les chiffres correspondant, ensuite dans la colonne alimentation exterieur, il recherche le n° de la pièce correspondant à la colonne vacances colo et qu'il le met bien dans la bonne ligne, et enfin pour la 3e colonne, il recherche aussi le n° de pièce correspondant à la colonne vacances colo et qu'il met le chiffre correspondant.

il y a peut être une simple adaptation à faire...

Il est impossible de le faire avec l'action copier coller.

Pouvez-vous m'aider svp ?

Voici la capture d'écran de ce que je souhaite avoir en automatique :

Pièce jointe 391662

Voici le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
 
 
 
Sub ExtraireParGroupeColonneB()
Dim O As Long, NbLg As Long
Dim n As Integer
Dim H1 As Worksheet
Dim Mondico As Object
Dim Tablo
Dim Interdits
Dim ligne
 
  Interdits = Array("&", ":", "/", "\", "~?", "~*", "[", "]", Chr(34))
 
  Application.ScreenUpdating = False
 
  Application.DisplayAlerts = False
 
 
  Application.DisplayAlerts = True
 
 
 
  Set H1 = Sheets("BD")
  If H1.FilterMode = True Then H1.ShowAllData
  NbLg = H1.Range("A" & Rows.Count).End(xlUp).Row
 
rep = InputBox("Choisir la lettre de la colonne pour la création de fiches", "CREATION DE FICHES PAR GROUPES", "B")
 
  H1.Columns(rep).Copy H1.Columns("O")
 
  With H1.Range("O2:O" & NbLg)
    For n = 0 To UBound(Interdits)
      .Replace what:=Interdits(n), replacement:="_", lookat:=xlPart
    Next n
 
  End With
 
  Set Mondico = CreateObject("Scripting.dictionary")
  For O = 2 To NbLg
    Mondico(H1.Range("O" & O).Value) = ""
  Next O
 
  H1.Range("O1:P1") = "XYZ"
 
  Tablo = Mondico.keys
  For n = 0 To UBound(Tablo)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(n)
    Sheets("Modèle").UsedRange.Copy
    Sheets(Tablo(n)).Range("A1").PasteSpecial
 
 
    With Sheets(Tablo(n))
      .Range("A2") = Tablo(n)
      H1.Range("P2") = Tablo(n)
 
        For Each cel In H1.Range("G2:G" & NbLg) 'pour chaque cellule de G2 à G_DernièreLigne
            r = cel.Row
            noms = H1.Range("C" & r)
            If H1.Range(rep & r) = Tablo(n) Then
                c = .Range("A1000").End(xlUp).Row + 1
                If .Range("A9") = "" Then
                    H1.Range("C" & r & ":H" & r).Copy 'Copie de C à H feuille BD
                    .Range("A" & c).PasteSpecial xlPasteValues 'Colle depuis A feuille modèle
                End If
 
                If Not .Range("E9:E" & c).Find(cel) Is Nothing And Not .Range("A9:A" & c).Find(noms) Is Nothing Then
                'Si le numero de pièce existe déjà dans la feuille modèle alors...
                Set ligne = .Range("E9:E" & c).Find(cel) 'on trouve la ligne correspondante
                    If Not ligne Is Nothing And .Range("A" & ligne.Row) <> noms Then
                        Flig = ligne.Row
                        Do
                            cel.Value = cel
                            Set ligne = .Range("E9:E" & c).FindNext(.Range("E" & Flig))
                            ligne = ligne.Row
                        Loop While ligne = Flig And .Range("A" & ligne) <> noms
                    Else
                    ligne = ligne.Row
                    End If
remp:
                    'On prend chaque cas de compte et on vient mettre le débit et crédit dans les colonnes correspondantes
                    If H1.Range("A" & r) = "VACANCES - COLOS" Then .Range("G" & ligne) = .Range("G" & ligne) + H1.Range("I" & r): .Range("H" & ligne) = .Range("H" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "ALIMENTATION A L'EXTERIEUR." Then .Range("I" & ligne) = .Range("I" & ligne) + H1.Range("I" & r): .Range("J" & ligne) = .Range("J" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "AUTRES REMB.FRAIS GR 1" Then .Range("N" & ligne) = .Range("N" & ligne) + H1.Range("J" & r): .Range("M" & ligne) = .Range("M" & ligne) + H1.Range("I" & r)
                Else
                    H1.Range("C" & r & ":H" & r).Copy
                    .Range("A" & c).PasteSpecial xlPasteValues
                    ligne = c
                    GoTo remp
                End If
 
            End If
 
 
        Next cel
 
           ActiveWindow.DisplayOutline = False
 
 
 
    End With
 
      'ICI AJUSTER LIGNES ET COLONNES
 
    Call MiseEnPageFeuilleModeleColonnesEtLignes
 
  Next n
 
  H1.Columns("O:P").Clear
  H1.Select
 
 
End Sub

26/06/2018, 17h16
Pierre Fauconnier

Qu'entends-tu pas "créer les fiches". Il y a un filtre à appliquer? Un regroupement? Une simple permutation de colonnes et quelques formules?

Première remarque: travailler avec des tableaux structurés. Ce sera plus simple à manipuler, et en Excel, et en VBA.
26/06/2018, 23h38
Stéphanie57

1 pièce(s) jointe(s)

création des fiches

Qu'entends-tu pas "créer les fiches".

Pour moi la créatoin de fiches c'est l'extraction de données depuis une base de donnée pour créer d'autres onglets bien précis.

exemple : Nous travaillons dans un centre éducatif pour enfants, dans notre établissement, il existe plusieurs lieu de vie, les enfants de 5 à 10 ans, les enfants de 11 à 15 ans et les enfants de 16 ans à 17 ans, il existe donc 3 groupes de vie. Ce que je souhaite avoir dans la création de fiches, c'est les dépenses de plusieurs comptes comptables répartient pour les 3 groupes de vie, donc 3 onglets, un onglet groupe de vie 1, un onglet groupe de vie 2 et un onglet groupe de vie 3.

Il y a effectivement un regroupement à faire, mais la complication est dans le regroupement des lignes comptables avec le point commun qui est le numéro de la pièce comptable, je m'expliques :

exemple d'écriture comptable : N° pièce comptable ACE10/015 - Groupe de vie : ARTISTES

Au débit : compte vacance pour 100 euros
compte alimentation pour 30 euros

Au crédit : compte fournisseur pour 90 euros
compte Rembt Caf pour 40 euros

J'aurai donc dans l'onglet ARTISTES :

Pièce jointe 391854

Première remarque: travailler avec des tableaux structurés. Ce sera plus simple à manipuler, et en Excel, et en VBA.

Que proposes-tu en excel et en VBA ?
27/06/2018, 12h07
Pierre Fauconnier

Salut.

Question présentation, ce n'est pas toujours top, mais les TCD permettraient une approche assez rapide à mettre en place.

Sinon, on peut envisager de boucler. De combien de lignes se compose le tableau de base?

Une autre approche serait d'extraire les pièces sans doublon, de les placer dans le tableau de présentation et de remplir les autres colonnes avec INDEX/EQUIV en matricielle. Cela pourrait être assez rapide en VBA. Après, en fonction du compte, on filtre sur la colonne et on n'a ainsi qu'un seul tableau de résultat à adapter par filtre pour la présentation.
27/06/2018, 12h37
Stéphanie57

TCD

Je n'ai jamais été à l'aise avec les TCD, je préfère la seconde proposition, boucler pour enfin boucler le fichier :ptdr::ptdr::ptdr:

ta logique me convient, extraire les sans doublon...

Citation:

Envoyé par Pierre Fauconnier

Salut.

Question présentation, ce n'est pas toujours top, mais les TCD permettraient une approche assez rapide à mettre en place.

Sinon, on peut envisager de boucler. De combien de lignes se compose le tableau de base?

Une autre approche serait d'extraire les pièces sans doublon, de les placer dans le tableau de présentation et de remplir les autres colonnes avec INDEX/EQUIV en matricielle. Cela pourrait être assez rapide en VBA. Après, en fonction du compte, on filtre sur la colonne et on n'a ainsi qu'un seul tableau de résultat à adapter par filtre pour la présentation.

2 pièce(s) jointe(s)

Je te propose une solution qui s'appuie sur les propriétés des tableaux structurés, notamment

le fait qu'une formule peut utiliser des références structurées;
que cette référence peut être utilisée en VBA pour borner rapidement;
qu'une formule dans une colonne se propage aux nouvelles lignes;
que si l'on supprime les lignes du tableau, Excel mémorise la formule et la restitue lors de l'ajout de nouvelles lignes.

Sur base de cela, on créer les formules en Excel dans le tableau final, puis on utilise un code qui

supprimer les lignes du tableau final;
ajoute toutes les pièces;
supprime les doublons.

La mécanique des tableaux structurés fait le reste.

Voici les formules à utiliser dans le tableau. J'ai appelé le tableau source t_Mouvements et le tableau final t_Analyse. Les formules illustrées doivent être recopiées dans les bonnes colonnes par copier-coller (pas par drag&drop!!) et les noms des colonnes doivent être adaptées. Après que ce décor soit planté, le code "métier" tient en trois lignes (avec quelques lignes en plus pour accélérer si gros tableau)

Pièce jointe 392060

Pièce jointe 392062
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Sub ClearTable(TableName As String) If Not Range(TableName).ListObject Is Nothing Then If Range(TableName).ListObject.ListRows.Count > 0 Then _ Range(TableName).ListObject.DataBodyRange.Delete End If End Sub Sub Treatment() Dim Calculation As XlCalculation On Error GoTo EndHandler Calculation = Application.Calculation Application.ScreenUpdating = False ClearTable "t_Analyse" Range("t_Mouvements[Pièce]").Copy Destination:=Range("t_Analyse[Pièce]") Range("t_Analyse").RemoveDuplicates Columns:=Range("t_Analyse").ListObject.ListColumns("Pièce").Index, Header:=xlYes EndHandler: Application.Calculation = Calculation Application.ScreenUpdating = False If Err.Number <> 0 Then MsgBox "Erreur durant le traitement", vbExclamation End Sub
[EDIT] Si, pour une raison ou une autre, tu ne peux pas avoir un tableau structuré pour présenter l'analyse, nous devrons ajouter quelques lignes de code pour ajouter les formules après la suppression des doublons.

27/06/2018, 15h00
Stéphanie57

suite

Tout d'abord Merci infiniment pour avoir pris le temps de travailler dessus, je vais regarder et tester, je reviens vers toi dès que c'est fait.

Merci encore:D:D:D:D:D