XL 2016 VBA - Impossible d'envoyer l'image du QR Code en fichier

'----------------------------
'Génère un QR code en fichier
'----------------------------
Sub QRCodeToFile(Chaine As String, NomCompletFichier, Optional PicWidth As Integer = 120, Optional PicHeight As Integer = 120)
    Dim Ch As ChartObject, Pic As Picture
    Application.CutCopyMode = False    'on vide l'eventuelle image précédamment copiée(pour ne pas recoller la meme)
    DoEvents    'laisse quelques milliemes de seconde au clip pour se vider
    Set Pic = QRCodeToCell(Chaine, ActiveCell, PicWidth, PicHeight): Pic.CopyPicture
    Set Ch = ActiveSheet.ChartObjects.Add(0, 0, Pic.Width, Pic.Height)    'Create a Chart on the ActiveSheet
    With Ch.Chart
        Do While .Pictures.Count = 0: DoEvents: .Paste: Loop    ' on paste tant qu'il y a pas une image dans le chart
          .Export NomCompletFichier, FilterName:=Mid(NomCompletFichier, InStrRev(NomCompletFichier, ".") + 1)
    End With
    Pic.Delete: Ch.Delete    'Delete the image and the Chart
End Sub

'----------------------------
'Génère un QR code en fichier
'Code de PatrickToulon
'
'Arguments:
'---------
'- Chaine   : Chaine à encoder en QR Code
'- NomCompletFichier: Nom complet du fichier image du QR Code
'- PicWidth : Largeur de l'image du QR Code
'- PicHeight: Hauteur de l'image du QR Code
'----------------------------
Sub QRCodeToFile(Chaine As String, _
                 NomCompletFichier, _
                 Optional PicWidth As Integer = 120, _
                 Optional PicHeight As Integer = 120)

    Dim Link As String
    Dim ReQ As Object
    Dim oStream As Object

    'https://developers.google.com/chart/infographics/docs/qr_codes
    Link = "http://chart.googleapis.com/chart?cht=qr&chs=" & PicWidth & "x" & PicHeight & "&chl=" & Chaine

    If Len(Dir(NomCompletFichier)) > 0 Then Kill NomCompletFichier
    '
    Set ReQ = CreateObject("Microsoft.XMLHTTP")
    ReQ.Open "get", Link, False
    ReQ.send
    If ReQ.Status <> 200 Then MsgBox "la requete n'a pas abouti": Exit Sub
    '
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write ReQ.responsebody
    oStream.SaveToFile NomCompletFichier
    oStream.Close
End Sub