IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Modification d'une macro [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    45
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations forums :
    Inscription : Décembre 2011
    Messages : 45
    Par défaut Modification d'une macro
    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 : 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
       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

  2. #2
    Expert confirmé Avatar de jfontaine
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Juin 2006
    Messages
    4 756
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 51
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Contrôleur de Gestion

    Informations forums :
    Inscription : Juin 2006
    Messages : 4 756
    Par défaut
    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 : 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
    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

  3. #3
    Membre averti
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    45
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations forums :
    Inscription : Décembre 2011
    Messages : 45
    Par défaut
    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

  4. #4
    Expert confirmé Avatar de jfontaine
    Homme Profil pro
    Contrôleur de Gestion
    Inscrit en
    Juin 2006
    Messages
    4 756
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 51
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Contrôleur de Gestion

    Informations forums :
    Inscription : Juin 2006
    Messages : 4 756
    Par défaut
    A tester
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  5. #5
    Membre averti
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    45
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations forums :
    Inscription : Décembre 2011
    Messages : 45
    Par défaut
    OK, je te remercie, le code fonctionne parfaitement

    Merci et a bientôt

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2007] Modification d'une macro
    Par mobiclick dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 22/01/2010, 23h36
  2. Empêcher la modification d'une macro word
    Par Samy_Bel dans le forum VBA Word
    Réponses: 3
    Dernier message: 30/12/2009, 11h27
  3. Modification d'une Macro
    Par zahidovich dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 09/12/2009, 17h51
  4. [XL-2003] Modification d'une macro de récup de données
    Par Blop le bricoleur dans le forum Macros et VBA Excel
    Réponses: 32
    Dernier message: 22/07/2009, 11h36
  5. Réponses: 1
    Dernier message: 15/07/2008, 09h40

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo