Amélioration de mes macros

**chouchouboy** · 08/10/2010, 19h39

Bonjour,
Je suis en train de réaliser un fichier qui permet de gérer une facturation client pour une entreprise.
Les clients paient des honoraires au mois, au trimestre (en 3 ou 4 acomptes), au semestre et à l'année.
Du coup, avec ce que j'ai fait je dois utiliser une macro pour changer les formules certains cellules en fonction de ces différents paramètres.
Voici mes 2 macros (attention, je suis débutant et je pique des bouts de codes ici et là pour que ça marche).

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
82
Sub changement_formule_honoraires_client_sans_remise()
 
ActiveSheet.Unprotect
Dim lig, col, col_ex, col_tampon_num_ex, col_honoraires,  col_tampon_hono_n_1, col_tampon_hono_n_2, col_nouveau, col_hono_base
 
'initialisation des variables
    col = "AJ" 'colonne contenant la cellule à modifier (cellule de départ)
    col_ex = "AF" 'colonne contenant le n° de l'exercice
    col_tampon_num_ex = "AG" 'colonne tampon qui recopie le n° de l'exercice
    col_tampon_hono_n_1 = "AH" 'colonne contenant la recopie des honoraires de N-1
    col_tampon_hono_n_2 = "AI" 'colonne contenant la recopie des honoraires de N-2
    col_honoraires = "AN" 'colonne des honoraires de N+1
    col_nouveau = "Z" 'colonne qui définit si le client est un nouveau client ou non
    col_hono_base = "AA" 'colonne qui contient les honoraires de base
    If ActiveCell.Row <= 8 Then
    lig = ActiveCell.Row
    ElseIf ActiveCell.Row > 8 Then
    lig = ActiveCell.Row + 1
    Else: lig = ActiveCell.Row + 1
    End If
 
Application.ScreenUpdating = False
 
Columns(col_tampon_num_ex & ":" & col_tampon_hono_n_2).EntireColumn.Hidden = False
 
Cells(lig, col).Select 'on se place sur la cellule à modifier
 
If Cells(lig, col_ex) = 0 And Cells(lig, col_nouveau) = "Non" Then
 
        Cells(lig, col_ex).Copy 'copie du n° d'exercice
        Cells(lig, col_tampon_num_ex).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Cells(lig, col).Select
 
        Cells(lig, col_honoraires).Copy 'copie du montant des honoraires de N+1
        Cells(lig, col_tampon_hono_n_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Cells(lig, col_tampon_hono_n_2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        Cells(lig, col).Select
 
 
ElseIf Cells(lig, col_ex) > 0 And Cells(lig, col_ex) <> Cells(lig, col_tampon_num_ex) And Cells(lig, col_nouveau) = "Non" _
                            And Cells(lig, col_tampon_hono_n_1) <> "" Then
        Cells(lig, col_tampon_hono_n_1).Copy 'copie du montant des honoraires tampon N-1 dans tampon N-2
        Cells(lig, col_tampon_hono_n_2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
        Cells(lig, col).Select
 
        Cells(lig, col_ex).Copy 'copie du n° d'exercice
        Cells(lig, col_tampon_num_ex).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
        Cells(lig, col).Select
 
        Cells(lig, col_honoraires).Copy 'copie du montant des honoraires de N+1 dans tampon N-1
        Cells(lig, col_tampon_hono_n_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
 
 
'première année, quel que soit le numéro de l'exercice
ElseIf Cells(lig, col_ex) > 0 And Cells(lig, col_ex) <> Cells(lig, col_tampon_num_ex) And Cells(lig, col_nouveau) = "Non" _
                            And Cells(lig, col_tampon_hono_n_1) = "" Then
        Cells(lig, col_hono_base).Copy 'copie du montant des honoraires de base dans colonne tampon n-1
        Cells(lig, col_tampon_hono_n_1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
        Cells(lig, col_tampon_hono_n_2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
 
        Cells(lig, col).Select
 
        Cells(lig, col_ex).Copy 'copie du n° d'exercice
        Cells(lig, col_tampon_num_ex).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False
 
 
 
End If
 
Columns(col_tampon_num_ex & ":" & col_tampon_hono_n_2).EntireColumn.Hidden = True
Application.CutCopyMode = False
Cells(lig, col).Select
Application.ScreenUpdating = True
'ActiveSheet.Protect
End Sub

Donc, je ne vous en voudrais si vous me dites que mon code est nul mais bon... ça marche ! Si vous voulez bien me corriger ! Merci.

Et puis, 2ème question : j'ai une colonne qui doit être "visitée" par la macro ci-dessus pour voir s'il est nécessaire de changer la formule de cette cellule.
Cela concerne la colonne AJ. Je suppose qu'il doit falloir faire une boucle mais j'ai du mal à la réaliser ! Merci de votre aide.

**mercatog** · 08/10/2010, 22h45

Au lieu des copier pastspecial, affecter directement les valeurs

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
Sub Changement_Formule_Honoraires_Client_Sans_Remise()
Dim Lig As Long
Const Col As String = "AJ"                      'colonne contenant la cellule à modifier (cellule de départ)
Const Col_Ex As String = "AF"                   'colonne contenant le n° de l'exercice
Const Col_Tampon_Num_ex As String = "AG"        'colonne tampon qui recopie le n° de l'exercice
Const Col_Tampon_Hono_N_1 As String = "AH"      'colonne contenant la recopie des honoraires de N-1
Const Col_Tampon_Hono_N_2 As String = "AI"      'colonne contenant la recopie des honoraires de N-2
Const Col_Honoraires As String = "AN"           'colonne des honoraires de N+1
Const Col_Nouveau As String = "Z"               'colonne qui définit si le client est un nouveau client ou non
Const Col_Hono_Base As String = "AA"            'colonne qui contient les honoraires de base
 
Application.ScreenUpdating = False
With Sheets("Feuil1")           'A adapter
    .Unprotect
    .Columns(Col_Tampon_Num_ex & ":" & Col_Tampon_Hono_N_2).Hidden = False
    Lig = IIf(ActiveCell.Row <= 8, 0, 1) + ActiveCell.Row
    If .Cells(Lig, Col_Ex) = 0 And .Cells(Lig, Col_Nouveau) = "Non" Then
        .Cells(Lig, Col_Tampon_Hono_N_1) = .Cells(Lig, Col_Honoraires)
        .Cells(Lig, Col_Tampon_Hono_N_2) = .Cells(Lig, Col_Honoraires)
        .Cells(Lig, Col_Tampon_Num_ex) = .Cells(Lig, Col_Ex)
    ElseIf .Cells(Lig, Col_Ex) > 0 And .Cells(Lig, Col_Ex) <> .Cells(Lig, Col_Tampon_Num_ex) And .Cells(Lig, Col_Nouveau) = "Non" And .Cells(Lig, Col_Tampon_Hono_N_1) <> "" Then
        .Cells(Lig, Col_Tampon_Hono_N_1) = .Cells(Lig, Col_Honoraires)
        .Cells(Lig, Col_Tampon_Hono_N_2) = .Cells(Lig, Col_Tampon_Hono_N_1)
        .Cells(Lig, Col_Tampon_Num_ex) = .Cells(Lig, Col_Ex)
    ElseIf .Cells(Lig, Col_Ex) > 0 And .Cells(Lig, Col_Ex) <> .Cells(Lig, Col_Tampon_Num_ex) And .Cells(Lig, Col_Nouveau) = "Non" And .Cells(Lig, Col_Tampon_Hono_N_1) = "" Then
        .Cells(Lig, Col_Tampon_Hono_N_1) = .Cells(Lig, Col_Hono_Base)
        .Cells(Lig, Col_Tampon_Hono_N_2) = .Cells(Lig, Col_Hono_Base)
        .Cells(Lig, Col_Tampon_Num_ex) = .Cells(Lig, Col_Ex)
    End If
    .Columns(Col_Tampon_Num_ex & ":" & Col_Tampon_Hono_N_2).Hidden = True
    .Protect
End With
End Sub

Pour le 2ème point, c'est pas clair comme explication.

**chouchouboy** · 09/10/2010, 00h47

merci pour ce premier débroussaillage. Je suis en train d'adapter ce code à ma situation et refaire des tests pour voir si tout colle.

Ma deuxième question était la suivante : au travers du code, vous avez pu voir que je travaille sur la ligne en cours et dans cette ligne, je copie colle des données selon différents paramètres. Et bien ce que je souhaiterais, c'est avoir une macro qui passe en revue toutes les lignes et qui exécute la macro que vous m'avez corrigé automatiquement... ?
Vous voyez ce que je veux dire ?

Sinon, par rapport à votre code corrigé, je ne comprends : le code s'exécute sur la ligne en cours + 1 ???
Et à quoi sert

Code :

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

Lig = IIf(ActiveCell.Row <= 8, 0, 1) + ActiveCell.Row

Merci encore de prendre du temps pour moi !

**mercatog** · 09/10/2010, 10h34

explique mi cette partie

Code :

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

1
2
3
4
5
6
If ActiveCell.Row <= 8 Then
    lig = ActiveCell.Row
    ElseIf ActiveCell.Row > 8 Then
    lig = ActiveCell.Row + 1
    Else: lig = ActiveCell.Row + 1
    End If

je t'expliquerai celle ci

Code :

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

Lig = IIf(ActiveCell.Row <= 8, 0, 1) + ActiveCell.Row

Si tu veux faire le code pour toutes les lignes

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
Sub Changement_Formule_Honoraires_Client_Sans_Remise()
Dim Lig As Long
Const Col As String = "AJ"                      'colonne contenant la cellule à modifier (cellule de départ)
Const Col_Ex As String = "AF"                   'colonne contenant le n° de l'exercice
Const Col_Tampon_Num_ex As String = "AG"        'colonne tampon qui recopie le n° de l'exercice
Const Col_Tampon_Hono_N_1 As String = "AH"      'colonne contenant la recopie des honoraires de N-1
Const Col_Tampon_Hono_N_2 As String = "AI"      'colonne contenant la recopie des honoraires de N-2
Const Col_Honoraires As String = "AN"           'colonne des honoraires de N+1
Const Col_Nouveau As String = "Z"               'colonne qui définit si le client est un nouveau client ou non
Const Col_Hono_Base As String = "AA"            'colonne qui contient les honoraires de base
 
Application.ScreenUpdating = False
With Sheets("Feuil1")           'A adapter
    .Unprotect
    For Lig = 2 To .Cells(Rows.Count, Col).End(xlUp).Row
        If .Cells(Lig, Col_Ex) = 0 And .Cells(Lig, Col_Nouveau) = "Non" Then
            .Cells(Lig, Col_Tampon_Hono_N_1) = .Cells(Lig, Col_Honoraires)
            .Cells(Lig, Col_Tampon_Hono_N_2) = .Cells(Lig, Col_Honoraires)
            .Cells(Lig, Col_Tampon_Num_ex).ClearContents
        ElseIf .Cells(Lig, Col_Ex) > 0 And .Cells(Lig, Col_Ex) <> .Cells(Lig, Col_Tampon_Num_ex) And .Cells(Lig, Col_Nouveau) = "Non" And .Cells(Lig, Col_Tampon_Hono_N_1) <> "" Then
            .Cells(Lig, Col_Tampon_Hono_N_1) = .Cells(Lig, Col_Honoraires)
            .Cells(Lig, Col_Tampon_Hono_N_2) = .Cells(Lig, Col_Tampon_Hono_N_1)
            .Cells(Lig, Col_Tampon_Num_ex) = .Cells(Lig, Col_Ex)
        ElseIf .Cells(Lig, Col_Ex) > 0 And .Cells(Lig, Col_Ex) <> .Cells(Lig, Col_Tampon_Num_ex) And .Cells(Lig, Col_Nouveau) = "Non" And .Cells(Lig, Col_Tampon_Hono_N_1) = "" Then
            .Cells(Lig, Col_Tampon_Hono_N_1) = .Cells(Lig, Col_Hono_Base)
            .Cells(Lig, Col_Tampon_Hono_N_2) = .Cells(Lig, Col_Hono_Base)
            .Cells(Lig, Col_Tampon_Num_ex) = .Cells(Lig, Col_Ex)
        End If
    Next Lig
    .Columns(Col_Tampon_Num_ex & ":" & Col_Tampon_Hono_N_2).Hidden = True
    .Protect
End With
End Sub

Amélioration de mes macros

Macros et VBA Excel

Discussions similaires

Partager

Partager