Traduction de code
Bonjour a tous et bonne année!!!
Est-ce que quelqu'un serait capable de me traduire ce code ligne par ligne s'il vous plais, j'ai besoin de refaire plus ou moins la même chose.
Merci d'avance
Private Sub cmdNewDevis_Click()
'
Dim tMois()
tMois = Array("Null", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOÛT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
sDevis = Me.cmdNewDevis.Caption
'Création d'une nouvelle ligne devis
If [B12] <> tMois(Month(Now)) Then
If [B12] <> "" Then
For x = 1 To 4
Range("A12:N12").Insert shift:=xlDown
Next
Range("B16:N16").Interior.Color = Worksheets("Bibliothèque").Range("A" & [A1] + 1).Interior.Color
End If
iMod = Int(Month(Now) Mod 2)
[A1] = 1 + (iMod * 2)
[A2] = 1
[B12] = tMois(Month(Now))
Else
Range("A12:N12").Insert shift:=xlDown
[B12] = [B13]
[A2] = IIf([A2] = 1, 0, 1)
End If
'Bordures
If [A2] > 0 Then Range("B12:N12").Interior.Color = Worksheets("Bibliothèque").Range("A" & [A1]).Interior.Color
Range("B12:N13").Borders.LineStyle = 1
Range("B12:N13").Borders.Color = Worksheets("Bibliothèque").Range("A" & [A1] + 1).Interior.Color
'
[C13] = Date
[B13] = sDevis
[N13] = "En attente"
'Construction du nouveau n° de devis
sNewDevis = Trim(Str$(Year(Now) - 2000)) & "D/" & Format$(Month(Now), "00") & "-"
Select Case sDevis
Case Is = ""
sNewDevis = sNewDevis & "01"
Case Else
If Val(Left$(sDevis, 2)) = Year(Now) - 2000 And Val(Mid(sDevis, 5, 2)) = Month(Now) Then
sNewDevis = sNewDevis & Format$(Val(Right$(sDevis, 2) + 1), "00")
Else
sNewDevis = sNewDevis & "01"
End If
End Select
Me.cmdNewDevis.Caption = sNewDevis
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub
Private Sub Worksheet_Activate()
'
Application.EnableEvents = False
'
Range("A1:O1").Select
ActiveWindow.Zoom = True
Range("A1").Select
'
Application.EnableEvents = True
'
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tMois()
Dim rCell As Range
tMois = Array("Null", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOÛT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iTRow = Target.Row
Set rCell = Columns("N").Find("Statut", SearchDirection:=xlNext)
iTopRow = rCell.Row + 2
iRow = Range("N" & Rows.Count).End(xlUp).Row
'
If Not Application.Intersect(Target, Range("N" & iTopRow & ":N" & iRow)) Is Nothing Then
If Target.Value = "Gagné" Then
With Worksheets("Carnet de commande")
'mise en mémoire du prochain n° de facture
sFact = .OLEObjects("lblNumFacture").Object.Caption
'réglage de l'affichage
If .[B7] <> tMois(Month(Now)) Then
If .[B7] <> "" Then
For x = 1 To 4
.Range("A7:Q7").Insert shift:=xlDown
Next
.Range("B11:Q11").Interior.Color = Worksheets("Bibliothèque").Range("A" & .[A1] + 1).Interior.Color
End If
iMod = Int(Month(Now) Mod 2)
.[A1] = 1 + (iMod * 2)
.[A2] = 1
.[B7] = tMois(Month(Now))
Else
.Range("A7:Q7").Insert shift:=xlDown
.[B7] = .[B8]
.[A2] = IIf(.[A2] = 1, 0, 1)
End If
.[B8] = sFact
'
If .[A2] > 0 Then .Range("B7:Q7").Interior.Color = Worksheets("Bibliothèque").Range("A" & .[A1]).Interior.Color
.Range("B7:Q8").Borders.LineStyle = 1
.Range("B7:Q8").Borders.Color = Worksheets("Bibliothèque").Range("A" & .[A1] + 1).Interior.Color
'Construction du nouveau n° de facture
sNewFact = Trim(Str$(Year(Now) - 2000)) & "F/" & Format$(Month(Now), "00") & "-"
Select Case sFact
Case Is = ""
sNewFact = sNewFact & "01"
Case Else
If Val(Left$(sFact, 2)) = Year(Now) - 2000 And Val(Mid(sFact, 5, 2)) = Month(Now) Then
sNewFact = sNewFact & Format$(Val(Right$(sFact, 2) + 1), "00")
Else
sNewFact = sNewFact & "01"
End If
End Select
.OLEObjects("lblNumFacture").Object.Caption = sNewFact
'Transfert des données
.Range("C8").Value = Format$(Date, "dd/mm/yy")
.Range("D8").Value = Range("B" & iTRow).Value
.Range("E8:F8").Value = Range("D" & iTRow & ":E" & iTRow).Value
.Range("H8:J8").Value = Range("F" & iTRow & ":H" & iTRow).Value
'
'Installation des formules
.Range("K8").FormulaLocal = "=SI(ET(I8>0;J8>0);I8*J8;"""")"
.Range("L8").FormulaLocal = "=SI(K8<>"""";K8+I8;"""")"
.Range("O8").FormulaLocal = "=SI(ET(I8=0;M8=0;N8=0);"""";I8-M8-N8)"
'
.Activate
End With
End If
End If
'
'Majuscule à la première lettre de certaines données
'Nom client Ville Canal
If Not Application.Intersect(Target, Range("D" & iTopRow & ":D" & iRow), Range("I" & iTopRow & ":I" & iRow), Range("J" & iTopRow & ":J" & iRow)) Is Nothing Then
sFlag = Target.Value
Target.Value = UCase$(Left$(sFlag, 1)) & Right$(sFlag, Len(sFlag) - 1)
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub
Bonsoir,
vous avez de la chance, j'étais dans un "bon jour"
Voici ma traduction :
' quand on clic sur le bouton
Private Sub cmdNewDevis_Click()
' définition d'un tableau avec pour nom tMois
Dim tMois()
' attribution des valeurs contenues dans ce tableau
' tMois(0) = "Null"
' tMois(1) ="JANVIER" etc
tMois = Array("Null", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOÛT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
' arrêt de la surveillance des événement se produisant sur la feuille concidérée
Application.EnableEvents = False
' arrêt de la mise à jour de l'écran pour l'application, cela évite de "voir" scintiller l'écran lors de changement de feuille lors du déroulement du code par exemple
Application.ScreenUpdating = False
' attribution à la variable sDevis le texte écrit sur le boutton cmdNewDevis
sDevis = Me.cmdNewDevis.Caption
'Création d'une nouvelle ligne devis
' test si la valeur contenue dans la cellule B12 de la feuille active est différente du nom du mois du mois en cours c'est à dire du mois de l'horloge
' de l'ordinateur Now = date est heure de l'horloge, Month(Now) = mois de la date et l'heure de l'horloge
If [B12] <> tMois(Month(Now)) Then
' si la valeur de la cellule B12 est différente de rien donc non vide
If [B12] <> "" Then
' alors on lance une boucle de 4 tour (de 1 à 4)
For x = 1 To 4
' à chaque tour on insère une série de cellule (de la colonne A à la colonne N) au dessus de la ligne 12
Range("A12:N12").Insert shift:=xlDown
Next
' sélection des cellules allant de la colonne B à la colonne N de la ligne 16 pour leur attribuer
' la couleur intérieur de la cellule en colonne A et à la ligne de la valeur de la cellule A1 de la feuille actuelle +1 de la feuille
' bibliothèque. En somme si la feuille actuelle est "Tableau" alors dans la cellule A1 de la feuille tableau se trouve une valeur numérique (exemple 26)
' on va donc chercher la couleur intérieur de la cellule A27 (26+1) de la feuille bibliothèque et on l'applique
' a la série de cellule allant de B16 à N16 de la feuille "Tableau"
Range("B16:N16").Interior.Color = Worksheets("Bibliothèque").Range("A" & [A1] + 1).Interior.Color
End If
' on attribu à la variable iMod la partie entière du reste de la division du numéro du mois de l'horloge de l'ordinateur par 2
' exemple : mois mars = 3, 3/2 = 1 fois 2 et rest 1 => partie entière de 1 = 1 ce doit être pour savoir si c'est un mois impaire ou paire
iMod = Int(Month(Now) Mod 2)
' on attribu la la cellule de la feuille active la valeur de iMod multipliée par 2 à qui on ajoute 1, avec le cas ci-dessus
' iMod x 2 = 2 + 1 = 3, donc A1 de la feuille "tableau" prend la valeur 3 (tiens c'est Mars...)
[A1] = 1 + (iMod * 2)
' on attribu à la cellule A2 de cette même feuille la valeur de 1
[A2] = 1
' on attribue à la cellule B12 le nom du mois en cour de l'horloge de l'ordinateur
[B12] = tMois(Month(Now))
' si la valeur contenue dans la cellule B12 de la feuille active est égal au nom du mois en cours alors... (en fait si ce n'est pas différent c'est que c'est égal)
Else
' on insère qu'une série de cellule allant de la colonne A à la colonne N au dessus de la ligne 12
Range("A12:N12").Insert shift:=xlDown
' on attribu à la cellule B12 la valeur de la cellule B13 (anciennement valeur de la cellule B12...Vu qu'on a tout décaler vers le bas...)
[B12] = [B13]
' on attribue à la cellule A2 la valeur opposée de ce qu'elle contient car le code veut dire :
' si A2=1 alors 0 sinon 1
[A2] = IIf([A2] = 1, 0, 1)
End If
'Bordures
' si la valeur de A2 est strictement supérieur à 0
' en fait on a vu juste au dessus qu'elle peut avoir pour valeur 1 ou 0
' donc c'est pareil que de dire IF [A2]=1
' Then = alors
' on attribue aux cellules allant de la colonne B à la colonne N de la ligne 12 la couleur intérieure de la cellule de la colonne A
' et de la ligne égal à la valeur de la cellule A1+1 de la feuille bibliothèque
' et on a vu plus haut que la valeur de la cellule en A1 est = au numéro du mois de l'année, donc je présume que sur la feuille bibliothèque
' les cellules allant de A2 à A13 ont chacune une couleur correspondant à chaque mois de l'année...
If [A2] > 0 Then Range("B12:N12").Interior.Color = Worksheets("Bibliothèque").Range("A" & [A1]).Interior.Color
' mise en place des bordures "lignes pleine simple" sur les cellules allant de la colonne B à la colonne N de la ligne 12 à la ligne 13
' Quadrillage complet
Range("B12:N13").Borders.LineStyle = 1
' Ces bordure ont pour couleur la même couleur que l'intérieur des cellules de la ligne 12
Range("B12:N13").Borders.Color = Worksheets("Bibliothèque").Range("A" & [A1] + 1).Interior.Color
' on attribue à la cellule C13 la date actuelle de l'horloge de l'ordinateur
[C13] = Date
' on attribue à la cellule B13 la valeur de la variable sDevis qui est égal au texte écrit sur le boutton cmdNewDevis
[B13] = sDevis
' on attribue à la cellule N13 la valeur En attente
[N13] = "En attente"
'Construction du nouveau n° de devis
' on attribue à la variable sNewDevis la concaténation de plusieurs choses, c'est à dire on met bout à bout les morceaux de phrases
' Year(Now) - 2000 = année actuelle de l'horloge de l'ordinateur - 2000 = 2017-2000=17
' Str$ transforme un nombre en chaine de carractère mais il ajoute un espace devant donc Str$(17) = espace17 = _17
' j'ai mis un underscore afin de faire apparaitre l'espace
' Trim permet de retirer les espaces en début de chaine et en fin de chaine donc Trim(Str$(Year(Now) - 2000)) = Trim(_17) = 17
' Format$(Month(Now), "00") = permet de prendre le numéro du mis sur deux chiffres donc janvier = 1 = 01
' il suiffit de mettre bout à bout tous les morceuax : 17 & D/ & 03 & - =>17D/03-
' donc sNewDevis = 17D/03-
sNewDevis = Trim(Str$(Year(Now) - 2000)) & "D/" & Format$(Month(Now), "00") & "-"
' ici un aiguillage de code en fonction de la valeur de sDevis
Select Case sDevis
' si sDevis = rien
Case Is = ""
' alors sNewDevis = sNewDevis concaténé avec 01 = dans notre exemple à 17D/03-01
sNewDevis = sNewDevis & "01"
' si sDevis n'est pas égal à rien alors
Case Else
' on test si la valeur numérique des deux carractères en partant de la gauche de sNewDevis est = à l'année de l'horloge de l'ordinateur - 2000
' et que la valeur numérique des deux caractères de sNewDevis en partant du cinquième caractère compris en partant de la gauche
' et égal au numéro du mois du système alors
' dans notre exemple cela revient à dire si 17=17 et 03 = 03 alors
If Val(Left$(sDevis, 2)) = Year(Now) - 2000 And Val(Mid(sDevis, 5, 2)) = Month(Now) Then
' alors sNewDevis = sNewDevis concaténé l a valeur numérique des deux caractères de sDevis en partant de la droite
sNewDevis = sNewDevis & Format$(Val(Right$(sDevis, 2) + 1), "00")
Else
' sinon
' ' alors sNewDevis = sNewDevis concaténé avec 01 = dans notre exemple à 17D/03-01
sNewDevis = sNewDevis & "01"
End If
' fin de l'aiguillage
End Select
' le nom du boutton est modifié avec la concaténation finale de sNewDevis !
Me.cmdNewDevis.Caption = sNewDevis
' on remet en marche la mise à jour de l'écran
Application.ScreenUpdating = True
' on remet en marche la surveillance des événements
Application.EnableEvents = True
' fin de la procédure
End Sub
' quand la feuille est activée
Private Sub Worksheet_Activate()
' on arrête la surveillance des événements
Application.EnableEvents = False
' on sélectionne les cellules allant de la colonne A à la colonne O de la ligne 1 de la feuille
Range("A1:O1").Select
' on active le zoom afin qu'il s'adapte à la largeur total de cette sélection
ActiveWindow.Zoom = True
' on sélectionne la cellule A1
Range("A1").Select
' on remet en marche la surveillance des événements
Application.EnableEvents = True
' fin de la procédure
End Sub
' si une valeur quelconque est modifiée sur la feuille (en somme si on quitte une cellule par la touche [entrée]
Private Sub Worksheet_Change(ByVal Target As Range)
' on définie un tableau tMois
Dim tMois()
' on définie un objet de type Range (cellule ou plage de cellule)
Dim rCell As Range
' on définie les valeurs du tableau
tMois = Array("Null", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOÛT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
' on arrête la surveillance des événements
Application.EnableEvents = False
' on arrête la mise à jour de l'écran
Application.ScreenUpdating = False
' on attribue à la variable iRow le numéro de la ligne de la cellule qui vient d'être modifiée
iTRow = Target.Row
' on attibue à l'objet rCell l'adresse de la cellule qui contien "Statut" en partant de la ligne 1 vers le bas
Set rCell = Columns("N").Find("Statut", SearchDirection:=xlNext)
' on attribue à iTopRow la valeur de la ligne de la cellule trouvée ci dessus à qui on ajoute 2
iTopRow = rCell.Row + 2
' on attribue à iRow le numéro de ligne de la dernière celllule pleine (ou non vide) de la colonne N en partant d'en bas et en remontant
iRow = Range("N" & Rows.Count).End(xlUp).Row
'
' Attention double négation !!!!
' Application.Intersect(Target, Range("N" & iTopRow & ":N" & iRow)) Is Nothing = on vérifie que la cellule modifiée (Target) n'est pas comprise
' dans la plage de cellule allant de la ligne iTopRow à iRow en colonne N
' mais comme il y a le NOT avant en fait on a une double négation !!! donc une affirmation :
' si je n'ai pas "pas d'intersection", alors ça veu dire que j'ai une intersection, donc on en arrive au test simplifié :
' si Target est comprise dans la colonne N entre la ligne iTopRow et iRow alors
If Not Application.Intersect(Target, Range("N" & iTopRow & ":N" & iRow)) Is Nothing Then
' si la valeur de la cellule modifiée (Target) est égale à "Gagné" alors
If Target.Value = "Gagné" Then
' pour une simplification d'écriture on dit "avec la feuille nommée "Carnet de commande" nous allons faire ce qui suit
With Worksheets("Carnet de commande")
'mise en mémoire du prochain n° de facture
' on attribue à sFact la valeur du texte afficher sur l'objet lblNumFacture de la feuille "Carnet de commande" (on dira "cette feuille" c'est plus court)
sFact = .OLEObjects("lblNumFacture").Object.Caption
'réglage de l'affichage
' si la valeur de la cellule B7 de cette feuille est différente au nom du mois du mois "système" alors
If .[B7] <> tMois(Month(Now)) Then
' si cette valeur est différente de rien (c'est à dire autre chose que le nom d'un mois...) alors
If .[B7] <> "" Then
' on effectue une boucle 4 fois
For x = 1 To 4
' et à chaque boucle on insère une série de cellule allant de la colonne A à la colonne Q de cette feuille au dessus de la ligne 7
.Range("A7:Q7").Insert shift:=xlDown
Next
' sur cette feuille on colorise les cellules allant de la colone B à la colonne Q en ligne 11
' avec la couleur de la cellule se trouvant sur la feuille bibliothèque en fonction du mois actuel du système
.Range("B11:Q11").Interior.Color = Worksheets("Bibliothèque").Range("A" & .[A1] + 1).Interior.Color
End If
' ici c'est le même principe qu'un peu plus haut.....
iMod = Int(Month(Now) Mod 2)
.[A1] = 1 + (iMod * 2)
.[A2] = 1
.[B7] = tMois(Month(Now))
Else
.Range("A7:Q7").Insert shift:=xlDown
.[B7] = .[B8]
.[A2] = IIf(.[A2] = 1, 0, 1)
End If
' on attribue à B8 la valeur de sFact
.[B8] = sFact
' ici c'est comme plus haut on met les bordures et on colorise
If .[A2] > 0 Then .Range("B7:Q7").Interior.Color = Worksheets("Bibliothèque").Range("A" & .[A1]).Interior.Color
.Range("B7:Q8").Borders.LineStyle = 1
.Range("B7:Q8").Borders.Color = Worksheets("Bibliothèque").Range("A" & .[A1] + 1).Interior.Color
'Construction du nouveau n° de facture
' le principe de construction du numéro de facture et le m^me que celui du numéro de devis
sNewFact = Trim(Str$(Year(Now) - 2000)) & "F/" & Format$(Month(Now), "00") & "-"
Select Case sFact
Case Is = ""
sNewFact = sNewFact & "01"
Case Else
If Val(Left$(sFact, 2)) = Year(Now) - 2000 And Val(Mid(sFact, 5, 2)) = Month(Now) Then
sNewFact = sNewFact & Format$(Val(Right$(sFact, 2) + 1), "00")
Else
sNewFact = sNewFact & "01"
End If
End Select
' une fois le numéro de facture construit on l'attribue au texte se trouvant sur l'objet de cette feuille
.OLEObjects("lblNumFacture").Object.Caption = sNewFact
'Transfert des données
' on attribue plusieurs valeurs à plusieurs cellules de cette feuille
.Range("C8").Value = Format$(Date, "dd/mm/yy")
.Range("D8").Value = Range("B" & iTRow).Value
.Range("E8:F8").Value = Range("D" & iTRow & ":E" & iTRow).Value
.Range("H8:J8").Value = Range("F" & iTRow & ":H" & iTRow).Value
'
'Installation des formules
' on écrit des formules dans certaines cellules de ctte feuille
.Range("K8").FormulaLocal = "=SI(ET(I8>0;J8>0);I8*J8;"""")"
.Range("L8").FormulaLocal = "=SI(K8<>"""";K8+I8;"""")"
.Range("O8").FormulaLocal = "=SI(ET(I8=0;M8=0;N8=0);"""";I8-M8-N8)"
'
' on active cette feuille
.Activate
' on en a fini de la simplification d'écriture avec cette feuille
End With
End If
End If
'
'Majuscule à la première lettre de certaines données
'Nom client Ville Canal
' attention !!! même principe de double négation !!!!
' en fait ici on vérifie si la cellule modifiée est en colonne D (Client) I (Ville) J(Canal)
' si c'est le cas, alors
If Not Application.Intersect(Target, Range("D" & iTopRow & ":D" & iRow), Range("I" & iTopRow & ":I" & iRow), Range("J" & iTopRow & ":J" & iRow)) Is Nothing Then
' on attribue à la variable sFlag la valeur de la cellule modifiée
sFlag = Target.Value
' on attribue à la celule modifiée son ancienne valeur avec une majuscule (à priori le reste reste comme c'est)
Target.Value = UCase$(Left$(sFlag, 1)) & Right$(sFlag, Len(sFlag) - 1)
End If
' on remet en marche la mise à jour de l'écran
Application.ScreenUpdating = True
' on remet en marche la surveillance des événements
Application.EnableEvents = True
' fin de la procédure
End Sub@ bientôt et bonne année !!!
LouReeD
Merci beaucoup c'est vraiment très très sympa de ta pars!!
A bientôt merci encore
Bonjour,
et merci de votre merci !
@ bientôt
LouReeD