Effacer signature dans deux cellules fusionnées

Bonjour,

je rencontre des difficultés d'écriture de commande, mon problème est le suivant : selon le technicien (="C46:D46") une signature scannée se met automatiquement dans les cellules fusionnées ("C50:D50")

jusque la je suis arrivée à lui dire si "C46:D46" = Jean Dupont alors tu insères la signature de Jean Dupont en "C50:D50" avant enregistrement PDF

Le problème que je rencontre c'est que je n'arrive pas à effacer la signature quand je souhaite que mon document redevienne vierge la signature ne s'efface pas.

voici le code installée:

Sub EffaceMentShapeCellule()

ActiveSheet

Dim S As Shape

  For Each S In .Shapes
      If Not Application.Intersect(S.TopLeftCell, .Range("c50:D50")) Is Nothing Then
         S.Delete
       End If
    Next S
End With
End Sub

Merci d'avance pour votre aide

Bonjour,

Et le code qui met la signature ?

Et le classeur, ce serait encore mieux !

'SIGNATURE TECHNICIEN

Sub signature_technicien()

  Dim chemin, chemin_2 As String

chemin = Range("Q2") & Range("Q3")
chemin_2 = Range("Q2") & Range("Q4")

Range("C50:D50").Select

If Range("C46") = "Patrick GUYOT" Then

  ActiveSheet.Pictures.Insert(chemin).Select

With Selection.ShapeRange
.LockAspectRatio = False 
.Top = 990 ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = 48 ' hauteur de la cellule
.Width = 144 ' largeur de la cellule
End With
With Selection
.PrintObject = True 
.Placement = xlMoveAndSize 
End With

Else

If Range("C46") = "Sébastien LALLEMAND" Then

  ActiveSheet.Pictures.Insert(chemin_2).Select

  With Selection.ShapeRange
.LockAspectRatio = False 
.Top = 990 ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = 48 ' hauteur de la cellule
.Width = 144 ' largeur de la cellule
End With
With Selection
.PrintObject = True 
.Placement = xlMoveAndSize
End With

  Else

             Exit Sub

  End If
  End If

End Sub

Plus le code est long... meilleur il n'est pas !

Réfractaire à la communication d'un fichier ?

c'est un document sur serveur avec données clients je ne préfère pas sans l'aval de mon responsable...

pour info ce code fonctionne, mais pas sur tous le PC, est ce un problème de version entre utilisateurs ???

Sub effacer_sign()

ActiveSheet.Unprotect "CODE"

    Dim img As Shape

    For Each img In Worksheets("modèle 15497").Shapes
     If img.Name Like "Picture*" Then
        img.Delete
     End If
    Next

ActiveSheet.Protect "CODE", True, True, True

End Sub

Sub signature_technicien()
    Dim chemin As String, pSign As Range
    With ActiveSheet
        Select Case .Range("C46")
            Case "Patrick GUYOT"
                chemin = .Range("Q2") & Range("Q3")
            Case "Sébastien LALLEMAND"
                chemin = .Range("Q2") & Range("Q4")
        End Select
        Set pSign = .Range("C50:D50")
        Application.ScreenUpdating = False
        With .Pictures.Insert(chemin).ShapeRange
            .LockAspectRatio = False
            .Top = pSign.Top
            .Left = pSign.Left
            .Height = pSign.Height
            .Width = pSign.Width
            .Name = "Visa"
        End With
    End With
End Sub

Sub effacer_sign()
    ActiveSheet.Shapes("Visa").Delete
End Sub