Ich möchte mehrere QR Codes auf einmal generieren. Doch mein Problem ist Internetlink haben Sonderzeichen die nicht im Namen für PNG gespeichert werden können. Wie kann jedem PNG einen anderen Namen geben ohne das dieser Name der Link ist? 

Sub InsertQR()
    Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
    Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
    Dim Size: Size = 250 'dalam Pixels
    Dim QR, Name, val
    Dim Invalid: Invalid = "\/:*?" & """" & "<>|"
    For Each val In Selection
        Name = val.Value
        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 '//binary
            .Open
            .write xHttp.responseBody
            .savetofile ThisWorkbook.Path & Application.PathSeparator & Name & ".png", 2 '//overwrite
            .Close
        End With
    Next
End Sub

Function ShowPic(PicFile As String) As String
    Dim AC As Range
    On Error GoTo Done
    Set AC = Application.Caller
    ActiveSheet.Shapes.AddPicture(ThisWorkbook.Path & Application.PathSeparator & PicFile, False, True, AC.Left, AC.Top, 30, 30).Name = "QR"
    ShowPic = ""
    Exit Function
Done:
    ShowPic = "Error"
End Function

Sub PutTheQR()
    Dim val As String
    val = ActiveCell.Offset(0, -1).Value
    Do While val <> ""
    ActiveCell.FormulaR1C1 = "=ShowPic(RC[-1])"
    ActiveCell.ClearContents
    ActiveCell.Offset(1, 0).Activate
    val = ActiveCell.Offset(0, -1).Value
    Loop
End Sub