Exécution répétitive

Version imprimable

29/12/2008, 16h50
NELAIN

Exécution répétitive

Bonjour,

J'ai un feuille dans excel comprenant sur chaque ligne
un nom de destinataire
une case à cocher
une adresse destinataire

cette feuille (feuil1)doit être protéger en écriture pour tous les utilisateurs
j'ai donc fait une deuxième feuille (feuil2) avec les mêmes infos mais les adresses en moins

Derriére j'ai du code en vba, qui supprime toutes les cases à cocher puis recopie toute modif faite sur la feuil1 dans feuil2 et enfin crée une case à cocher sur toutes les lignes comprenant une adresse de messagerie.

Mon pb est que lorsque je lance cette macro la première fois c'est ok, la deuxième fois sans modif ni rien il me génére un message d'erreur

Citation:

Bibliothèque d'objets incorrecte ou contenant des références à des définitions d'objets introuvables

Et lorsque je relance une 3eme fois pour voir où se trouve l'erreur il me retourne l'erreur suivante dés le lancement de la macro " 8002802b erreur automation élément introuvable" Cette dernière je la comprend moins puisque l'élément correpond à ma feuil1 toujours présente et orthographiée pareille

merci pour votre aide car là je ne voit pas du tout de quoi ça peux venir

ps : une fois que j'ai eu le pb " 8002802b erreur automation élément introuvable" même en fermant le fichier il apparait à chaque lancement

bonne journée
cn

voici une partie de mon code la ligne en bleu est concernée par la deuxième erreur et partout ou je fais référence à la feuille ("Tbd Envoi Annexes Mobile"). J'ai un pb (sauf à la toute première éxécution)

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
Sub MAJAdr()
Dim rep As String
rep = MsgBox("Etes vous sur de vouloir faire la mise à jour du listing adresses ?", vbOKCancel)
 
Select Case rep
Case 1
    suppcheckBox
    CopieAdr
    InsertCheckBox
    MsgBox "Mise à jour terminée"
Case Else
End Select
 
End Sub
------------------------------------------------------
Sub InsertCheckBox()
On Error GoTo Err_InsertCheckBox
 
Dim i As Integer
Dim n As Integer
Dim posleft As Variant
Dim postop As Variant
Dim posWidth As Variant
Dim posHeight As Variant
Dim car As String
 
car = ","
 
Initvar
 
For i = 2 To NbLigne
    Sheets("listing adresses").Select
    If Trim(Range("G" & i)) <> "" Then
    
        Sheets("Tbd Envoi Annexes Mobile").Select
        posleft = Replace(Range("C" & i).Left, car, ".")
        postop = Replace(Range("C" & i).Top, car, ".")
        posWidth = Replace(Range("C" & i).Width, car, ".")
        posHeight = Replace(Range("C" & i).Height, car, ".")
        
        ActiveSheet.CheckBoxes.Add(posleft, postop, posWidth, posHeight).Select
        
        With Selection
        .Value = True
        .LinkedCell = "H" & i
        .Text = ""
        .Display3DShading = True
        End With
    End If
Next
Exit_InsertCheckBox:
    Exit Sub
 
Err_InsertCheckBox:
MsgBox Err.Description
Resume Exit_InsertCheckBox
End Sub
 ---------------------------------------------------------------
Sub suppcheckBox()
Dim i As Integer
 
CptLigne
 
For i = 2 To NbLigne
    Range("H" & i) = ""
Next
ActiveSheet.CheckBoxes.Delete
 
End Sub
 ---------------------------------------------------------------
Sub CopieAdr()
'
' CopieAdr Macro
' Macro enregistrée le 28/11/2008 par dqsf6548
   Worksheets("listing adresses").Select
    Columns("A:F").Select
    Selection.Copy
    Worksheets("Tbd Envoi Annexes Mobile").Select
    Cells.Select
    ActiveSheet.Paste
End Sub

Bonjour,

Je ne vois pas où est l'erreur. J'ai fait tourné ton code et ça marche. Je me permets cependant d'améliorer ton code pour éviter les "Select".
Autre point, dans ton code, tu commences par faire "suppcheckBox". Cette procédure ne précise pas dans quelle feuille tu fais le traitement. Du coup, elle peut le faire n'importe où. Je l'ai de plus simplifiée.

Autre point, tu fais

Code:

posleft = Replace(Range("C" & i).Left, car, ".")

.
Tu le fais parce que le séparateur décimal sous windows doit être le point alors que sous Excel c'est la virgule (ou le contraire !) Pour éviter cela, il suffit d'harmoniser les deux systèmes (Windows et Excel) pour n'avoir que le point comme séparateur décimal.
Dernier point, j'ai créé deux sous-programmes Initvar et CptLigne qui sont appelés dans ton code mais que tu n'as pas donné. Apparemment, ces sous-programmes permettent de calculer (entre autre) Nbligne

Voici donc le code corrigé. Dis-moi si cela a résolu ton problème.
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 Dim Nbligne As Integer Sub MAJAdr() Dim rep As String rep = MsgBox("Etes vous sur de vouloir faire la mise à jour du listing adresses ?", vbOKCancel) Select Case rep Case 1 suppcheckBox CopieAdr InsertCheckBox MsgBox "Mise à jour terminée" Case Else End Select End Sub Sub Initvar() Nbligne = 10 End Sub Sub CptLigne() Nbligne = 10 End Sub Sub InsertCheckBox() On Error GoTo Err_InsertCheckBox Dim i As Integer Dim n As Integer Dim posleft As Variant Dim postop As Variant Dim posWidth As Variant Dim posHeight As Variant Dim car As String car = "," Initvar For i = 2 To Nbligne If Trim(Sheets("listing adresses").Range("G" & i)) <> "" Then With Worksheets("Tbd Envoi Annexes Mobile").Range("C" & i) posleft = .Left postop = .Top posWidth = .Width posHeight = .Height End With Set Nomchkbox = Worksheets("Tbd Envoi Annexes Mobile").CheckBoxes.Add(posleft, postop, posWidth, posHeight) With Nomchkbox .Value = True .LinkedCell = "H" & i .Text = "" .Display3DShading = True End With End If Next Exit_InsertCheckBox: Exit Sub Err_InsertCheckBox: MsgBox Err.Description Resume Exit_InsertCheckBox End Sub Sub suppcheckBox() With Worksheets("Tbd Envoi Annexes Mobile") .Columns("H:H").ClearContents .CheckBoxes.Delete End With End Sub Sub CopieAdr() ' ' CopieAdr Macro ' Macro enregistrée le 28/11/2008 par dqsf6548 Worksheets("listing adresses").Columns("A:F").Copy Destination:= _ Worksheets("Tbd Envoi Annexes Mobile").Cells End Sub
Didier

Bonjour didier,
Tout d'abord merci de ton aide
J'ai insérer ton code dans mom module mais j'ai toujours mon pb peux tu me donner une adresse email afin que je te transfert mon fichier pour que tu puisses voir.

par avance merci.

carina

Citation:

Voici donc le code corrigé. Dis-moi si cela a résolu ton problème.

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
Dim Nbligne As Integer
Sub MAJAdr()
Dim rep As String
rep = MsgBox("Etes vous sur de vouloir faire la mise à jour du listing adresses ?", vbOKCancel)
 
Select Case rep
Case 1
    suppcheckBox
    CopieAdr
    InsertCheckBox
    MsgBox "Mise à jour terminée"
Case Else
End Select
 
End Sub
Sub Initvar()
Nbligne = 10
End Sub
Sub CptLigne()
Nbligne = 10
End Sub
Sub InsertCheckBox()
On Error GoTo Err_InsertCheckBox
 
Dim i As Integer
Dim n As Integer
Dim posleft As Variant
Dim postop As Variant
Dim posWidth As Variant
Dim posHeight As Variant
Dim car As String
 
car = ","
 
Initvar
 
For i = 2 To Nbligne
    If Trim(Sheets("listing adresses").Range("G" & i)) <> "" Then
 
        With Worksheets("Tbd Envoi Annexes Mobile").Range("C" & i)
            posleft = .Left
            postop = .Top
            posWidth = .Width
            posHeight = .Height
        End With
 
        Set Nomchkbox = Worksheets("Tbd Envoi Annexes Mobile").CheckBoxes.Add(posleft, postop, posWidth, posHeight)
        With Nomchkbox
        .Value = True
        .LinkedCell = "H" & i
        .Text = ""
        .Display3DShading = True
        End With
    End If
Next
Exit_InsertCheckBox:
    Exit Sub
 
Err_InsertCheckBox:
MsgBox Err.Description
Resume Exit_InsertCheckBox
End Sub
Sub suppcheckBox()
With Worksheets("Tbd Envoi Annexes Mobile")
    .Columns("H:H").ClearContents
    .CheckBoxes.Delete
End With
 
End Sub
Sub CopieAdr()
'
' CopieAdr Macro
' Macro enregistrée le 28/11/2008 par dqsf6548
   Worksheets("listing adresses").Columns("A:F").Copy Destination:= _
    Worksheets("Tbd Envoi Annexes Mobile").Cells
End Sub

Didier

01/01/2009, 19h19
DidierLoche
Bonjour Carina,

Tout d'abord, Bonne année !

Je pensais que le problème venait des librairies installées. En virant des librairies inutiles, ça s'est mis à fonctionner. Mais en suite, ça a planté dans CopieAdr. Depuis, le même problème réapparait.
J'ai "refabriqué" les feuilles Tbd Envoi Annexes Mobile et Listing adresses et ça a remarché.
Quand le sous-programme CopieAdr s'execute, la copie suivante est longue à se faire (NbLigne = 131) :
Code:

1 2 Worksheets("listing adresses").Range(Cells(1, 1), Cells(NbLigne, 6)).Copy Destination:= _ Worksheets("Tbd Envoi Annexes Mobile").Cells(1, 1)
et à la fin, on a droit au message suivant :

Citation:

Can't enter break mode at this time

Quand on relance la macro, VBA plante au même endroit mais avec ce message d'erreur :

Citation:

Run-time error '1004':
Application-defined or object-defined error

Personnellement, je sèche ! Est-ce que quelqu'un pourrait prendre le relais pour aider Carina ?

Didier
02/01/2009, 17h59
pgz

Bonjour Didier, Carina et le forum.

C'est quelle version d'Excel?

PGZ
02/01/2009, 18h33
DidierLoche

Bonjour,

Je suis sur E-03.

Je pense que la feuille que Carina cherche à copier est vérolée mais je ne vois pas où.

Didier
02/01/2009, 18h59
pgz

Je veux bien regarder.

PGZ