Problème "Objet Requis"

Bonjour,

cette marco ne marche pas...Excel me dit "Objet requis" qlq peut me corriger le code MERCI.

Sub Clean()

    activesheet.Unprotect "???"
    activesheet.Range("R6,R12,R18").Value = "/"
    activesheet.Range("R7,R13,R19").Value = "/"
    activesheet.Range("Supr.4").Value = "1"
    activesheet.Range("R4").Value = ""

  If Target.Address = "R6,R12,R18" And Target.Count = 1 Then
    '-- suppression
    For Each s In activesheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, -11).Address Then
          s.Delete
        End If
      End If
    Next s
    End If

    activesheet.Protect "???", True, True, True
    

Bonjour

Précise la ligne mais déjà d'où sort Target ?

Salut,

Normalement le code est écris comme ceci:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$R$6" And Target.Count = 1 Then
    '-- suppression
    For Each s In activesheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, -11).Address Then
          s.Delete
        End If
      End If
    Next s
    '--
    If Target <> "" Then
        Sheets("DONNEES").Shapes(Target).Copy
        Target.Offset(0, 2).Select
        activesheet.Paste
        Selection.ShapeRange.Left = ActiveCell.Left - 867
        Selection.ShapeRange.Top = ActiveCell.Top + 8
        Target.Select
     End If

  End If

  If Target.Address = "$R$12" And Target.Count = 1 Then
    '-- suppression
    For Each s In activesheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, -11).Address Then
          s.Delete
        End If
      End If
    Next s
    '--
    If Target <> "" Then
        Sheets("DONNEES").Shapes(Target).Copy
        Target.Offset(0, 2).Select
        activesheet.Paste
        Selection.ShapeRange.Left = ActiveCell.Left - 867
        Selection.ShapeRange.Top = ActiveCell.Top + 8
        Target.Select
     End If
  End If

    If Target.Address = "$R$18" And Target.Count = 1 Then
    '-- suppression
    For Each s In activesheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, -11).Address Then
          s.Delete
        End If
      End If
    Next s
    '--
    If Target <> "" Then
        Sheets("DONNEES").Shapes(Target).Copy
        Target.Offset(0, 2).Select
        activesheet.Paste
        Selection.ShapeRange.Left = ActiveCell.Left - 867
        Selection.ShapeRange.Top = ActiveCell.Top + 8
        Target.Select
     End If
  End If

End Sub

En gros si dans la cellule R6,R12,R18 on met "/", l'image sélectionnée est blanche.

Avec une autre macro j'indique cette valeur automatiquement :

Sub Clean()
activesheet.Range("R6,R12,R18").Value = "/"
End Sub

Sauf qu'il ne se passe rien et l'image reste visible à l'ancienne valeur de R6 (par exemple).

Merci pour ton aide.

RE

If Target.Address = "$R$6" And Target.Count = 1

si l'adresse est "$R$6" c'est forcément que Target.Count = 1

Les 3 parties de code semblent identiques donc il faudrait utiliser

If Not Intersect(Target, Range("R6,R12,R18")) Is Nothing And Target.Count = 1 Then

et un seul code

Mais clean modifie 3 cellules d'un coup il ne faut pas tester Target.Count = 1

Mais ta logique est bizarre : pourquoi 2 codes ?

Mets tout dans clean en te référant aux 3 cellules concernées mais pas à target qui n'existe que une procédure événementielle...

Merci! effectivement c'était le :

activesheet.Range("R6,R12,R18").Value = "/"

qui bloquait. J'ai fais un code pour chaque cellule et ça marche!

Encore merci!