Excel Mudar Endereço URL a Partir de Outra Célula

[Gonzallez]

Olá galera, tudo bem?

 

Eu tenho uma planilha com informações de livros (título, autor, etc). Nessa planilha também tem um link externo que tem a imagem desses livros. No entanto, o nome da imagem a que esse link se refere, está com caracteres especiais (underline, etc). 

 

Eu gostaria de saber se haveria a possibilidade de criar um macro no qual o Excel renomeasse apenas o link dessas imagens a partir do título do livro (que está em outra coluna), mas antes disso a imagem teria que ser baixada porque senão o link não vai funcionar.

 

Seria basicamente puxar o título do livro de alguma célula e colar no link, para em vez da imagem ter o nome de "2323_s23232.jpg ter "título-livro.jpg".

 

PS: segue link da minha planilha em anexo.

 

Deu pra entender?

 

Desde de já, obrigado.

Tabela_de_Produtos.xls

[Basole]

Veja se e isso que deseja

A macro substitui a url por hyperlink com o titulo do respectivo livro, mantendo o endereco da imagem.

 

 

 

 

 

Tabela_de_Produtos.xls

[Gonzallez]

8 horas atrás, Basole disse:

Veja se e isso que deseja

A macro substitui a url por hyperlink com o titulo do respectivo livro, mantendo o endereço da imagem.

 

 

 

 

 

Tabela_de_Produtos.xls 56 kB · 2 downloads

Muito obrigado @Basole, mas ainda não é o que estou procurando. 

 

Na verdade eu gostaria que o sistema fizesse o download a partir da URL, e após o download renomeasse o nome da imagem de acordo com o título do livro, ou simplesmente removesse aqueles underlines. 

 

 

 

 

[Basole]

@Gonzallez Atualizei a macro de acordo com sua solicitacao

 

* 1-  Cria uma nova pasta para armazenar as imagens que serao "baixadas", chamada FOTOS (caso nao exista), localizada na mesma pasta da planilha.

   2 - Renomea a imagem de acordo com a coluna B

  3 - Insere um hyperlink na coluna N armazenando o endereco (caminho), de cada imagem "baixada".

 

Sub DownloadImagensRenameTitle()
Dim sURI  As Range
Dim Lr!

  Lr = Range("N" & Rows.Count).End(xlUp).Row

 Set oXMLHTTP = VBA.CreateObject("MSXML2.XMLHTTP.6.0")
 Set oBinaryStream = VBA.CreateObject("ADODB.Stream")
 adTypeBinary = 1
 oBinaryStream.Type = adTypeBinary

   FolderName = ThisWorkbook.Path & "\FOTOS"

        If VBA.Len(VBA.Dir(FolderName, VBA.vbDirectory)) = 0 Then
             VBA.MkDir FolderName 'cria NOVA pasta, caso nao exista
        End If
        
        
 For i = 2 To Lr
  sPath = FolderName & "\" & Range("B" & i).Value2 & ".jpg"
Set sURI = Range("N" & i)

  On Error GoTo HTTPError
  oXMLHTTP.Open "GET", sURI.Value2, False
  oXMLHTTP.Send
  aBytes = oXMLHTTP.responsebody
  On Error GoTo 0

  oBinaryStream.Open
  oBinaryStream.Write aBytes
  adSaveCreateOverWrite = 2
  oBinaryStream.SaveToFile sPath, adSaveCreateOverWrite
  oBinaryStream.Close
  
 ActiveSheet.Hyperlinks.Add Anchor:=sURI, _
                        Address:=FolderName & "\" & Range("B" & i).Value2 & ".jpg", _
                        SubAddress:="", _
                        ScreenTip:=Range("B" & i).Value2, _
                        TextToDisplay:=Range("B" & i).Value2
NextRow:
 Next

 Exit Sub

HTTPError:
 Resume NextRow

End Sub

Veja se e isso!

 

[Gonzallez]

1 hora atrás, Basole disse:

@Gonzallez Atualizei a macro de acordo com sua solicitacao

 

* 1-  Cria uma nova pasta para armazenar as imagens que serao "baixadas", chamada FOTOS (caso nao exista), localizada na mesma pasta da planilha.

   2 - Renomea a imagem de acordo com a coluna B

  3 - Insere um hyperlink na coluna N armazenando o endereco (caminho), de cada imagem "baixada".

 

Sub DownloadImagensRenameTitle()
Dim sURI  As Range
Dim Lr!

  Lr = Range("N" & Rows.Count).End(xlUp).Row

 Set oXMLHTTP = VBA.CreateObject("MSXML2.XMLHTTP.6.0")
 Set oBinaryStream = VBA.CreateObject("ADODB.Stream")
 adTypeBinary = 1
 oBinaryStream.Type = adTypeBinary

   FolderName = ThisWorkbook.Path & "\FOTOS"

        If VBA.Len(VBA.Dir(FolderName, VBA.vbDirectory)) = 0 Then
             VBA.MkDir FolderName 'cria NOVA pasta, caso nao exista
        End If
        
        
 For i = 2 To Lr
  sPath = FolderName & "\" & Range("B" & i).Value2 & ".jpg"
Set sURI = Range("N" & i)

  On Error GoTo HTTPError
  oXMLHTTP.Open "GET", sURI.Value2, False
  oXMLHTTP.Send
  aBytes = oXMLHTTP.responsebody
  On Error GoTo 0

  oBinaryStream.Open
  oBinaryStream.Write aBytes
  adSaveCreateOverWrite = 2
  oBinaryStream.SaveToFile sPath, adSaveCreateOverWrite
  oBinaryStream.Close
  
 ActiveSheet.Hyperlinks.Add Anchor:=sURI, _
                        Address:=FolderName & "\" & Range("B" & i).Value2 & ".jpg", _
                        SubAddress:="", _
                        ScreenTip:=Range("B" & i).Value2, _
                        TextToDisplay:=Range("B" & i).Value2
NextRow:
 Next

 Exit Sub

HTTPError:
 Resume NextRow

End Sub

Veja se e isso!

 

@Basole, onde insiro esse código?

[Patropi]

@Gonzallez

 

Para responder use a Janela Responder que fica logo abaixo da última resposta, não use o botão Citar sem necessidade, pois polui o fórum dificultando a leitura das respostas( só clicar dentro dela e digitar).

Só use o botão Citar quando realmente for necessário.

 

[]s

[Basole]

@Gonzallez  siga o passo-a-passo:

 

Inserir código VBA na pasta de trabalho do Excel

Abra sua pasta de trabalho no Excel.
Pressione Alt + F11 para abrir o Visual Basic Editor (VBE).

 

Clique com o botão direito do mouse no nome da pasta de trabalho no painel "Project-VBAProject" (no canto superior esquerdo da janela do editor) e selecione Inserir -> Módulo no menu de contexto.

 

Copie o código do VBA (Que inseri no meu poste anterior.) e cole-o no painel direito do editor do VBA (janela "Módulo1").

 

Salve sua pasta de trabalho.

Feche a janela e Aperte as teclas ALT+F8 e clique em executar

 

[Gonzallez]

Muito obrigado @Basole, é isso mesmo. Perfeito cara! 

 

Brigadão!

[Edson Luiz Branco]

Muito bom, @Basole!