Macro Excel sur plusieurs ordinateurs

Version imprimable

2 pièce(s) jointe(s)

Bonjour,
Je travaille avec Excel de Office famille et petite entreprise 2021
Sur Windows 10
J'ai fait un fichier Excel pour nos retours des boutiques.
Chaque boutique devra l'utiliser mais ma macro ne fonctionne plus sur les autres ordinateurs.
Mon classeur contient 3 onglets (Formulaire, Retour et Donne)

Pièce jointe 637883 Pièce jointe 637884

J'ai 3 macro
1 pour copier les informations dans l'onglet retour
1 pour effacer les données
1 pour envoyer un email
J'ai 3 macros
1 pour copier les informations dans l'onglet retour
1 pour effacer les données
1 pour envoyer un email
La macro pour copier donne des erreurs.
Erreur 32809
Dans le debug ça bloque au ligne :
Worksheets("Formulaire").Activate
J’ai testé sheets("Formulaire"). select
J’ai regardé sur le forum et je n’ai pas réussi à régler ou ça bloque.
Merci de m’aider

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
Sub Copie()
'
' Macro3 Macro
 
'enleve la fusion de la description du probleme
   Worksheets("Formulaire").Activate
     Range("B15:G17").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.UnMerge
    'copie de la date
    Range("D4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Activate
    Range("b2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'copie de la Boutique
    Worksheets("Formulaire").Select
    Range("D6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Activate
    Range("c2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     'copie de la Votre nom
    Worksheets("Formulaire").Select
    Range("D8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("d2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      'copie de la Fournisseur
    Worksheets("Formulaire").Select
    Range("D10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("e2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     'copie de la Skue
    Worksheets("Formulaire").Select
    Range("C12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("f2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      'copie de la Qte
    Worksheets("Formulaire").Select
    Range("G12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("g2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      'copie de la Probleme
    Worksheets("Formulaire").Select
    Range("B15").Select
    Selection.Copy
    Worksheets("Retour ").Select
    Range("h2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Worksheets("Formulaire").Select
 
       'copie du # transfer
    Worksheets("Formulaire").Select
    ActiveWindow.SmallScroll Down:=3
    Range("d19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("i2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'copie de la commande
    Worksheets("Formulaire").Select
    ActiveWindow.SmallScroll Down:=3
    Range("d23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("j2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'copie de la Cliente
    Worksheets("Formulaire").Select
    ActiveWindow.SmallScroll Down:=3
    Range("d25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("k2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  'copie date d'achat
    Worksheets("Formulaire").Select
    Range("d27").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Select
    Range("l2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ' Fusion des cellules de la description du probleme
     Worksheets("Formulaire").Select
    Range("B15:G17").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
          End With
          'ajout d'une ligne
           Worksheets("Retour ").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    'Worksheets("Formulaire").Protect
   ' Worksheets("Retour ").Protect
End Sub
Sub effacer()
'effache le formulaire avec un message box pour confirmer clique sur le oui ca efface et sur le non ca fait rien
    If MsgBox("Etes-vous certain de vouloir effacer le contenu  ?", vbYesNo, "Demande de confirmation") = vbYes Then
        Range("D6,D8,D10,C12,B15:G17,D19,D23,D25").ClearContents
        MsgBox "Le contenu a été effacé !"
    End If
    End Sub
 
Sub email()
 'Déclaration des variables
    Dim MaMessagerie As Object
    Dim MonMessage As Object
    Dim MaSignature As String
 
    'on affecte les variables de type objet - initialisation des variables - Set
    Set MaMessagerie = CreateObject("Outlook.Application")
    Set MonMessage = MaMessagerie.CreateItem(0)
    'On affiche le mail
    MonMessage.Display
    MaSignature = MonMessage.HTMLBody
 
    'On construitle message
    With MonMessage
    'L'adresse du destinataire
    .To = "mon@email"
    .CC = "autre @email"
    'On affiche l'objet du mail
    .Subject = "Retour défectueux" & " " & Range("d10") & " " & Range("d6")
    'on affiche le corps du mail
    .HTMLBody = "<p style='font-family:Calibri;font-size:16'>" & _
    "<br><br>" & "Bonjour" & _
    "<br><br>" & "Nous avons un(des) retour(s) d'item(s) défectueux à faire :" & "<br><br>" & _
    "<br>" & "Quantité:" & " " & Range("g12") & "<br>" & _
    "<br>" & "Skue:" & " " & Range("c12") & "<br>" & _
    "<br>" & "Description du problème:" & "<br>" & _
    Range("b15") & "<br>" & _
    "<br>" & "# Transfer " & " " & Range("d19") & "<br>" & _
    "<br>" & "# de Commande:" & Range("d23") & "<br>" & _
    "Nom de la cliente" & " " & "" & Range("d25") & " " & _
         "<br>" & "Voir photo ci-jointe (1 item) " & "<br><br>" & _
     "<br><br><br><br>" & "Ne pas oublier d'inclure photo du probleme et de l'étiquette." & _
    "<br>" & "Merci et bonne journée!" & "<br><br>" & MaSignature
        'd19 Produit 1 defectueux
        'd20 Produit 1 Raison
    .Display 'affiche le mail avant de l'envoyer
    End With
End Sub

Dans les boutiques, ils utilisent la même version d'office que toi ? ou des plus anciennes ?
En principe, tu peux te passer de activate et select

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Sub Copie()
'
' Macro3 Macro
 
'enleve la fusion de la description du probleme
    With Worksheets("Formulaire").range("B15:G17")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .UnMerge
     End With
 
    'copie de la date
    Range("D4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("b2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'copie de la Boutique
    Worksheets("Formulaire").Range("D6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("c2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     'copie de la Votre nom
    Worksheets("Formulaire").Range("D8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("d2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      'copie de la Fournisseur
    Worksheets("Formulaire").Range("D10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("e2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     'copie de la Skue
    Worksheets("Formulaire").Range("C12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("f2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      'copie de la Qte
    Worksheets("Formulaire").Range("G12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("g2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      'copie de la Probleme
    Worksheets("Formulaire").Range("B15").Select
    Selection.Copy
    Worksheets("Retour ").Range("h2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Worksheets("Formulaire").Select
 
       'copie du # transfer
    Worksheets("Formulaire").Range("d19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("i2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'copie de la commande
    Worksheets("Formulaire").Range("d23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("j2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        'copie de la Cliente
    Worksheets("Formulaire").Range("d25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("k2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  'copie date d'achat
    Worksheets("Formulaire").Range("d27").Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Retour ").Range("l2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ' Fusion des cellules de la description du probleme
     Worksheets("Formulaire").Range("B15:G17").Select
    Application.CutCopyMode = False
    With Selection
        .Merge
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
       End With
          'ajout d'une ligne
    Worksheets("Retour ").Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    'Worksheets("Formulaire").Protect
   ' Worksheets("Retour ").Protect
End Sub
 
Sub effacer()
'effache le formulaire avec un message box pour confirmer clique sur le oui ca efface et sur le non ca fait rien
    If MsgBox("Etes-vous certain de vouloir effacer le contenu  ?", vbYesNo, "Demande de confirmation") = vbYes Then
        Range("D6,D8,D10,C12,B15:G17,D19,D23,D25").ClearContents
        MsgBox "Le contenu a été effacé !"
    End If
    End Sub
 
Sub email()
 'Déclaration des variables
    Dim MaMessagerie As Object
    Dim MonMessage As Object
    Dim MaSignature As String
 
    'on affecte les variables de type objet - initialisation des variables - Set
    Set MaMessagerie = CreateObject("Outlook.Application")
    Set MonMessage = MaMessagerie.CreateItem(0)
    'On affiche le mail
    MonMessage.Display
    MaSignature = MonMessage.HTMLBody
 
    'On construitle message
    With MonMessage
    'L'adresse du destinataire
    .To = "mon@email"
    .CC = "autre @email"
    'On affiche l'objet du mail
    .Subject = "Retour défectueux" & " " & Range("d10") & " " & Range("d6")
    'on affiche le corps du mail
    .HTMLBody = "<p style='font-family:Calibri;font-size:16'>" & _
    "<br><br>" & "Bonjour" & _
    "<br><br>" & "Nous avons un(des) retour(s) d'item(s) défectueux à faire :" & "<br><br>" & _
    "<br>" & "Quantité:" & " " & Range("g12") & "<br>" & _
    "<br>" & "Skue:" & " " & Range("c12") & "<br>" & _
    "<br>" & "Description du problème:" & "<br>" & _
    Range("b15") & "<br>" & _
    "<br>" & "# Transfer " & " " & Range("d19") & "<br>" & _
    "<br>" & "# de Commande:" & Range("d23") & "<br>" & _
    "Nom de la cliente" & " " & "" & Range("d25") & " " & _
         "<br>" & "Voir photo ci-jointe (1 item) " & "<br><br>" & _
     "<br><br><br><br>" & "Ne pas oublier d'inclure photo du probleme et de l'étiquette." & _
    "<br>" & "Merci et bonne journée!" & "<br><br>" & MaSignature
        'd19 Produit 1 defectueux
        'd20 Produit 1 Raison
    .Display 'affiche le mail avant de l'envoyer
    End With
End Sub

PS: j'ai simplifié toutes les sélections qui étaient sur 2 lignes (c'est inutile); On voit que ça vient d'un enregistrement de macro :mrgreen: il faut toujours la nettoyer un peu après
PS2: Je note que ta feuille Retour contient un espace à la fin de son nom (="Retour "); en soit ce n'est pas gênant, mais ça peut être une source d'erreur bête

27/04/2023, 17h44
clochette033

2 pièce(s) jointe(s)

Citation:

Envoyé par umfred

Dans les boutiques, ils utilisent la même version d'office que toi ? ou des plus anciennes ? ( oui c'est a même version)
En principe, tu peux te passer de activate et select

PS: j'ai simplifié toutes les sélections qui étaient sur 2 lignes (c'est inutile); On voit que ça vient d'un enregistrement de macro :mrgreen: il faut toujours la nettoyer un peu après (merci)
PS2: Je note que ta feuille Retour contient un espace à la fin de son nom (="Retour "); en soit ce n'est pas gênant, mais ça peut être une source d'erreur bête

(corrigée)

J'ai copier ton code et quand je test sur mon pc j'ai le message d'erreur 1004
Pièce jointe 637943
le debug arrete a Worksheets("Retour").Range("b2").Select
Pièce jointe 637944
Merci
27/04/2023, 18h39
clochette033

resolu

J’ai trouvé la solution.
Le problème était au niveau de la date d’achat.
J’avais inséré un contrôle activeX pour choisir la date, J’ai supprimé le contrôle et ça fonctionne
merci
27/04/2023, 19h02
umfred

étrange :weird: mais bon si le problème est résolu