XL 2016 Positionner une image au centre d'une cellule

[Laosurlamontagne]

Bonjour à tous,

J'ai une macro événementiel qui me permet d'ajouter un fichier sur une cellule en cliquant 2 fois dessus. Elle fonctionne très bien, cependant, je n'arrive pas à centrer le fichier sur la cellule. Il se positionne par défaut en haut à gauche et c'est pas très jolie...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("Table")) Is Nothing Then

Dim Reponse As Variant
Dim FileName$
Dim SH As Shape
'--- Choix d'un fichier ---
Reponse = Application.GetOpenFilename( _
    FileFilter:="Tout fichier (*.*), *.*", _
    Title:="Insérer un fichier sous forme d'icône dans la cellule active")
If Reponse = False Then Exit Sub
FileName$ = Mid(Reponse, InStrRev(Reponse, "\") + 1)
'--- Le fichier est-il déjà présent ? ---
On Error Resume Next
For Each SH In ActiveSheet.Shapes
  If SH.AlternativeText = Reponse Then
    Range(SH.TopLeftCell.Address).Select
    MsgBox prompt:="Le fichier ''" & Reponse & "'' existe déjà" & vbLf & _
          " en cellule " & SH.TopLeftCell.Address(False, False), _
          Title:="Le fichier sous forme d'icône existe déjà"
    Exit Sub
  End If
Next SH
On Error GoTo 0

Application.ScreenUpdating = False
'--- Crée la Shape ---
Set SH = ActiveSheet.Shapes.AddOLEObject( _
    FileName:=Reponse, DisplayAsIcon:=False, _
    IconFileName:=Application.Path & "\" & "Excel.exe", _
    IconIndex:=0, IconLabel:=FileName$)
'--- Propriétés de la Shape ---
SH.AlternativeText = Reponse  'Identificateur unique

SH.TopLeftCell = ActiveCell   'Localisation sur cellule

    '°°° Taille °°°
SH.Width = 40
SH.Height = 40

Application.ScreenUpdating = True

  Cancel = True
End If
End Sub

Quelqu'un aurait-il une solution?

Merci par avance.

 

[Lone-wolf]

Bonjour laosurlamontagne 🙂
ça fait longtemps?! Le chalet y est toujours???😉

Uun exemple à adapter selon la grandeur des cellules.

For Each sh In ActiveSheet.Shapes
sh.Top = ActiveCell.Top + 5
sh.Left = ActiveCell.Left + 5
Next sh

 

[Laosurlamontagne]

Il est encore sous la neige... 😛

Ca ne centre pas le fichier sur la cellule mais les lignes de code me permettent de le positionner comme je le souhaite.

Merci pour ton aide!