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 :

Description d'une macro


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Inscrit en
    Mai 2009
    Messages
    29
    Détails du profil
    Informations forums :
    Inscription : Mai 2009
    Messages : 29
    Par défaut Description d'une macro
    Bonjour,

    je fais appel aujourd'hui à vos connaissances en VBA afin de m'expliquer, par le biais de commentaires, la macro suivante:

    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
    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
    Sub Macro1()
    On Error GoTo Err_Commande86_Click
    '
    ' Macro1 Macro
    ' Macro enregistrée le 31/03/2009 par *********
    '
        Range("I3:Bl500").Select
        Selection.Interior.ColorIndex = xlNone
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Selection.ClearComments
    '
    ' à quoi cela correspond-il??
     
    col = 8
    a = ""
    b = ""
    c = ""
    c1 = ""
    c2 = ""
    d = ""
    e = ""
    f = ""
    cpt = 1
    lots = ""
    sem = ""
    cumul = 0
    nb = 0
     
    For Each cellule In ActiveSheet.Range("A3:h500").Cells
    f = e
    e = d
    d = c2
    c2 = c1
    c1 = c
    c = b
    b = a
    a = cellule
     
    If (cpt = col) Then
    If (b <= Range("c1").Value) Then
    sem = sem & "Sem " & Format(b, "ww", vbMonday, vbFirstJan1) & ";"
    End If
    End If
     
    If (cpt = col And f = "") Then
    lots = lots & cellule.Value & ";"
     
    nb = nb + 1
    End If
     
    If (cpt = col And f <> "") Then
     
    cumul = 0
    cumul2 = 0
    sous_total = 0
    If (nb > 0) Then
    sous_total = InStr(1, lots, ";")
    sous_total = Mid(lots, 1, sous_total)
    sous_total = Replace(sous_total, ";", "")
    sous_total = Round(sous_total, 2)
    lots = Replace(lots, sous_total & ";", "", 1, 1)
    nb = nb - 1
    End If
    num_lot = 1
    test = True
    For Each Cellule2 In ActiveSheet.Range("L" & cellule.Row & ":BL" & cellule.Row).Cells
     
    If (Cellule2.Value <> "") Then cumul = Int(Cellule2.Value) + cumul
    If (Cellule2.Value <> "") Then cumul2 = Int(Cellule2.Value) + cumul2
    ad = InStrRev(Cellule2.AddressLocal, "$")
    ad = Mid(Cellule2.AddressLocal, 1, ad)
     
     
    If (InStr(sem, Range(ad & "2").Value)) Then
    Cellule2.Select
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
    sem = Replace(sem, Range(ad & "2").Value & ";", "")
    End If
     
    If (cumul2 > sous_total And nb > 0) Then
    Cellule2.Select
        With Selection.Interior
            .ColorIndex = 44
        End With
        Selection.AddComment
        Selection.Comment.Visible = True
        Selection.Comment.Text Text:="Fin de lot " & num_lot & "." & Chr(10) & cumul2 - sous_total & " KG pris sur le lot suivant."
        Selection.Comment.Visible = False
    cumul2 = cumul2 - sous_total
    num_lot = num_lot + 1
    sous_total = InStr(1, lots, ";")
    sous_total = Mid(lots, 1, sous_total)
    sous_total = Replace(sous_total, ";", "")
    sous_total = Round(sous_total, 2)
     
    lots = Replace(lots, sous_total & ";", "", 1, 1)
    nb = nb - 1
     
    End If
     
     
    If (cumul > cellule.Value And test = True) Then
    Cellule2.Select
        With Selection.Interior
            .ColorIndex = 3
        End With
        Selection.ClearComments
        Selection.AddComment
        Selection.Comment.Visible = True
        Selection.Comment.Text Text:="Rupture :" & Chr(10) & "Manque de " & cumul - cellule.Value & " KG"
        Selection.Comment.Visible = False
        sous_total = 0
        lots = ""
        cumul2 = 0
        nb = 0
        test = False
    'Exit For
    End If
     
    Next
     
    End If
     
    cpt = 1 + cpt
    If (cpt > col) Then
    cpt = 1
    End If
    Next
     
    Range("A1").Select
     
    Exit_Commande86_Click:
        Exit Sub
     
    Err_Commande86_Click:
        MsgBox Err.Description
        Resume Exit_Commande86_Click
    End Sub
    En fait la première partie est pour moi imcompéhensible puisque je n'ai jamais fait ce genre de macro à mon très très modeste niveau!

    Merci de m'aider et d'éclairer ma lanterne à ce sujet...

  2. #2
    Rédacteur/Modérateur

    Avatar de Jean-Philippe André
    Homme Profil pro
    Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Inscrit en
    Juillet 2007
    Messages
    14 682
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 41
    Localisation : Canada

    Informations professionnelles :
    Activité : Architecte Power Platform, ex-Développeur VBA/C#/VB.Net
    Secteur : Finance

    Informations forums :
    Inscription : Juillet 2007
    Messages : 14 682
    Par défaut
    salut,

    les premieres lignes indiquent un nettoyage des cadres dans tes cellules.

    Les lignes de code suppriment (passent a xlNone) les cotes de ta selection de cellules.


    Cela t'aide-t-il a mieux comprendre la macro ?
    Cycle de vie d'un bon programme :
    1/ ça fonctionne 2/ ça s'optimise 3/ ça se refactorise

    Pas de question technique par MP, je ne réponds pas

    Mes ouvrages :
    Migrer les applications VBA Access et VBA Excel vers la Power Platform
    Apprendre à programmer avec Access 2016, Access 2019 et 2021

    Apprendre à programmer avec VBA Excel
    Prise en main de Dynamics 365 Business Central

    Coffrets disponibles de mes ouvrages : https://www.editions-eni.fr/jean-philippe-andre
    Pensez à consulter la FAQ Excel et la FAQ Access

    Derniers tutos
    Excel et les paramètres régionaux
    Les fichiers Excel binaires : xlsb,

    Autres tutos

  3. #3
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Et tu peux simplifier la première partie comme ceci
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    With Range("B3:Il500")
        .Interior.ColorIndex = xlNone   'enlève la couleur de fond des cellules
        .Borders.LineStyle = xlNone     'enlève toutes les bordures
        .ClearComments                  'enlève tous les commentaires
    End With

  4. #4
    Membre averti
    Inscrit en
    Mai 2009
    Messages
    29
    Détails du profil
    Informations forums :
    Inscription : Mai 2009
    Messages : 29
    Par défaut
    Merci pour vos réponses,

    pour cette partie là oui j'avais compris (je me suis mal exprimé oups sorry)

    c'est la suite, l'énumération que je ne comprend pas...

    Mais je suppose qu'il devrait être difficile de répondre à ma question sans voir la macro fonctionnait...

    Mais je n'ai pas le fichier sous la main, dès que je peux je la partage...

    mais si vous arrivez à me dire à quoi cela pourrait juste correspondre cela m'aiderait grandement

    Merci encore à vous!!

  5. #5
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut heuh!!!
    bonjour

    toujours dans un souci de reduction de code inutile
    tu peut deja remplacer toute tes lignes de netoyages par:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
     Range("I3:Bl500").clear
    sa les vides ,enleves les cadre,enleve la couleur de fond, remet la couleur text en normal(noir),ect..enfin les cellule redevienne comme a l'origine


    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  6. #6
    Membre averti
    Inscrit en
    Mai 2009
    Messages
    29
    Détails du profil
    Informations forums :
    Inscription : Mai 2009
    Messages : 29
    Par défaut
    rebonjour,

    je suis enfin de retour et prêt à m'occuper de cette histoire de macro dont je n'ai toujours pas saisi le sens du début de cette partie exactement :
    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
    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
     
    col = 8
    a = ""
    b = ""
    c = ""
    c1 = ""
    c2 = ""
    d = ""
    e = ""
    f = ""
    cpt = 1
    lots = ""
    sem = ""
    cumul = 0
    nb = 0
     
    For Each cellule In ActiveSheet.Range("A3:h500").Cells
    f = e
    e = d
    d = c2
    c2 = c1
    c1 = c
    c = b
    b = a
    a = cellule
     
    If (cpt = col) Then
    If (b <= Range("c1").Value) Then
    sem = sem & "Sem " & Format(b, "ww", vbMonday, vbFirstJan1) & ";"
    End If
    End If
     
    If (cpt = col And f = "") Then
    lots = lots & cellule.Value & ";"
     
    nb = nb + 1
    End If
     
    If (cpt = col And f <> "") Then
     
    cumul = 0
    cumul2 = 0
    sous_total = 0
    If (nb > 0) Then
    sous_total = InStr(1, lots, ";")
    sous_total = Mid(lots, 1, sous_total)
    sous_total = Replace(sous_total, ";", "")
    sous_total = Round(sous_total, 2)
    lots = Replace(lots, sous_total & ";", "", 1, 1)
    nb = nb - 1
    End If
    num_lot = 1
    test = True
    For Each Cellule2 In ActiveSheet.Range("L" & cellule.Row & ":BL" & cellule.Row).Cells
     
    If (Cellule2.Value <> "") Then cumul = Int(Cellule2.Value) + cumul
    If (Cellule2.Value <> "") Then cumul2 = Int(Cellule2.Value) + cumul2
    ad = InStrRev(Cellule2.AddressLocal, "$")
    ad = Mid(Cellule2.AddressLocal, 1, ad)
     
     
    If (InStr(sem, Range(ad & "2").Value)) Then
    Cellule2.Select
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThick
            .ColorIndex = 5
        End With
    sem = Replace(sem, Range(ad & "2").Value & ";", "")
    End If
     
    If (cumul2 > sous_total And nb > 0) Then
    Cellule2.Select
        With Selection.Interior
            .ColorIndex = 44
        End With
        Selection.AddComment
        Selection.Comment.Visible = True
        Selection.Comment.Text Text:="Fin de lot " & num_lot & "." & Chr(10) & cumul2 - sous_total & " KG pris sur le lot suivant."
        Selection.Comment.Visible = False
    cumul2 = cumul2 - sous_total
    num_lot = num_lot + 1
    sous_total = InStr(1, lots, ";")
    sous_total = Mid(lots, 1, sous_total)
    sous_total = Replace(sous_total, ";", "")
    sous_total = Round(sous_total, 2)
     
    lots = Replace(lots, sous_total & ";", "", 1, 1)
    nb = nb - 1
     
    End If
     
     
    If (cumul > cellule.Value And test = True) Then
    Cellule2.Select
        With Selection.Interior
            .ColorIndex = 3
        End With
        Selection.ClearComments
        Selection.AddComment
        Selection.Comment.Visible = True
        Selection.Comment.Text Text:="Rupture :" & Chr(10) & "Manque de " & cumul - cellule.Value & " KG"
        Selection.Comment.Visible = False
        sous_total = 0
        lots = ""
        cumul2 = 0
        nb = 0
        test = False
    'Exit For
    End If
     
    Next
     
    End If
     
    cpt = 1 + cpt
    If (cpt > col) Then
    cpt = 1
    End If
    Next
     
    Range("L3").Select
     
    Exit_Commande86_Click:
        Exit Sub
     
    Err_Commande86_Click:
        MsgBox Err.Description
        Resume Exit_Commande86_Click
    End Sub
    je ne vois pas à quioi correspond a, b, c1,c2 etc...

    Merci pour vos réponses...je tente d'uploader le fichier de suite pour ceux qui voudrait avoir une vision globale de ce sur quoi je m'intéresses...(inutile pour mon cas pour le stage mais utile pour mes connaissance en VBA)

    Merci encore à vous de prendre de votre temps...

  7. #7
    Membre averti
    Inscrit en
    Mai 2009
    Messages
    29
    Détails du profil
    Informations forums :
    Inscription : Mai 2009
    Messages : 29
    Par défaut
    Voici le fichier en format .zip, seul logiciel installé sur le PC du lieu de mon stage et sur lequel je n'ai aucun droit (similaire à un compte visiteur)

    Bref, j'éspère que vous pourrez me répondre.

    Si cela ne vous embête pas, je sais que j'en demande déjà beaucoup, de mettre sous forme de commentaire dans la macro grâce à ce symbole ' le processus de cette macro

    par exemple comme l'a très bien fait Mercatog :


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    With Range("B3:Il500")
        .Interior.ColorIndex = xlNone   'enlève la couleur de fond des cellules
        .Borders.LineStyle = xlNone     'enlève toutes les bordures
        .ClearComments                  'enlève tous les commentaires
    End With
    '
    Merci encore!

    edit :

    Les cases jaunes/oranges = lot terminé
    cases rouges = rupture de stock
    cases avec bordures bleues = fin de la DLUO d'un lot
    Fichiers attachés Fichiers attachés

Discussions similaires

  1. [VB6] Exécuter une macro Access
    Par Nektanebos dans le forum VB 6 et antérieur
    Réponses: 8
    Dernier message: 22/02/2006, 16h32
  2. Macro utilisant une macro...
    Par Gogoye dans le forum C
    Réponses: 2
    Dernier message: 29/10/2003, 14h22
  3. [VBA-E] [Excel] Lancer une macro à une heure donnée
    Par Lysis dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 16/10/2002, 12h15
  4. Qu'est-ce qu'une macro ?
    Par karli dans le forum Assembleur
    Réponses: 2
    Dernier message: 01/09/2002, 03h38
  5. Réponses: 2
    Dernier message: 22/07/2002, 12h13

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