XL 2013 msopicture dans picture sur feuille

Sub test1()
    Dim v$, I&, Img As OLEObject
    v = "_3DEffectColorPickerClassic"
    'Set Img = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, Left:=0, Top:=0, Width:=40, Height:=40)
    Set Img = ActiveSheet.OLEObjects.Add("Forms.Image.1", , , 0, 0, Width:=40, Height:=40)
    With Img
        .Object.Picture = Application.CommandBars.GetImageMso(v, 40, 40)
        .Object.PictureSizeMode = 1
        .Object.BorderStyle = 0
        Do Until I = 50: I = I + 1: DoEvents: Loop    'indispensable visiblement sinon l'image est blanche
        'copie en WMF(xlpicture)
        .Parent.Shapes(.Name).CopyPicture
        .Parent.Pictures.Paste
        .Delete
        'ou
        'issue de l'enregistrement de macro
        'copie en png
        '.Parent.Shapes.Range(Array(.Name)).Select
        'Selection.Copy
        '.Parent.PasteSpecial Format:="Image (PNG)", Link:=False, DisplayAsIcon:=False
        '.delete
    End With
End Sub