创建打开 Web 链接的 Power Point

问：

我在创建创建 PowerPoint 演示文稿的宏时遇到问题，我可以在其中从 Excel 中的链接获取照片。我已经尝试了很多次，但将照片从网页复制到 PowerPoint 中不起作用。

我试过这段代码：

Sub CrearDiapositivasDesdeTablaDinamica()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim ws As Worksheet
    Dim rowIndex As Long
    Dim linkColumnIndex As Long
    Dim pdvColumnIndex As Long
    Dim imgURL As String
    Dim pdvName As String
    Dim imgFilePath As String
    Dim img As Object

    ' Ruta de la aplicación de PowerPoint
    Set pptApp = CreateObject("PowerPoint.Application")

    ' Abre una presentación de PowerPoint existente o crea una nueva
    Set pptPres = pptApp.Presentations.Add

    ' Especifica el índice de las columnas "PDV" y "Link" en la tabla dinámica (ajusta según tu caso)
    pdvColumnIndex = 1 ' La primera columna es la columna de nombres de PDV
    linkColumnIndex = 2 ' La segunda columna es la columna de enlaces

    ' Accede a la hoja de Excel (ajusta según tu caso)
    Set ws = ThisWorkbook.Sheets("hoja1")

    ' Carpeta temporal para descargar imágenes
    imgFilePath = Environ("TEMP") & "\temp_img.jpg"

    ' Recorre las filas de la tabla dinámica
    For rowIndex = 1 To ws.Cells(Rows.Count, linkColumnIndex).End(xlUp).Row
        ' Obtiene el nombre del PDV de la celda en la columna "PDV"
        pdvName = ws.Cells(rowIndex, pdvColumnIndex).Value

        ' Obtiene el enlace de la imagen de la celda en la columna "Link"
        imgURL = ws.Cells(rowIndex, linkColumnIndex).Value

        ' Verifica si la URL comienza con un protocolo válido (http:// o https://)
        If Not (Left(imgURL, 7) = "http://" Or Left(imgURL, 8) = "https://") Then
            ' Agrega "http://" como protocolo predeterminado
            imgURL = "http://" & imgURL
        End If

        ' Muestra un mensaje de progreso
        MsgBox "Descargando imagen para la diapositiva " & rowIndex

        ' Descarga la imagen a la carpeta temporal
        Dim xmlhttp As Object
        Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
        xmlhttp.Open "GET", imgURL, False
        xmlhttp.send
        If xmlhttp.Status = 200 Then
            Set img = CreateObject("WIA.ImageFile")
            img.LoadFile xmlhttp.responseBody
            img.SaveFile imgFilePath
        End If

        ' Crea una nueva diapositiva
        Set pptSlide = pptPres.Slides.Add(rowIndex, ppLayoutText)

        ' Agrega el título de la diapositiva como el nombre del PDV
        pptSlide.Shapes(1).TextFrame.TextRange.Text = pdvName

        ' Muestra un mensaje de progreso
        MsgBox "Agregando imagen a la diapositiva " & rowIndex

        ' Agrega la imagen desde la carpeta temporal debajo del título
        pptSlide.Shapes.AddPicture Filename:=imgFilePath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=100, Top:=100, Width:=400, Height:=300
    Next rowIndex

    ' Muestra la presentación
    pptApp.Visible = True

    ' Limpia los objetos
    Set img = Nothing
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub