Amélioration/Correction syntaxe macro

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Deuxième post sur le forum, débutant en VBA, l'indulgence est de mise :)

J'ai codé la macro suivante, et j’aimerai améliorer la syntaxe du code.

Si les HardCoderz du forum peuvent y apporter des corrections/améliorations, tout en m'expliquant pourquoi, je suis preneur !

Comment ce code doit marcher ?
1) j'ouvre le fichier excel avec le modul VBA comportant le code ci-dessous
2) j’ouvre test.xls (cf fichier ci-joint)
3) je lance le code

Merci et j'attends vos feedback

Cheers !

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
 
Sub test_v3()
 
On Error GoTo Mysolution:
 
Dim libdufd As String, datedujour As Date, msgdumail As String, isin As String, Message As String, ListeMail As String
libdufd = Range("D3")
datedujour = FormatDateTime(Date, vbShortDate)
msgdumail = "Fichier de collecte " & libdufd & " au " & datedujour
isin = Range("B3")
Message = "Souhaitez-vous envoyer le fichier ? "
correspondance = "Le CHEMIN DU FICHIER .XLS DANS LEQUEL rech_isin cherche isin"
 
 
If Left(isin, 2) = "FR" Then
        type_val = 0
Else
        type_val = 1
End If
 
If type_val = 0 Then
Exit Sub
Else
Range("B3").Select
Workbooks.Open (correspondance)
ActiveWorkbook.RunAutoMacros xlAutoOpen
Worksheets("ETR centralisés").Activate 'ETR centralisés  est le nom du sheet du fichier correspondance.xls
End If
 
Range("A1").Activate
Range("A1:A1000").Select
 
rech_isin = Cells.Find(isin, LookIn:=xlValues).Activate 'Le On Error GoTo Mysolution: est important ici car si le code
                                                        'en "B3" n'est pas trouvé dans onglet "ETR centralisés" j'ai une
                                                        'error 91
 
ActiveCell.Select
ActiveCell.Offset(0, 16).Select     'Les adresses email se trouvent dans la colonne Q du sheet ETR centralisés du workbook correspondance
ListeMail = ActiveCell.Value
 
If ListeMail = "" Then
Rep = MsgBox("Aucun contact n'est paramètré", vbOK)
ActiveWorkbook.Close
Exit Sub
Else
Rep = MsgBox(Message, vbYesNo)
End If
If Rep = vbNo Then
ActiveWorkbook.Close
Exit Sub
End If
 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error Resume Next
With OutMail
    .To = ListeMail
ActiveWorkbook.Close 'je ferme le fichier correspondance.xls pour attacher au mail le fichier test.xls
    .CC = "XXXX@YY.com"
    .Subject = "collecte de " & libdufd
    .Body = msgdumail
    .Attachments.Add ActiveWorkbook.FullName
    .display '.Send
End With
On Error GoTo 0
 
Set OutMail = Nothing
Set OutApp = Nothing
 
ActiveWorkbook.Close
 
Exit Sub
 
Mysolution:
If Err.Number = 91 Then
Rep = MsgBox("Le code " & isin & " n'est pas renseigné", vbOK)
ActiveWorkbook.Close
ActiveWorkbook.Close
Exit Sub
End If
 
End Sub

16/08/2013, 20h02
parmi
Bonjour,

Tu pourrais commencé par enlever tous les Select/Activate qui ne sont pas nécessaires.

Quand tu utilises Find et que tu veuilles éviter les erreurs si non trouvé, fais comme ceci
Code:

1 2 3 4 5 6 Set MaValeur = Cells.Find(Valeur,....) If Not MaValeur Is Nothing Then 'Valeur trouvée End If ..... Set MaValeur = Nothing 'toujours mettre à Nothing les variables initialisées avec Set
C'est un départ...

Bonsoir parmi,

Merci encore de répondre à mon post.

J'ai suivi tes conseils, et voila ce que je propose, as tu d'autres corrections/améliorations à apporter ? Qu'en penses-tu ?

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
 
Sub test_v3()
 
Dim libdufd As String, datedujour As Date, msgdumail As String, isin As String, Message As String, ListeMail As String
libdufd = Range("D3")
datedujour = FormatDateTime(Date, vbShortDate)
msgdumail = "Fichier de collecte " & libdufd & " au " & datedujour
isin = Range("B3")
Message = "Souhaitez-vous envoyer le fichier ? "
correspondance = "Le CHEMIN DU FICHIER .XLS DANS LEQUEL rech_isin cherche isin"
 
 
If Left(isin, 2) = "FR" Then
        type_val = 0
Else
        type_val = 1
End If
 
If type_val = 0 Then
Exit Sub
Else
Workbooks.Open (correspondance)
ActiveWorkbook.RunAutoMacros xlAutoOpen
Worksheets("ETR centralisés").Activate 'ETR centralisés  est le nom du sheet du fichier correspondance.xls
End If
 
 
Set MonIsin = Range("A1:A1000").Find(isin, LookIn:=xlValues)
If Not MonIsin Is Nothing Then
ListeMail = MonIsin.Offset(0, 16).Value
Else
Rep = MsgBox("Le code " & isin & " n'est pas renseigné dans le fichier Fonds ETR centralisés", vbOK)
ActiveWorkbook.Close
ActiveWorkbook.Close
End If
 
 
If ListeMail = "" Then
Rep = MsgBox("Aucun contact n'est paramètré", vbOK)
ActiveWorkbook.Close
Exit Sub
Else
Rep = MsgBox(Message, vbYesNo)
End If
 
If Rep = vbNo Then
ActiveWorkbook.Close
Exit Sub
End If
 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error Resume Next
With OutMail
    .To = ListeMail
ActiveWorkbook.Close 'je ferme le fichier correspondance.xls pour attacher au mail le fichier test.xls
    .CC = "XXXX@YY.com"
    .Subject = "collecte de " & libdufd
    .Body = msgdumail
    .Attachments.Add ActiveWorkbook.FullName
    .display '.Send
End With
On Error GoTo 0
 
Set OutMail = Nothing
Set OutApp = Nothing
 
Set MonIsin = Nothing
 
ActiveWorkbook.Close
 
 
End Sub

16/08/2013, 21h59
parmi

Ça me semble pas mal bien.

Au cas où... lorsque je vérifie du texte, j'utilise UCase ou LCase au cas où la casse serait différente. Dans ton cas, peut-être que FR sera toujours en majuscules. Ça, c'est toi qui le sais...;)

J'écrirais

Code:

If Left(UCase(isin), 2) = "FR" Then

Aussi, les parenthèses ne sont pas nécessaires quand tu écris

Code:

Workbooks.Open (correspondance)

sauf si tu écris Call devant

Mais ce sont de petits détails...

Bonne continuation ! :ccool:
16/08/2013, 22h06
daddygraffiti

Effectivement dans mon cas "FR" est toujours en majuscule mais merci du conseil ! (je ne connaissais pas cette formule)

Bonne continuation et bon week end !

Cheers !