Re : Recalcul avec VBA
Bonjour,
La touche F9 n'a aucun effet.
Voilà le code entier dans la feuille "Ethernet", sachant qu'il y a des calculs similaires dans d'autres feuilles. C'est quand on saisit qqchose en F6 que les calculs ne se font pas.
Par contre, tout est ok quand on saisit qqchose en D5, peut-être parce que cela fait appel au code du module 1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D5")) Is Nothing Then
'Si on a saisi qq chose en D5
Application.EnableEvents = False
Lister Range("D6")
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("D5
6")) Is Nothing Then
'Si on a saisi qq chose en D5
6
Range("D44") = Worksheets("Calculations").Range("H3")
Range("D49") = Worksheets("Calculations").Range("H4")
Range("D55") = Worksheets("Calculations").Range("H5")
Range("D59") = Worksheets("Calculations").Range("H6")
Range("G6") = Worksheets("Calculations").Range("H7")
Range("E18") = Worksheets("Calculations").Range("H12")
Range("E44") = Worksheets("Calculations").Range("H13")
Range("E49") = Worksheets("Calculations").Range("H14")
End If
If Not Intersect(Target, Range("F6")) Is Nothing Then
'Si on a saisi qq chose en F6
Range("E18") = Worksheets("Calculations").Range("H12")
Range("E44") = Worksheets("Calculations").Range("H13")
Range("E49") = Worksheets("Calculations").Range("H14")
Worksheets("Ethernet").Calculate
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Si cela peut aider, le code suivant se trouve dans le module 1 :
Sub Lister(Rg As Range)
Dim Ligne As Long
With Worksheets("Cities")
.Range("A1") = .Range("D3")
.Range("B:B").Clear
.Range("A2") = "*" & Worksheets(Rg.Parent.Name).Range("D5") & "*"
.Range("CITY_List").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("A1:A2"), CopyToRange:=.Range("B1"), _
Unique:=False
Ligne = .Range("B65536").End(xlUp).Row
If Ligne < 2 Then Ligne = 2
.Range("B2:B" & Ligne).Name = "MaListe"
End With
AjoutListeDeValidation Rg
End Sub
Sub AjoutListeDeValidation(Rg As Range)
With Worksheets(Rg.Parent.Name)
If Range("MaListe")(2, 1) <> "" Then
.Range("E6") = Range("MaListe").Rows.Count
Else
If Range("MaListe")(1, 1) <> "" Then
.Range("E6") = 1
Else
.Range("E6") = 0
End If
End If
.Range("D6") = ""
With .Range(Rg.Address).Validation
.Delete
.Add xlValidateList, , , "=MaListe"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End With
End Sub
Sub das()
Application.EnableEvents = True
End Sub
Merci de votre aide.