Discussion :

[NELAIN]

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

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

[NELAIN]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[DidierLoche]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[NELAIN]

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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 :

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

[pgz]

Bonjour Didier, Carina et le forum.

C'est quelle version d'Excel?

PGZ