Discussion :

[DECLERC]

Bonjour

Je préviens : Je ne connais rien en Macro.
Je voudrais créer une macro pour insérer des images d'un dossier dans un doc Word (Office 365) et avoir une boite de dialogue qui s'ouvre juste après l'insertion pour proposer de supprimer les images du dossier.
J'ai trouvé ceci sur la toile (ça fonctionne) mais je ne sais pas comment faire pour avoir un message me demandant la confirmation de la suppression des images du dossier.
Vu mes connaissances nulles, je m'en remets à vous. Peut être faut il tout modifier, ou compléter en tous cas toutes vos aides me seront les bienvenues. Merci d'avance.

Voici la macro:

Sub InsereImg()
'
' InsImg Macro

Dim Repertoire As String
Dim Extension As String
Dim Fichier As String
Dim image As Object
'Saisie du nom du répertoire
Repertoire = "D:\Onedrive\Images2\" 'mettre le chemin du dossier image
'Saisie du type d'extension
Extension = "jpg"

'Récupération du premier fichier du répertoire
Fichier = Dir(Repertoire & "*" & Extension, vbDirectory)

Do While Fichier <> ""
'Insertion de l'image
'Selection.InlineShapes.AddPicture FileName:=Repertoire & Fichier
Set image = Selection.InlineShapes.AddPicture(Repertoire & Fichier)
With image
.LockAspectRatio = msoTrue
'.Height = CentimetersToPoints(xx)
.Width = CentimetersToPoints(17)
End With
'Insertion d'une ligne vide
Selection.TypeParagraph
'Récupération du prochain fichier du répertoire
Fichier = Dir
Loop
End Sub

[E KERGRESSE]

Bonjour,

Pourquoi une boite de dialogue si les fichiers doivent être supprimés ?

[DECLERC]

Bonjour
Je ne sais pas si cela s'appelle vraiment une boite de dialogue
Je voudrais une fenêtre qui s’affiche quand l'insertion des images est faite pour confirmer la suppression.
Du style "Attention tous les fichiers du dossier xxx seront supprimés" et on valide par Ok ou on clic sur "Non" et si possible ensuite une autre fenêtre si on clique sur OK "Les fichiers du dossier xxx ont été supprimés" avec "OK" pour fermer cette fenêtre. si on clique sur "Non" alors "Les fichiers du dossier xxx n'ont pas été supprimés", aussi ok pour fermer ce message.

Je ne suis peut être pas vraiment clair et j'en suis désolé, je ne connais rien du tout aux macros.

[E KERGRESSE]

C'est avec une boite de dialogue de type Liste à Liste que vous pourriez faire cela :



Il faudrait plutôt faire le choix avant l'import.

Un modèle avec le code sur le site de Jacques BOISGONTIER dans la partie Formulaire Transfert Listbox : Liste à liste

[DECLERC]

Je préfèrerais ne pas laisser le choix pour être sur qu'il ne restera plus de fichiers dans le dossier. et donc simplement supprimer les fichiers avec une fenetre de confirmation qui permet de valider ou non

[E KERGRESSE]

Le test de suppression est fait ici avec un Msgbox :

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
 
Sub InsereImg2()
 
Dim Index As Integer
Dim Fso As Object, Dossier As Object, F As Object, Image As Object
Dim Repertoire As String
Dim MatriceImages() As Variant, Reponse As Variant
 
    On Error GoTo Fin
 
    Selection.MoveEnd unit:=wdStory
 
    Repertoire = "D:\Onedrive\Images2\" 'mettre le chemin du dossier image
    Index = 0
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = Fso.getfolder(Repertoire)
    ChDir (Dossier)
    Index = 0
 
    For Each F In Dossier.Files
        Select Case LCase(Fso.GetExtensionName(F.Name))
               Case "jpg"
                    ReDim Preserve MatriceImages(Index)
                    MatriceImages(Index) = F
                    Index = Index + 1
 
                    Set Image = Selection.InlineShapes.AddPicture(F)
                    With Image
                        .LockAspectRatio = msoTrue
                        .Width = CentimetersToPoints(17)
                    End With
                    Selection.TypeParagraph
                    Set Image = Nothing
 
        End Select
    Next F
 
    Reponse = MsgBox("Supprimer les fichiers ?", vbYesNo, "Suppression des fichiers")
 
    If Reponse = vbYes Then
       If UBound(MatriceImages) > 0 Then
          For Index = LBound(MatriceImages) To UBound(MatriceImages)
              For Each F In Dossier.Files
                  If MatriceImages(Index) = F Then
                     F.Delete
                     Exit For
                  End If
              Next F
          Next Index
      End If
    End If
 
    GoTo Fin
 
Fin:
 
    Set Dossier = Nothing: Set Fso = Nothing: Set Image = Nothing
 
End Sub

[DECLERC]

Franchement bravo , c'est parfait! cela fonctionne impeccable!
Merci beaucoup et joyeuses fêtes de fin d'année