[XL-2007] Modification d'une macro [Résolu]

[francky62000]

Bonjour a tout le monde , bonjour le forum

Mes compétences en VBA étant limité, mais j'en apprends tous les jours, je sollicite auprés de vous une aide afin de modifier un code que voici :

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
   Sub carte_de_fidelite()
 
    Client = Range("AC8").Value
    Montant = Range("AC9").Value
 
    Sheets("Clients").Select
    Range("F5").Select
    Do While ActiveCell.Value <> Client And ActiveCell.Value <> ""
        ActiveCell.Offset(1, 0).Select
    Loop
    If ActiveCell.Value = "" Then
        MsgBox ("Client non trouvé")
        Sheets("Facture").Select
        Exit Sub
    End If
    ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value + 1
    ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, 2).Value + Montant
 
    If ActiveCell.Offset(0, 1) = Range("A3").Value Then
        Bon = ActiveCell.Offset(0, 2) * Range("D2").Value
        ActiveCell.Offset(0, 1).Value = 0
        ActiveCell.Offset(0, 2).Value = 0
        Sheets("Facture").Select
        MsgBox ("Carte de fidélité complète !!" & Chr(13) & "Remise de 10% :  " & Format(Bon, "0.00") & "  Euros")
    End If
 
    Sheets("Facture").Select
End Sub

Comme vous l'aurez compris, cette macro et pour tenir a jour une carte de fidélité .
La macro travaille avec 2 feuilles "Facture" et "Client"
Quand ma facture est terminée , je lance la macro qui recherche dans la colonne F5 de la feuille "Client" le nom de celui-ci.
Si le nom n'est pas trouvé , retour d'un message " client non trouvé " ligne 12
A l'inverse le calcul s'effectue si le client est trouvé


J'aimerai , si le client n'est pas trouvé dans la colonne F5 de la feuille "Client", que l'ajout se fasse automatiquement car celui-ci est connu par le range effectué depuis ma feuille "Facture" en "AC8".
Quand le client est ajouté, la macro refait la recheche ( afin d'eviter les doublons ) puis attribut au client ce dont il a droit.


J'espére que cela est possible

Merci de votre aide

[jfontaine]

Bonjour,

Si dessous une idée d'optimisation, pour éviter l'utilisation répéter des Activcell, et qui ajoute le client si inexistant dans la feuille client

Analyse ce code et essais d'adapter la dernière partie de contrôle de fin de remplissage de la carte de fidelité.
Reviens vers nous si difficultés.

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
Dim StrClient As String
 
Dim Rg As Range
Dim ShClient As Worksheet
Dim shFacture As Worksheet
 
Set ShClient = Sheets("Clients")
Set shFacture = Sheets("Factures")
 
StrClient = shFacture.Range("AC8").Value
 
'Recherche si client existant
Set Rg = ShClient.Range("F:F").Find(what:=StrClient, after:=ShClient.Range("F5"), lookat:=xlWhole)
 
If Rg Is Nothing Then
    'Pas trouvé
    MsgBox ("Client non trouvé : " & StrClient)
    'Ajout du client dans la feuille Client
    Set Rg = ShClient.Range("F" & ShClient.Range("F65536").End(xlUp).Row + 1)
    Rg.Value = StrClient
End If
 
'Ajout les infos sur la carte
ShClient.Range("G" & Rg.Row).Value = ShClient.Range("G" & Rg.Row).Value + 1
ShClient.Range("H" & Rg.Row).Value = ShClient.Range("H" & Rg.Row).Value + shFacture.Range("AC9").Value

A moins que tu souhaites continuer ton code sur les même bases

[francky62000]

Oula , je t'avoue que ton code m'embrouille un peu , j'ai essayé de l'adapter , il fonction ( ajout et addition ) .
Cependant étant un peu contrarié par la facon de faire , l'adaptation avec le reste du code ne m'est pas une tache facile.
En effet , Les cellule "A3" et "D3" de ma feuille "Client" détermine le moment ou le client a sa carte de fidélité pleine et le montant de sa remise
"A3"= nombre de visite que je détermine
"D2"= chiffre de remise en % ( ici 10 ) que je détermine
ex :Aprés 10 passages, il a droit a 10 % de remise sur le montant total de ses prestations

Du coup, je suis un peu perdu lol

[jfontaine]

A tester

Code :

1
2
3
4
5
6
If ShClient.Range("G" & Rg.Row).Value = ShClient.Range("A3").Value Then
        Bon = ShClient.Range("H" & Rg.Row).Value * ShClient.Range("D2").Value
        ShClient.Range("G" & Rg.Row).Value = 0
        ShClient.Range("H" & Rg.Row).Value = 0
        MsgBox ("Carte de fidélité complète !!" & Chr(13) & "Remise de 10% :  " & Format(Bon, "0.00") & "  Euros")
End If

[francky62000]

OK, je te remercie, le code fonctionne parfaitement

Merci et a bientôt