Bonjour à tous les passionnés de ce forum (toujours aussi épatant)
Je cherche à écrire une macro chargée de placer un code tout écrit dans les fichiers qu'elle crée.
Pour Information, ce code est listé ci-après,il est quasiment constant, il fonctionne, mais je ne sais absolument pas comment l'écrire via une autre macro . D'avance je vous remercie de votre aide.
Amicalement à tous
DMC
Je cherche à écrire une macro chargée de placer un code tout écrit dans les fichiers qu'elle crée.
Pour Information, ce code est listé ci-après,il est quasiment constant, il fonctionne, mais je ne sais absolument pas comment l'écrire via une autre macro . D'avance je vous remercie de votre aide.
Code:
Private Sub Worksheet_Calculate()
Static b As Boolean, I, Compteur As Single, Ligne As Range
If b = True Then Exit Sub
'If Target.Count > 1 Or b = True Then Exit Sub
b = True: Compteur = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Ligne = Cells.Find(what:="Remise sur articles :", After:=Cells(1, 1), LookIn:=xlFormulas, _
lookat:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not Ligne Is Nothing Then
On Error GoTo cas_err
For I = Ligne.Row - 1 To Ligne.Row
If Cells(I, 5) = 0 Then
Rows(I).RowHeight = 0
Else
Rows(I).EntireRow.AutoFit
Compteur = Compteur + 1
End If
Next I
If Compteur > 0 Then
Cells(Ligne.Row + 8, 3) = "les cases grisées indiquent les articles bénéficiant d'une remise individuelle"
Rows(Ligne.Row + 8).EntireRow.AutoFit
Rows(Ligne.Row + 3).EntireRow.AutoFit
Else
Rows(Ligne.Row + 8).RowHeight = 0
Rows(Ligne.Row + 3).RowHeight = 0
End If
If Compteur > 1 Then Rows(Ligne.Row + 2).EntireRow.AutoFit Else Rows(Ligne.Row + 2).RowHeight = 0
End If
If Cells(Ligne.Row + 6, 5) > 0 Then
Range("A" & Ligne.Row + 7 & ":A" & Ligne.Row + 7).EntireRow.AutoFit
Else
Range("A" & Ligne.Row + 7 & ":A" & Ligne.Row + 7).Rows.RowHeight = 0
End If
Columns("E:F").EntireColumn.AutoFit
GoTo finir
cas_err:
MsgBox ("vous avez saisi une valeur non numérique !")
Resume Next
finir:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
b = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' controle des valeurs sur moteurs
Static C As Boolean
If C = True Then Exit Sub
'If Target.Count > 1 Or b = True Then Exit Sub
If Not Intersect(Target, Range("e:e")) Is Nothing Then
C = True
If Cells(Target.Row, 1) = "DN" Then
If Target.Value <> 0 And Target.Value <> 1 Then
MsgBox (" Saisir 0 ou 1 pour les moteurs")
Cells(Target.Row, 5) = 0
End If
End If
C = False
End If
End Sub
DMC