Compléter macro
a
Bonjour le forum
Je voudrais ajouter une partie de macro sous la forme de la partie existante ci-dessous
Mais
Remplacer 7 par 5
Remplacer 17 par16
ElseIf Not Intersect(Range("E7"), Target) Is Nothing Then
If Target = "" Then
Range("A17").ClearContents ' Suppression date si SUPPR cellule E7
Else
If Range("E17") = Range("E7") Then
Range("A17") = Application.Proper(Format(Date, "dddd dd mmmm yyyy")) ' Sinon on inscrit la date
End If
End If
ElseIf Not Intersect(Range("J2"), Target) Is Nothing Then
ModifTexteLoiAlur Range("G17"), Range("J2")Dans la macro complète ci-dessous
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date
Dim X, Y
Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
' On recherche si la page est surveillée
If Left(Sh.Name, 7) = "Charges" Then
If Not Intersect(Range("B12:B89,E12:E89"), Target) Is Nothing Then
If Target.Interior.ColorIndex = 2 Then
' Si la colonne B et la colonne E est vide on efface la date
Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("E" & Target.Row) = "", "", Application.Proper(Format(Date, "dddd dd mmmm yyyy")))
End If
ElseIf Not Intersect(Range("E7"), Target) Is Nothing Then
If Target = "" Then
Range("A17").ClearContents ' Suppression date si SUPPR cellule E7
Else
If Range("E17") = Range("E7") Then
Range("A17") = Application.Proper(Format(Date, "dddd dd mmmm yyyy")) ' Sinon on inscrit la date
End If
End If
ElseIf Not Intersect(Range("J2"), Target) Is Nothing Then
ModifTexteLoiAlur Range("G17"), Range("J2")
Application.EnableEvents = False
If Target = "" Then
Range("G91") = "Montant Annuel Fonds de Travaux Inclus dans Simulation & Solde Charges"
Joli Range("G91"), 9, 6, 3
Joli Range("G91"), 33, 6, 3
Joli Range("G91"), 45, 10, 3
Joli Range("G91"), 58, 13, 3
Else
Range("G91") = "Montant Annuel Fonds de Travaux À Titre Indicatif Cellule E5"
Joli Range("G91"), 9, 6, 3
Joli Range("G91"), 33, 17, 3
Joli Range("G91"), 58, 3, 3
End If
ElseIf Not Intersect(Range("J10"), Target) Is Nothing Then
Application.EnableEvents = False
If Target = "" Then
Range("G17") = "Montant Eau Chaude Inclus dans le Calcul Simulation & Solde Charges"
Range("G17").Font.ColorIndex = 2
Joli Range("G17"), 1, 7, 3
Joli Range("G17"), 20, 6, 3
Joli Range("G17"), 42, 10, 3
Joli Range("G17"), 55, 13, 3
Range("G94") = "Montant Annuel Eau Chaude Inclus dans Simulation & Solde Charges"
Joli Range("G94"), 9, 6, 3
Joli Range("G94"), 27, 6, 3
Joli Range("G94"), 38, 11, 3
Joli Range("G94"), 51, 14, 3
Else
Range("G17") = "Montant Eau Chaude Exclu du Calcul Simulation & Solde Charges"
Range("G17").Font.ColorIndex = 2
Joli Range("G17"), 1, 7, 3
Joli Range("G17"), 20, 5, 3
Joli Range("G17"), 36, 10, 3
Joli Range("G17"), 49, 13, 3
Range("G94") = "Montant Annuel Eau Chaude À Titre Indicatif Cellule E7"
Joli Range("G94"), 9, 6, 3
Joli Range("G94"), 27, 17, 3
Joli Range("G94"), 53, 2, 3
End If
Application.EnableEvents = True
'Fin modification du 27/11/2021
ElseIf Target.Column = 1 And Target.Row > 12 And Target.Interior.ColorIndex = 2 Then
If IsDate(Target) Then
Target = Application.Proper(Format(Target, "dddd dd mmmm yyyy"))
Else
Target = ""
End If
ElseIf Not Intersect(Target, Union(Range("E3"), Range("E8"))) Is Nothing Then
X = Range("E3").Value
Y = Range("E8").Value
If (X <> "") And (Y <> "") Then
Target.ClearContents
JouerSon
MsgBox "Impossible de saisir une valeur dans cellule " & Target.Address(rowabsolute:=False, columnabsolute:=False) & " car cellule " & IIf(Target.Address = "$E$8", "E3", "E8") & " renseigné"
End If
End If
End If
Application.EnableEvents = True
End SubÇa accroche mais je ne sait pas oùMerci à vous pour vos éventuels retours
Cordialement
a
re le forum
Avec toutes mes excuses il manquait un End if
Cordialement
Invité
Bonjour al87
Le titre "compléter macro" n'est pas conforme à la charte
- Rédigez soigneusement votre demande et choisissez un titre qui résume bien votre demande.
Vous avez trouvé, tant mieux
Ce post ira à la poubelle d'ici 1 semaine