Installer plusieurs macros sur la même feuille
Bonjour,
Je suis néophyte dans le domaine du VBA et j'ai regardé beaucoup de vidéo sur Excel pour comprendre son mode de fonctionnement.
J'ai complété une bd sur laquelle je dois inséré deux macros. J'ai compris à la lecture de certain écris, qu'il était nécessaire de n'avoir qu'un "Private Sub Worksheet_Change(ByVal Target As Range)" et j'ai cru à tord qu'il suffisait de mettre les deux bout à bout pour que ça fonctionne.
Mais hélas, ça ne fonctionne toujours pas, par contre si j'en enlève un code sur les deux, ça fonctionne très bien.
J'ai regardé des réponses ici, mais je ne trouve toujours pas l'erreur.
Voici donc le code initial.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 3 To 1500
If Cells(i, "A").Value <> "" And Cells(i, "F") = "" Then Cells(i, "F") = Date
Cells(i, "F").NumberFormat = "m/d/yyyy"
Next
Range("F:F").EntireColumn.AutoFit
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
On Error GoTo Exitsub
If Target.Address = "$I$6" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Subet le code modifier
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 3 To 1500
If Cells(i, "A").Value <> "" And Cells(i, "F") = "" Then Cells(i, "F") = Date
Cells(i, "F").NumberFormat = "m/d/yyyy"
Next
Range("F:F").EntireColumn.AutoFit
Dim Oldvalue As String
Dim Newvalue As String
On Error GoTo Exitsub
If Target.Address = "$I$6" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End SubEdit modo : code mis entre balise
Si vous pouvez me corriger et m'expliquer ou j'ai fait l'erreur.
Merci de votre aide.
Bonjour Claude et
Vous venez de poster votre message avec un format qui empêche une bonne lisibilité
la prochaine fois, merci de mettre votre code entre balises, avec le bouton </>
Une petite présentation ICI serait la bienvenue
Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum
Merci de votre participation et de votre compréhension
A+
Je prends note merci.
Bonjour,
A tester !...
Cdlt.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim Oldvalue As String
Dim Newvalue As String
Dim i As Integer
On Error GoTo errHandler
Set Rng = Me.Range("A3:A1500")
If Not Intersect(Target, Rng) Is Nothing Then
If Not IsEmpty(Me.Cells(Target.Row, 1)) And IsEmpty(Me.Cells(Target.Row, 6)) Then
With Me.Cells(Target.Row, 6)
.Value = VBA.Date
.NumberFormat = "m/d/yyyy"
.EntireColumn.AutoFit
End With
End If
End If
If Target.Address = "$I$6" And Target.Validation Then
If Not IsEmpty(Target) Then
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If IsEmpty(Oldvalue) Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
exit_Handler:
Application.EnableEvents = True
Exit Sub
errHandler:
Resume exit_Handler
End SubMerci Jean-Eric,
Ça ne fonctionne pas mais je reprends.
Les deux codes fonctionnes séparément sans aucun problème.
Le premier code sert à mettre la date actuel (dès que je mets un (x) dans la case A..
Le deuxième code sert à mettre plusieurs (items de ma liste déroulante dans la même case)
Ce que je ne sais pas, c'est comment les ajouter l'un et l'autre dans la même feuille.
Merci,
Re,
Pour ne pas parler dans le vide, merci de déposer un fichier anonymisé SVP
A+
Bonjour,
Voici le fichier.
Le problème et je le répète, c'est que je ne sais pas comment les inséré les deux en même temps sur la feuille.
Le premier code sert: à insérer la date
Le deuxième code sert: à insérer plusieurs données l'une à la suite de l'autre dans la même cellule.
Ils fonctionnent très bien l'un et l'autre de façon individuelle, mais pas s'ils sont les deux l'un à la suite de l'autre.
J'espère avoir été un peu plus clair dans mes explications.
Claude
Re,
Voilà Claude, je pense avoir compris la philosophie
Le code
' Exécution après changement d'une cellule
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
' Si saisie dans la colonne A
If Not Intersect(Target, Range("A:A")) Is Nothing Then
' Si saisie non vide
If Target.Value <> "" Then
' Si pas de date inscrite
If Cells(Target.Row, "F") = "" Then
' Désactiver les évènements
Application.EnableEvents = False
' Inscrire la date au bon format
Cells(Target.Row, "F") = Format(Date, "m/d/yyyy")
Range("F:F").EntireColumn.AutoFit
' Réactiver les évènements
Application.EnableEvents = True
End If
End If
End If
On Error GoTo Exitsub
If Not Intersect(Target, Range("I:I")) Is Nothing Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then GoTo Exitsub
If Target.Value = "" Then GoTo Exitsub
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
Exitsub:
Application.EnableEvents = True
End SubLe fichier avec le code
A+
Un gros merci Bruno.
C'est exactement ce dont j'avais besoin.
Maintenant, je vais essayer de comprendre la logique derrière cette correction.
J'apprécie vraiment le temps que tu as pris pour me corriger.
Bonne journée