XL 2016 Affiner une macro

[zeduky]

Bonsoir à tous,

J'ai récupéré cette macro sur le forum et je suis très content du résultat. Mais j'aimerai la nettoyer et enlever les choses dont je n'ai pas besoin. Le seul soucis est que je ne suis pas pro du VBA et je suis incapable de modifier celle ci. Pouvez vous m'aider.
Macro d'origine permet d'insérer des images qui se trouvent dans un répertoire Windows sur le c: avec un mot clé placé dans une cellule la réalisation est parfaite.

Il y a 2 choses que j'aimerai modifier si cela est possible

1. Pendant la macro à chaque insert d'image je dois la valider par une Userforme "ok" est il possible d'éliminer cette étape car sur une insertion de beaucoup d'images va être long et contraignant.
2. Pour finir à la fin de la macro les cellules sont toutes avec un commentaire avec le nom de l'image, est il possible de les faire disparaître ou voir si ce n'est pas nécessaire pour le bon fonctionnement de la macro d'origine de ne jamais les faire apparaître ou insérer.

Je vous joins un .txt avec la macro,
Muchos gracias pour votre aide.

 

[Staple1600]

Bonsoir le fil, le forum

Est-ce le résultat souhaité?

Sub versComm()
Dim Nom1 As String, Nom2 As String, repertoirePhoto As String
Dim Cell As Range, Sh As Shape

repertoirePhoto = "C:\Users\Pascal\Pictures\tousles mots\"      ' Adapter
'On Error Resume Next   ' pour évite l'arrêt de la macro si le nom ne correspond pas à une image valide
With Worksheets("base") ' à adapter à la feuille  <==
For Each Cell In Selection
    For Each Sh In .Shapes
        If Sh.Type = 13 Then
            If Sh.TopLeftCell.Address = Cell.Address Then Sh.Delete
        End If
    Next
Next
  For Each Cell In Selection
   Nom1 = Cell.Text
    Nom2 = Cell.Text & Cell.Address(0, 0)
    If Dir(repertoirePhoto & Nom1 & ".jpg") = Nom1 & ".jpg" Then
        .Pictures.Insert(repertoirePhoto & Nom1 & ".jpg").Name = Nom2
        .Shapes(Nom2).Left = Cell.Left
        .Shapes(Nom2).Top = Cell.Top
        tmp = .Shapes(Nom2).Height
        .Shapes(Nom2).LockAspectRatio = msoTrue
        .Shapes(Nom2).Height = Cell.Height
        'si l'image déborde en largeur
       If .Shapes(Nom2).Width > Cell.Width Then .Shapes(Nom2).Width = Cell.Width
End If
Next
End With
End Sub

 

[zeduky]

je dirai même plus c'est totalement le résultat souhaité 🙂
Merci beaucoup bonne soirée JM