Explication d'une macro

Bonjour,

Voilà une personne m'a faite une macro malheureusement je ne comprend pas tout de celle-ci

Elle fonctionne parfaitement mais ça m'embête de l'utiliser sans comprendre de façon général ce que tout ce charabia veut dire.

Option Explicit

Private Sub ImpExp_Click()
Dim LastLig As Long, TheLig As Long
Dim Tmp As String

Application.ScreenUpdating = False
Tmp = Range("REF")
If Tmp <> "" Then
    With Feuil2
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        TheLig = TheRow(Tmp, .Range("A4:A" & LastLig))
        If TheLig > LastLig Then .Range("A" & TheLig).Resize(, 177).Borders.LineStyle = xlContinuous

        Export Tmp, .Range("A4:A" & LastLig), .Range("B:HP"), Range("DESC")
        Export Tmp, .Range("A4:A" & LastLig), .Range("I:DP"), Range("CAUS")
        Export Tmp, .Range("A4:A" & LastLig), .Range("DQ:ER"), Range("VERIF")
        Export Tmp, .Range("A4:A" & LastLig), .Range("ES:FT"), Range("ACT")
    End With
    Range("REF") = ""
    Range("DTE") = ""
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastLig As Long, TheLig As Long
Dim Tmp As String

Application.ScreenUpdating = False
If Target(1, 1).Address = Range("REF")(1, 1).Address Then
    Tmp = Target(1, 1)
    Application.EnableEvents = False
    Range("REF") = UCase(Tmp)
    ClearForm
    With Feuil2
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        TheLig = TheRow(Tmp, .Range("A4:A" & LastLig))
        If TheLig > LastLig Then
            Target.Font.Color = 255
            With ActiveSheet.OLEObjects("ImpExp").Object
                .Caption = "Enregistrer nouvelle référence"
                .ForeColor = 255
            End With
        Else
            Target.Font.Color = 0
            With ActiveSheet.OLEObjects("ImpExp").Object
                .Caption = "Modifier référence"
                .ForeColor = vbBlue
            End With
            Import Tmp, .Range("A:A"), .Range("B:H"), Range("DESC")
            Import Tmp, .Range("A:A"), .Range("I:DP"), Range("CAUS")
            Import Tmp, .Range("A:A"), .Range("DQ:ER"), Range("VERIF")
            Import Tmp, .Range("A:A"), .Range("ES:FT"), Range("ACT")
        End If
    End With
    Application.EnableEvents = True
End If
End Sub

Private Function TheRef(ByVal What As String, ByVal Where As Range) As Range

If What <> "" Then Set TheRef = Where.Find(What, LookIn:=xlValues, lookat:=xlWhole)
End Function

Private Function CLookUp(ByVal What As String, ByVal Where As Range, ByVal From As Range, ByVal Num As Integer)
Dim c As Range

Set c = TheRef(What, Where)
If Not c Is Nothing Then
    CLookUp = Intersect(c.EntireRow, From(, Num).EntireColumn)
    Set c = Nothing
End If
End Function

Private Function TheRow(ByVal What As String, ByVal Where As Range) As Long
Dim c As Range

Set c = TheRef(What, Where)
If Not c Is Nothing Then
    TheRow = c.Row
    Set c = Nothing
Else
    TheRow = Where.Offset(Where.Rows.Count).Row
End If
End Function

Private Sub Import(ByVal What As String, ByVal Where As Range, ByVal From As Range, ByVal Inside As Range)
Dim i As Integer
Dim c As Range
Dim j As Long

Application.ScreenUpdating = False
Set c = TheRef(What, Where)
If Not c Is Nothing Then
    For Each c In Inside
        If c.MergeArea(1, 1).Address = c.Address Then
            i = i + 1
            c = CLookUp(What, Where, From, i)
        End If
    Next c
    j = TheRow(What, Where)
    Range("DTE") = Where.Worksheet.Cells(j, 177)
End If
End Sub

Private Sub Export(ByVal What As String, ByVal Where As Range, ByVal From As Range, ByVal Inside As Range)
Dim i As Integer
Dim c As Range
Dim j As Long

Application.ScreenUpdating = False
If What <> "" Then
    j = TheRow(What, Where)
    For Each c In Inside
        If c.MergeArea(1, 1).Address = c.Address Then
            i = i + 1
            From(j, i) = c
        End If
    Next c
    With Feuil2
        .Cells(j, 1) = What
        .Cells(j, 177) = Range("DTE")
    End With
End If
End Sub

Private Sub ClearForm()

Application.ScreenUpdating = False
Range("DESC").ClearContents
Range("CAUS").ClearContents
Range("VERIF").ClearContents
Range("ACT").ClearContents
End Sub

J'explique un peu le but de la macro : en tapant une référence dans la feuille quick kaizen, si la référence existe déjà ça reprend les données de la feuille BD et si je modifie et je valide, ça remet à jour le tableau BD sur la ligne de la référence. Si j'aoute une nouvelle référence elle se met à la suite dans le tableau.

Je préviens je suis un grand débutant. Donc j'ai essayé de chercher par moi même pour essayer de comprendre.

1- Que veut dire : Private Sub

2- Dim XXX As YYY ça permet bien de définir une variable?

3- Que veut dire Application.ScreenUpdating?

4- Que veut dire Rows.Count?

5- je comprend pas l'expression

Export Tmp, .Range("A4:A" & LastLig), .Range("B:HP"), Range("DESC")

6- Que veut dire Application.EnableEvents

7- Je ne comprend pas l'expression

LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
        TheLig = TheRow(Tmp, .Range("A4:A" & LastLig))
        If TheLig > LastLig Then

8- La fonction OLEObjects, ça sert à créer le bouton sur la feuille quick kaizen?

C'est mes questions sur les deux premiers private

Si quelqu'un pouvait m'expliquer de façon sommaire ce qu'on font chaque private car je suis totalement perdu.

Merci d'avance

Cordialement

Bonjour Hvegung, bonjour le forum,

Le code commenté :

Option Explicit 'oblige à définir toutes les variables (sinon ça plante)

Private Sub ImpExp_Click() 'cette macro doit, je pense, être associée à un bouton
Dim LastLig As Long, TheLig As Long 'déclare les variables LastLig de type long, TheLig de type long
Dim Tmp As String 'déclare la variable Tmp de type texte

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Tmp = Range("REF") 'définit la variable Tmp (correspond au contenu de la plage nommée "REF")
If Tmp <> "" Then 'condition : si Tmp n'est pas vide
    With Feuil2 'prend en compte l'onglet "Feuil2"
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row 'définit la variable LastLig (ligne de la dernière cellule éditée de la colonne 1 (=A)
        TheLig = TheRow(Tmp, .Range("A4:A" & LastLig)) 'définit la variable TheLig à l'aide de la fontion [TheRow] (plus bas)
        'si TheLig est supérieur à LastLig met une bordure aux cellule de la ligne TheLig à TheLig + 176 dans la colonne A
        If TheLig > LastLig Then .Range("A" & TheLig).Resize(, 177).Borders.LineStyle = xlContinuous
        Export Tmp, .Range("A4:A" & LastLig), .Range("B:HP"), Range("DESC") 'voir fonction [Export] (plus bas)
        Export Tmp, .Range("A4:A" & LastLig), .Range("I:DP"), Range("CAUS") 'voir fonction [Export] (plus bas)
        Export Tmp, .Range("A4:A" & LastLig), .Range("DQ:ER"), Range("VERIF") 'voir fonction [Export] (plus bas)
        Export Tmp, .Range("A4:A" & LastLig), .Range("ES:FT"), Range("ACT") 'voir fonction [Export] (plus bas)
    End With 'fin de la prise en compte de l'onglet "Feuil2"
    Range("REF") = "" 'vide le contenu de la plage nommée "REF"
    Range("DTE") = "" 'vide le contenu de la plage nommée "DTE"
End If 'fin de la condition
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
'(ce code ne doit pas se trouver dans un module standard mais dans un onglet, par exemple : Feuil1(Feuil1), sinon il ne fonctionne pas !
'il agira chaque fois que tu modifieras le contenu d'une cellule

Dim LastLig As Long, TheLig As Long 'déclare les variables LastLig de type long, TheLig de type long
Dim Tmp As String 'déclare la variable Tmp de type texte

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
'condition 1 : si la cellule modifiée correspond à la première cellule de la plage nommée "REF"
If Target(1, 1).Address = Range("REF")(1, 1).Address Then
    Tmp = Target(1, 1) 'définit la variable tmp (valeur de la cellule active)
    Application.EnableEvents = False 'empêche les procédure événementielles de se produire (évite la boucle sur cet événement si le code modifie une autre cellule)
    Range("REF") = UCase(Tmp) 'met le contenu de la plage nommée "REF" en majuscule
    ClearForm 'lance la procédure [ClearForm] (voir plus bas)
    With Feuil2 'prend en compte l'onglet "Feuil2"
        LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row 'définit la variable LastLig (ligne de la dernière cellule éditée de la colonne 1 (=A)
        TheLig = TheRow(Tmp, .Range("A4:A" & LastLig)) 'définit la variable TheLig à l'aide de la fontion [TheRow] (plus bas)
        If TheLig > LastLig Then 'condition 2 : si TheLig est supérieur à LastLig
            Target.Font.Color = 255 'colore la police de la cellue modifiée (je ne sais pas quelle est la couleur)
            With ActiveSheet.OLEObjects("ImpExp").Object 'prend en compte un objet nommé "ImpEXP"
                .Caption = "Enregistrer nouvelle référence" 'modifie le texte
                .ForeColor = 255 'modifie la couleur
            End With 'fin de la prise en compte de l'objet "ImpExp"
        Else 'sinon (condition 2 : si TheLig n'est pas supérieur à lastLig)
            Target.Font.Color = 0 'colore la police de la cellule modifiée (je ne sais pas quelle est la couleur)
            With ActiveSheet.OLEObjects("ImpExp").Object 'prend en compte un objet nommé "ImpEXP"
                .Caption = "Modifier référence" 'modifie le texte
                .ForeColor = vbBlue 'modifie la couleur
            End With 'fin de la prise en compte de l'objet "ImpExp"
            Import Tmp, .Range("A:A"), .Range("B:H"), Range("DESC") 'voir fonction [Import] (plus bas)
            Import Tmp, .Range("A:A"), .Range("I:DP"), Range("CAUS") 'voir fonction [Import] (plus bas)
            Import Tmp, .Range("A:A"), .Range("DQ:ER"), Range("VERIF") 'voir fonction [Import] (plus bas)
            Import Tmp, .Range("A:A"), .Range("ES:FT"), Range("ACT") 'voir fonction [Import] (plus bas)
        End If 'fin de la condition 2
    End With 'fin de la prise en compte de l'onglet "Feuil2"
    Application.EnableEvents = True 'autorise les procédure événementielles (il faut toujours remettre à true à la fin !)
End If 'fin de la condition 1
End Sub

Private Function TheRef(ByVal What As String, ByVal Where As Range) As Range 'fonction TheRef avec les attributs "What" et "Where"
If What <> "" Then Set TheRef = Where.Find(What, LookIn:=xlValues, lookat:=xlWhole) 'définit la plage TheRef en fonction de la première occurrence trouvée de "What" dans "Where"
End Function

Private Function CLookUp(ByVal What As String, ByVal Where As Range, ByVal From As Range, ByVal Num As Integer) 'fonction CLookUp avec les attributs "What", "Where", "From" et "Num"
Dim c As Range 'déclare la variable c de type range (cellule ou plage de cellules)

Set c = TheRef(What, Where) 'définit la page c à l'aide de la fonction [TheRef] voir au-dessus
If Not c Is Nothing Then 'si il existe au moins une occurrence trouvée
    CLookUp = Intersect(c.EntireRow, From(, Num).EntireColumn) 'définit CLookUp 'Heu pas vraiment compris là...
    Set c = Nothing 'vide la variable c
End If 'fin de la condition
End Function

Private Function TheRow(ByVal What As String, ByVal Where As Range) As Long 'fonction TheRow avec les attributs "What" et "Where"
Dim c As Range 'déclare la variable c de type range (cellule ou plage de cellules)

Set c = TheRef(What, Where) 'définit la page c à l'aide de la fonction [TheRef] voir au-dessus
If Not c Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    TheRow = c.Row 'TheRow correspond à la ligne de l'occurrence trouvée
    Set c = Nothing 'vide la variable c
Else 'sinon
    TheRow = Where.Offset(Where.Rows.Count).Row 'redéfinit la ligne TheRow
End If
End Function

Private Sub Import(ByVal What As String, ByVal Where As Range, ByVal From As Range, ByVal Inside As Range) 'procédure avec les attributs "What", "Where", "From", "Inside"
Dim i As Integer 'déclare la variable I (incrément)
Dim c As Range 'déclare la variable c (Cellule)
Dim j As Long 'déclare la variable j

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set c = TheRef(What, Where) 'définit la cellule c (ou pla plage) à l'aide de la fontion [TheRef] voir plus haut
If Not c Is Nothing Then 'condition : si il existe au moins une occurence trouvée
    For Each c In Inside 'boucle sur toutes les cellues c de l'attribut "Inside"
        If c.MergeArea(1, 1).Address = c.Address Then 'condition : si la l'addresse de la première cellule de la palge c est la même que la cellulle c (pas compris là non plus)
            i = i + 1 'incrément i
            c = CLookUp(What, Where, From, i) 'redéfinit c avec la fonction [CLookUp]
        End If 'fin de la condition
    Next c 'prochaine cellule de la boucle
    j = TheRow(What, Where) 'définit la ligne j à l'aide de la fonction [TheRow]
    Range("DTE") = Where.Worksheet.Cells(j, 177) 'définit la valeur de la plage nommée "DTE"
End If
End Sub

Private Sub Export(ByVal What As String, ByVal Where As Range, ByVal From As Range, ByVal Inside As Range) 'voir explication dans la procédure au dessus
Dim i As Integer
Dim c As Range
Dim j As Long

Application.ScreenUpdating = False
If What <> "" Then
    j = TheRow(What, Where)
    For Each c In Inside
        If c.MergeArea(1, 1).Address = c.Address Then
            i = i + 1
            From(j, i) = c
        End If
    Next c
    With Feuil2
        .Cells(j, 1) = What
        .Cells(j, 177) = Range("DTE")
    End With
End If
End Sub

Private Sub ClearForm()
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Range("DESC").ClearContents 'vide la plage nommée "DESC"
Range("CAUS").ClearContents 'vide la plage nommée "CAUS"
Range("VERIF").ClearContents 'vide la plage nommée "VERIF"
Range("ACT").ClearContents 'vide la plage nommée "ACT"
End Sub

Bonjour ThauThème,

Merci beaucoup pour l'explication de la macro, c'est déjà un peu plus clair,

Il reste quelque partie encore un peu sombre mais tu m'as déjà beaucoup aidée

Cordialement

Bonjour Hvegung, bonjour le forum,

Tu dois surtout remercier la personne qui t'a fait le code car il est remarquable !...

Re-bonjour,

Je l'ai bien remercié, et ça fonctionne bien mieux que la macro que j'avais fait mais beaucoup plus difficile à comprendre aussi

Cordialement

Bonjour à tous,

Je cherchais ce type de macro et il me convient très bien.

Toutefois j'aurai besoin de l'adapter et je ne suis pas un grand expert de VBA.

Il faudrait que cette macro soit active sur uniquement sur certaines plages variables de la feuille.

Je voudrais par exemple que cette macro fonctionne :

A34; A41

puis

A45;A52

puis

A56;A63

sachant que chaque plage peut s'agrandir de façon plus ou moins importante...

Merci pour votre aide.

Bonjour Beno et bienvenue...

Mieux vaut commencer par de bonnes pratiques !

Ça ne se fait pas de squatter un sujet pour poser une autre question...

Tu ouvres ton sujet, tu pose ta question, en fournissant les éléments utiles et autant que possible un fichier d'illustration sur lequel il soit possible de travailler.

Si tu y tiens tu peux toujours récupérer la macro qui t'intéresse et la soumettre dans ton propre sujet, mais cela reste tout à fait secondaire. L'important est ta problématique et ta configuration propres qui pourront conduire à un éventail de propositions peut-être très différentes de la bouée à laquelle tu essaies de t'accrocher.

Cordialement.

Bonjour MFerrand,

Je comprends bien l’idée de squatter le sujet d’un autre. je ne voulais pas faire mal et j’ai même pensé faire bien

Mais vu que j’ai utilisé les macros proposées ici (puis retenue l’une d’entre elle) je me suis dit que choses :

• que faire une nouveau sujet sur alors qu’un poste existe déjà ce n’était utile (et je pensais que ça allait alourdir le forum)
• ça pouvait servir à d’autres qui avaient déjà regarder et/ou suivi le sujet.

Pour l’envoi d’une fichier d’exemple le fichier que j’utilise est assez lourd, et comporte des coordonnées (société et collègues) que je ne souhaite pas diffuser.

Mais comme je viens de me faire taper sur les doigts, je vais essayer de déposer un fichier un peu similaire retiré de toute info perso.

Le temps de le constituer et je reviens ici