Supprimer des images ou les liens y étant rattachés

**Electro02** · 06/04/2018, 14h54

Bonjour à tous.

Je suis un noob autodidacte en VBA Excel. J'apprends beaucoup grâce à vos questions et réponses sur ce forum. D'abord merci à vous pour cela !

Chers Experts, donc, c'est à mon tour de vous solliciter car là franchement je coince et je n'arrive pas à me débrouiller seul

Le script de macro que je vous présente ci-dessous (désolé s'il est digne d'un super débutant lol) marche à merveille, sauf au moment où les images - que je réussi pourtant à sélectionner - ne se suppriment pas dans le fichier Excel de destination.
J'ai essayé différents bouts de scripts, différentes méthodes, mais au final, soit cela ne change rien, soit ça bogue.

Mon souci est précisément le suivant :
- Je veux exporter la feuille en cours dans un nouveau fichier (ça c'est good sauf que les images et leur lien restent). Les macros ne s'enregistrent pas dans le fichier de destination, mais comme les liens sont "intelligents", ils lancent quand même les macros en ouvrant le fichier source lol
- Sur le nouveau fichier (donc de destination), les images doivent disparaitre, ou, au pire, rester présentes, mais SANS aucun lien/hyperlien (vers des macros, d'autres feuilles du classeur d'origine, etc.)
- Pour conclure : l'utilisateur de la feuille exportée en un classeur à part ne doit pouvoir utiliser ni lien ni macro via les liens des images du fichier d'origine.

J'espère que c'est clair, car pas évident à expliquer

Si je fais mal les choses, soyez indulgents, merci

Mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 
Sub EnregistrementExcel()
 
    Dim DateTab As String, RepDest As String, RefAgent As String, VerifExist As String, CodeTab As String, NomTableau As String
 
    DateTab = Format(Date, "yyyymmdd")
    RepDest = "C:\DESTINATION\MACHINTRUC\"
    RefAgent = Application.UserName
    CodeTab = ActiveSheet.Name
    NomTableau = ActiveSheet.Cells(5, 7).Value & " - " & DateTab & " - " & CodeTab & " - " & RefAgent & ".xlsx"
 
 
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
    .LeftFooter = "ETABLISSEMENT / Service / " & Sheets("ACCUEIL").Range("C8")
    End With
 
    If IsEmpty(Cells(2, 1)) = True Then
    MsgBox ("Veuillez renseigner la référence du correspondant avant enregistrement au format Excel")
    Range("A2").Select
    Exit Sub
    End If
 
    If IsEmpty(Cells(5, 1)) = True Then
    MsgBox ("Veuillez renseigner le type d'anomalie avant enregistrement au format Excel")
    Range("A5").Select
    Exit Sub
    End If
 
    If MsgBox("Confirmez-vous l'enregistrement de ce fichier au format Excel ?", vbOKCancel) = vbOK Then
 
    VerifExist = Dir(RepDest & NomTableau)
 
    If VerifExist = "" Then
        Application.DisplayAlerts = False
 
        ThisWorkbook.ActiveSheet.Copy
        ActiveWorkbook.SaveAs Filename:=RepDest & NomTableau
 
'-------------- C'EST LA QUE CA COINCE ---------------------------------------------------------------------------------------------------
        ActiveSheet.Shapes.Range(Array("Picture 6", "Picture 5", "Picture 4", "Picture 3", "Picture 2", "Picture 1")).Select
        Selection.Delete
'------------------------------------------------------------------------------------------------------------------------------------------------
 
        ActiveWorkbook.Close
 
        MsgBox ("votre fichier a bien été enregistré sous : " & RepDest & NomTableau)
        Application.DisplayAlerts = True
    Else
 
    If MsgBox("Le fichier que vous voulez enregistrer existe déjà. Souhaitez-vous le remplacer ?", vbYesNo) = vbYes Then
        Application.DisplayAlerts = False
 
        ThisWorkbook.ActiveSheet.Copy
        ActiveWorkbook.SaveAs Filename:=RepDest & NomTableau
 
'-------------- C'EST LA QUE CA COINCE ---------------------------------------------------------------------------------------------------
        ActiveSheet.Shapes.Range(Array("Picture 6", "Picture 5", "Picture 4", "Picture 3", "Picture 2", "Picture 1")).Select
        Selection.Delete
'------------------------------------------------------------------------------------------------------------------------------------------------
 
        ActiveWorkbook.Close
 
        MsgBox ("votre fichier a bien été enregistré sous : " & RepDest & NomTableau)
        Application.DisplayAlerts = True
    Else
 
    MsgBox ("Fichier non enregistré au format Excel")
 
    End If
   End If
  End If
 
End Sub

1000 fois merci par avance pour votre précieuse aide !!!

**Electro02** · 06/04/2018, 16h19

PS : Et si par bonheur vous pouvez aussi me dire comment dire à la macro de prendre TOUTES les images de la feuille, sans avoir à détailler "picture 1", "picture 2", etc., ça serait le bonheur absolu !

Merci !

**Marc-L** · 06/04/2018, 16h22

Bonjour,

utiliser directement la collection Pictures de la feuille de calculs, pas besoin de Select …

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**Electro02** · 06/04/2018, 16h26

Envoyé par Marc-L

Bonjour,

utiliser directement la collection Pictures de la feuille de calculs, pas besoin de Select …

Bonjour !

Merci pour cette première réponse.
J'ai déjà entendu parlé de "collection", mais je n'ai pas tout saisi dans mes lectures...

Concrètement, pour mon bout de code VBA qui "coince", cela donnerait quoi ?

Merci

**Marc-L** · 06/04/2018, 16h30

Merci de ne pas citer l'intégralité du message juste précédent, aucun intérêt à part nuire à la lisibilité de la discussion !

{feuille de calculs}.{Collection}.{méthode action}

Remplacer les accolades par les éléments correspondants …

___________________________________________________________________________________________________________

L'effort fait les forts …