Discussion :

[Electro02]

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]

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]

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]

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]

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 …

[Electro02]

Je n'ai pas repris l'intégralité de la citation, j'ai enlevé la signature
Je plaisante, bien-sûr, c'est noté.

Merci pour cette piste de réflexion, je vais voir à cela !

[Marc-L]

Effectivement !  

[Electro02]

J'ai essayé :

Code :

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

ActiveSheet.Pictures.Delete

Pas d'arrêt de la macro mais pas d'effet

[Electro02]

J'ai tenté ça aussi, toujours sans effet :

Code :

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

1
2
3
4
5
6
7
8
9
Dim shape As Excel.shape
 
For Each shape In ActiveSheet.Shapes
    Select Case shape.Type
        Case msoPicture, msoMedia, msoShapeTypeMixed, msoOLEControlObject, msoAutoShape
            shape.Delete
        Case Else
    End Select
Next

[Electro02]

Et ça, c'est sans effet également... Je désespère...

Code :

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

1
2
3
4
Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic

A savoir, au besoin, pour l'aide que vous voudrez bien m'apporter :
je veux supprimer des images que j'ai insérées sur la feuille via Insertion/Images.
Chacune de ces images s'est vu attribué une macro ou un lien vers une autre feuille ou vers une cellule.
Ces images sont "flottantes" (non intégrées dans des cellules, mais placées par dessus le texte).

Je compte sur vous, car là je ne sais plus quoi essayer...

[Marc-L]

J'ai essayé :

Code :

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

ActiveSheet.Pictures.Delete

Pas d'arrêt de la macro mais pas d'effet

C'est exactement cela, cela fonctionne bien de mon côté pour des images …
Les deux autres codes auraient aussi dû fonctionner.

Placer la ligne de suppression dans une procédure Test et l'exécuter pour voir sur la feuille active des images …

[Electro02]

Oui, c'est dingue ! Cela fonctionne si je fais un test sur le fichier de destination. Mais pas si je le fais à partir du fichier principal (source).

Masi j'ai fini par trouvé la parade.
Ce n'est sûrement pas très pro et fait un peu "bricoleur du dimanche", mais au moins mon problème n'est plus.

Je donne le code pour qui cela pourrait dépanner un jour, faute d'avoir trouvé mieux :

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
75
 
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
        ActiveWorkbook.Close
 
        Application.AskToUpdateLinks = False
        Workbooks.Open (RepDest & NomTableau)
        ActiveSheet.Pictures.Delete
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Application.AskToUpdateLinks = True
 
        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
        ActiveWorkbook.Close
 
        Application.AskToUpdateLinks = False
        Workbooks.Open (RepDest & NomTableau)
        ActiveSheet.Pictures.Delete
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Application.AskToUpdateLinks = True
 
        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

Merci pour le coup de pouce, Marc-L

Je clôture en sujet résolu