XL 2016 VBA insertion image non verrouillée

ks102

XLDnaute Nouveau
Bonjour à tous,

J'ai un code qui, lorsque je clique sur un bouton, insere une image.
J'ai un code qui supprime l'image du classeur lorsque je clique sur le bouton.

Mon classeur étant vérrouillé afin d'eviter toutes modifications, lorsque j'insere l'image celle-ci ce retrouve également vérouillée et donc impossible par la suite de la supprimer et donc me pose problème....

Voici mon code ci-dessous pour inserer la photo

VB:
Sub Inserer_traca()
    Dim Emplacement As Range
    Dim Img As Object
    Dim ShapeObj As Shape

Worksheets("EFNC").Protect Password:="UAPM", UserInterfaceOnly:=True

    If Application.Dialogs(xlDialogInsertPicture).Show Then
        'Définit l'emplacement de l'image
        Set Emplacement = Range("E19:J24")
 
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.DrawingObjects.Count)
 
        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .Name = "Cible"
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With
 
    Else
        MsgBox "Insertion d'image interrompue."
    End If
    
End Sub

Et mon code pour supprimer la photo:

VB:
Worksheets("EFNC").Shapes.Range(Array("Cible")).Select
    Selection.Delete


Merci d'avance pour votre retour
 

ks102

XLDnaute Nouveau
J'ai trouvé une astuce mais ca me pose un autre problème,

Si j'ajoute la ligne ci-dessous devant mon code pour supprimer la photo cela fonctionne
VB:
Worksheets("EFNC").Protect Password:="UAPM", UserInterfaceOnly:=True

Mais,
Lorsque j'ouvre mon classeur excel, j'ai un code qui m'ouvre le classeur en mode "anonyme" (voir code ci-dessous). Et si j'ajoute la ligne le mode anonyme ne fonctionne plus... :(

Code:
Option Explicit

'************************
Sub Interface_anonyme()
'************************
    Dim VL_feuille As Worksheet
    If ActiveWindow.DisplayGridlines = True Then
        ActiveWindow.DisplayGridlines = False
        ActiveWindow.DisplayHeadings = False
        Application.DisplayFormulaBar = False
        Application.DisplayFullScreen = True
        Application.DisplayScrollBars = False
        Application.DisplayFormulaBar = False
    Else
        For Each VL_feuille In Sheets
        On Error Resume Next
        VL_feuille.Select
        ActiveWindow.DisplayGridlines = True
        ActiveWindow.DisplayHeadings = True
        Application.DisplayFullScreen = True
        Application.DisplayScrollBars = True
        Application.DisplayFormulaBar = True
        On Error GoTo 0
        Next
        Application.WindowState = xlNormal
        Application.WindowState = xlMaximized
        Application.DisplayFormulaBar = True
        Sheets("EFNC").Select
    End If
End Sub
 

Statistiques des forums

Discussions
312 086
Messages
2 085 197
Membres
102 814
dernier inscrit
JLGalley