Chemin d'enregistrement VBA

Bonjour le forum,

Toutes mes tentatives d'ajouter une ligne à ce code pour enregistrer les images QR codes dans un dossier particulier ont échoué.

J'aimerai modifier ou Améliorer le code pour enregistrer les images généré par vba excel dans un dossier specifique excel vba.

Veuillez voir la pièce ci-jointe pour plus de renseignements.

Merci d'avance

Cordialement

Bonjour,

Pour commencer,

For Each val In Selection

Impossible que cela fonctionne, si vous n'utiliser pas un objet

Dim Cel as Range
For Each Cel in Selection

Non plus, si vous ne sélectionnez pas le cellules qui contiennent les noms

Sinon, ce code fonctionne avec

.SaveToFile ThisWorkbook.Path & Application.PathSeparator _
  & "QRCODES" & Application.PathSeparator & MyArray(0) & ".png", 2

A+

Bonjour à vous, Zinelamri, BrunoM45

j'ai essayé de modifier le code comme décrit par BrunoM45, mais j'ai une 'erreur d'exécution 3004 impossible d'écrire dans le fichier' sur la ligne SaveToFile

Edit : après avoir créé e répertoire QRCodes tout fonctionne

Bonjour le forum,

Bonjour BrunoM45

Merci beaucoup à vous, Cela fonctionne parfaitement avec ce code :

Sub BikinQR()
    Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
    Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
    Dim Size: Size = 500
    Dim QR, Name, val, MyArray
    Dim Invalid: Invalid = "\/:*?" & """" & "<>|"
    For Each val In Selection
        Name = val.Value
        MyArray = Split(Name, ",", -1, 1)
        For intChar = 1 To Len(Name)
            If InStr(Invalid, LCase(Mid(Name, intChar, 1))) > 0 Then
                MsgBox "The file: " & vbCrLf & """" & Name & """" & vbCrLf & vbCrLf & " is invalid!"
                Exit Sub
            End If
        Next
        QR = "http://chart.googleapis.com/chart?chs=" & Size & "x" & Size & "&cht=qr&chl=" & Name
        xHttp.Open "GET", QR, False
        xHttp.Send
        With bStrm
            .Type = 1
            .Open
            .write xHttp.responseBody
           .SaveToFile ThisWorkbook.Path & Application.PathSeparator _
  & "QRCODES" & Application.PathSeparator & MyArray(0) & ".png", 2
            .Close
        End With
    Next
End Sub

Merci beaucoup

Bien cordialement,