[VBA Intermediário] Exportar planilha do Excel para HTML com hiperlink

Você pode precisar salvar sua planilha ou uma parte dela em HTML, seja para publicação na internet ou então para enviar um e-mail dentro de uma formatação específica.

Uma função que pode ser utilizada para aprimorar a sua planilha que envia e-mails é a função RangetoHTML créditos para Ron de Bruin pelo desenvolvimento, porém, a função original não permite que os hiperlinks sejam mostrados no arquivo de saída, então apresento aqui uma alternativa para utilizar esta função, incluindo os hiperlinks que possam estar na sua planilha:

 

Function RangetoHTMLHiperlink(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim Hlink As Hyperlink
    
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    
    'Marcus Loyola - www.excelflex.com.br - insere os hiperlinks do objeto rng na planilha temporária
    For Each Hlink In rng.Hyperlinks
        TempWB.Sheets(1).Hyperlinks.Add _
        Anchor:=TempWB.Sheets(1).Range(Hlink.Range.Address).Offset(rng.Row * -1 + 1, 0), _
        Address:=Hlink.Address, _
        TextToDisplay:=Hlink.TextToDisplay
    Next Hlink
    
    
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTMLHiperlink = ts.readall
    ts.Close
    RangetoHTMLHiperlink = Replace(RangetoHTMLHiperlink, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    
    'Close TempWB
    TempWB.Close savechanges:=False
    
    'Delete the htm file we used in this function
    Kill TempFile
    
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Caso precise de ajuda profissional para implementar este código ou então para automatizar a sua planilha, me envie uma mensagem através do formulário de contato que responderei em breve, se preferir, pode me enviar um e-mail através do endereço [email protected].

 

Deixe um comentário

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *