XL 2013 shape positions via macro

[yoda60]

bonjour je souhaiterai pouvoir positionner toutes les shapes d'un ppt via macro. j'aurai en Feuil1 de mon fichier en colonne 1 les noms des shapes , en colonne 2 la position left etc.. pensez vous que cela est possible avec une boucle ? ci joint le code que je souhaite adapter (dans celui ci les shapes sont positionnées en centrant par rapport a une forme d'origine , mais cela manque de précision, ou bien c'est moi qui loupe un truc 🙂

merci d'avance

Private Sub ReplacePptShapeArea(pptShape As Object, tabVarArea As ListObject)
Dim rowVar As ListRow, tmpStr As String, rngSrc As Range, graphSrc As ChartObject, newShape As Object, tmpDbl As Double, formeSrc As Object
   
    On Error Resume Next
     tmpStr = Replace(Replace(pptShape.TextFrame.TextRange.Text, "$Z{", vbNullString), "}", vbNullString)
     Set rowVar = tabVarArea.ListRows(Application.WorksheetFunction.Match(tmpStr, tabVarArea.ListColumns("Variable Zone").DataBodyRange, 0))
     Set rngSrc = ThisWorkbook.Sheets(rowVar.Range(1, 2).Text).Range(rowVar.Range(1, 3).Text)
     Set graphSrc = ThisWorkbook.Sheets(rowVar.Range(1, 2).Text).ChartObjects(rowVar.Range(1, 3).Text)
    On Error GoTo 0
    If rowVar Is Nothing Then Exit Sub
    If (rngSrc Is Nothing) And (graphSrc Is Nothing) Then Exit Sub
   
    'copier la zone dans le ppt
    If rngSrc Is Nothing Then
        graphSrc.Copy
        'si c'est un graphique, le coller au format Bitmap
'        Set newShape = pptShape.Parent.Shapes.PasteSpecial(ppPasteBitmap)(1)
        Set newShape = pptShape.Parent.Shapes.PasteSpecial(1)(1)
    Else
        rngSrc.Copy
        On Error Resume Next
         'si c'est un Range, essayer de le coller au format HTML, sinon coller une image "métafichier amélioré"
'         Set newShape = pptShape.Parent.Shapes.PasteSpecial(ppPasteHTML, msoFalse, , , , msoFalse)(1)
'         If newShape Is Nothing Then Set newShape = pptShape.Parent.Shapes.PasteSpecial(ppPasteEnhancedMetafile, msoFalse, , , , msoFalse)(1)
         Set newShape = pptShape.Parent.Shapes.PasteSpecial(8, 0, , , , 0)(1)
         If newShape Is Nothing Then Set newShape = pptShape.Parent.Shapes.PasteSpecial(2, 0, , , , 0)(1)
        On Error GoTo 0
    End If
    Application.CutCopyMode = False
   
    'redimensionner par raport à la forme du modèle (rétréci si besoin en gardant les proportions)
    tmpDbl = Application.WorksheetFunction.Min(1, pptShape.Width / newShape.Width, pptShape.Height / newShape.Height)
    newShape.Width = newShape.Width * tmpDbl
    newShape.Height = newShape.Height * tmpDbl
   
    'recentrer par rapport à la forme du modèle
    newShape.Left = pptShape.Left + (pptShape.Width - newShape.Width) / 2       '/!\ ** Nécessite que le Slide parent soit sélectionné (??)
    newShape.Top = pptShape.Top + (pptShape.Height - newShape.Height) / 2       '/!\ ** Nécessite que le Slide parent soit sélectionné (??)


   
   
   
    'supprimer la forme source du modèle
    pptShape.Delete
End Sub