Erreur de compilation nom ambigu détecté worksheet_change

Le 18/10/2025 à 22:44

Bonsoir,

Je souhaite que les 2 codes fonctionnent mais j'ai le message d'erreur "erreur de compilation nom ambigu détecté worksheet_change".

Comment compiler mes formules, j'ai regardé quelques tutos mais je ne comprends pas comment faire.. merci d'avance,

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Larg As Double
Dim Haut As Double
Dim HautOrig As Double
Dim ColDeb As Integer
Dim ColFin As Integer

ColDeb = 9 'Colonne I
ColFin = 15 'Colonne O

If Target.Column >= ColDeb And Target.Column <= ColFin And Target.Count = 1 Then

HautOrig = Target.Parent.Rows(Target.Row).RowHeight 'On mémorise la hauteur de la ligne

If Target.Value = "" Or Trim(Target.Value) = "" Then 'Si la cellule est vide, on supprimer la forme
On Error Resume Next
ActiveSheet.Shapes("Rond" & Target.Row & "_" & Target.Column).Delete
On Error GoTo 0
Target.Parent.Rows(Target.Row).RowHeight = HautOrig
Else
On Error Resume Next
ActiveSheet.Shapes("Rond" & Target.Row & "_" & Target.Column).Delete 'Suppression ancienne forme
On Error GoTo 0

On Error Resume Next
Feuil1.Shapes(Target.Value).Copy

If Err.Number = 0 Then
ActiveSheet.Paste
With Selection
.Name = "Rond" & Target.Row & "_" & Target.Column
.Visible = True
End With

Larg = Feuil1.Shapes(Target.Value).Width
Haut = Feuil1.Shapes(Target.Value).Height

With Selection.ShapeRange 'Forme au centre de la cellule
.Left = Target.Left + (Target.Width - Larg) / 2
.Top = Target.Top + (Target.Height - Haut) / 2
End With

If Haut + 4 > HautOrig Then 'Ajuste la hauteur de ligne
Target.Parent.Rows(Target.Row).RowHeight = Haut + 4
Else
Target.Parent.Rows(Target.Row).RowHeight = HautOrig 'Hauteur d'origine
End If

Target.Select
End If
On Error GoTo 0
End If
End If

MajBarresFeuil6

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("G14:G300")) Is Nothing 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
If InStr(1, Oldvalue, Newvalue & ", ") > 0 Then

Target.Value = Replace(Oldvalue, Newvalue & ", ", "")
ElseIf InStr(1, Oldvalue, ", " & Newvalue) > 0 Then

Target.Value = Replace(Oldvalue, ", " & Newvalue, "")
ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then

Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Le 18/10/2025 à 23:10

et est ce que c'est possible que l'lorsque je rentre plusieurs choix, ils se mettent en dessous l'un après l'autre et non à la suite ?

Merci,,

Le 19/10/2025 à 08:14

Bonjour Séverine,

Tu as 2 X la même Sub() d'où nom ambigu.

Private Sub Worksheet_Change(ByVal Target As Range)

Tout ce qui concerne un événement DOIT être codé dans UNE seule et même Sub() de cet événement en y précisant chaque fois, évidemment, à quel élément particulier il se rapporte.

Petit détail pratique : quand tu veux insérer du code dans un message, histoire que ce soit lisible, utilise l'icône </> dans la barre d'outil de la fenêtre d'édition du message.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("G14:G300")) Is Nothing Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
.
.
End Sub

Pour le reste, d'abord le petit café du matin et la promenade des chiens. Oula, sacré ça, ici, pour madame!

A+

Le 19/10/2025 à 10:30

bonjour salafia, salut Curilis,

je pense à ceci (sans fichier )

Private Sub Worksheet_Change(ByVal Target As Range)

     Dim Larg  As Double
     Dim Haut  As Double
     Dim HautOrig As Double
     Dim ColDeb As Integer: ColDeb = 9       'Colonne I
     Dim ColFin As Integer: ColFin = 15      'Colonne O

     Dim Oldvalue As String
     Dim Newvalue As String
     Dim c As Range, shp As Shape, ShpNew

     '************** partie 1 ************************************************************
     Set c = Intersect(Target, Range("G14:G300"))     'juste les cellules modifiés de cette plage
     If Not c Is Nothing And c.Cells.CountLarge = 1 Then     's'iln'y a qu'une seule cellule modifiée
          If Len(Trim(c.Value2)) > 0 Then    'cellule n'est pas vide
               On Error Resume Next
               s = c.Validation.Formula1     'specialcells triggers un évenement !
               On Error GoTo 0
               If Err.Number = 0 Then        'cellule contient validation
                    Application.EnableEvents = False
                    Newvalue = c.Value
                    Application.Undo
                    Oldvalue = c.Value
                    If Oldvalue = "" Then
                         Target.Value = Newvalue
                    Else
                         If InStr(1, Oldvalue, Newvalue & ", ") > 0 Then
                              c.Value = Replace(Oldvalue, Newvalue & ", ", "")
                         ElseIf InStr(1, Oldvalue, ", " & Newvalue) > 0 Then
                              c.Value = Replace(Oldvalue, ", " & Newvalue, "")
                         ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then
                              c.Value = Oldvalue & ", " & Newvalue
                         End If
                    End If
                    Application.EnableEvents = True
               End If
          End If
          MajBarresFeuil6
     End If

     '************** partie 2 ************************************************************
     If ColDeb <= Target.Column And Target.Column <= ColFin And Target.Count = 1 Then

          HautOrig = Target.RowHeight        'On mémorise la hauteur de la ligne

          On Error Resume Next
          Me.Shapes("Rond" & Target.Row & "_" & Target.Column).Delete     'on efface toujours ce shape, s'il existe
          On Error GoTo 0

          If Trim(Target.Value) = "" Then    'Si la cellule est vide, on supprimer la forme
               Target.RowHeight = HautOrig
          Else

               i = Me.Shapes.Count
               On Error Resume Next
               Set shp = Feuil1.Shapes(Target.Value)
               On Error GoTo 0
               If Not shp Is Nothing Then
                    shp.Copy
                    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents     'pacienter un peu
                    ActiveSheet.Paste
                    DoEvents: DoEvents: DoEvents: DoEvents: DoEvents     'pacienter un peu
                    On Error Resume Next
                    Set ShpNew = Me.Shapes(i + 1)     'nouveau shape dans cette feuille
                    On Error GoTo 0
                    If Not ShpNew Is Nothing Then
                         With ShpNew
                              .Name = "Rond" & Target.Row & "_" & Target.Column
                              .Visible = True
                              .Left = Target.Left + (Target.Width - shp.Width) / 2
                              .Top = Target.Top + (Target.Height - shp.Height) / 2
                              If .Height + 4 > HautOrig Then     'Ajuste la hauteur de ligne
                                   Target.RowHeight = .Height + 4
                              Else
                                   Target.RowHeight = HautOrig     'Hauteur d'origine
                              End If
                         End With
                    End If
                    Application.CutCopyMode = False
                    Target.Select
               End If
          End If
     End If
End Sub
Le 20/10/2025 à 11:14

Bonjour,

Merci pour vos retours. En effet avec un fichier c'est toujours mieux!

En fait j'ai un fichier dont je souhaite pouvoir intégrer des barres de progression de l'action. (par contre la page gouv asso les barres ne fonctionnent pas bien..il y a un décalage j'ai l'impression...)

Puis j'ai souhaité en colonne G sur les différentes feuilles intégrer une liste déroulantes à choix multiples (et que les choix se mettent l'un après l'autre et centré).

Dès que je tente des codes, les 2 souhaits ne fonctionnent pas ensemble ...

12plan-action-v2.xlsm (94.18 Ko)

Une aide me serait très précieuse, car je galère depuis plusieurs jours...

Un GRAND MERCI d'avance,

Rechercher des sujets similaires à "erreur compilation nom ambigu detecte worksheet change"