web-dev-qa-db-fra.com

Texte HTML avec des balises en texte formaté dans une cellule Excel

Existe-t-il un moyen de prendre HTML et de l'importer dans Excel afin qu'il soit formaté en texte enrichi (de préférence en utilisant VBA)? En gros, lorsque je colle dans une cellule Excel, je cherche à transformer ceci:

<html><p>This is a test. Will this text be <b>bold</b> or <i>italic</i></p></html>

dans ceci:

C'est un test. Ce texte sera-t-il audacieux ou italique

excelvbaexcel-vbahtml-parsing
37
Kevin McGovern

Oui c'est possible :) En fait, laissez Internet Explorer faire le sale boulot pour vous;)

TRIÉ ET TESTÉ

MES HYPOTHÈSES

  1. Je suppose que le texte HTML est dans la cellule A1 de la feuille Sheet1. Vous pouvez également utiliser une variable à la place.
  2. Si vous avez une colonne remplie de valeurs HTML, mettez simplement le code ci-dessous dans une boucle

CODE 

Sub Sample()
    Dim Ie As Object

    Set Ie = CreateObject("InternetExplorer.Application")

    With Ie
        .Visible = False

        .Navigate "about:blank"

        .document.body.InnerHTML = Sheets("Sheet1").Range("A1").Value

        .document.body.createtextrange.execCommand "Copy"
        ActiveSheet.Paste Destination:=Sheets("Sheet1").Range("A1")

        .Quit
    End With
End Sub

INSTANTANÉ

enter image description here

HTH

Sid

26
Siddharth Rout

Vous pouvez copier le code HTML dans le presse-papiers et le coller en tant que texte Unicode. Excel rendra le code HTML dans la cellule. Découvrez cet article http://www.dailydoseofexcel.com/archives/2005/02/23/html-in-cells-ii/

Le code de macro pertinent de la publication:

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim objData As DataObject
   Dim sHTML As String
   Dim sSelAdd As String

   Application.EnableEvents = False

   If Target.Cells.Count = 1 Then
      If LCase(Left(Target.Text, 6)) = "<html>" Then
         Set objData = New DataObject

         sHTML = Target.Text

         objData.SetText sHTML
         objData.PutInClipboard

         sSelAdd = Selection.Address
         Target.Select
         Me.PasteSpecial "Unicode Text"
         Me.Range(sSelAdd).Select

      End If
   End If

   Application.EnableEvents = True

End Sub
10
Dick Kusleika

Je sais que ce fil est ancien, mais après avoir attribué le innerHTML, ExecWB a fonctionné pour moi:

.ExecWB 17, 0
'Select all contents in browser
.ExecWB 12, 2
'Copy them

Et puis, collez simplement le contenu dans Excel. Étant donné que ces méthodes sont sujettes aux erreurs d'exécution, mais fonctionnent correctement après un ou deux essais en mode débogage, vous devrez peut-être demander à Excel de réessayer s'il rencontre une erreur. J'ai résolu ce problème en ajoutant ce gestionnaire d'erreurs au sous-marin, et cela fonctionne bien:

Sub ApplyHTML()
  On Error GoTo ErrorHandler
    ...
  Exit Sub

ErrorHandler:
    Resume 
    'I.e. re-run the line of code that caused the error
Exit Sub
     
End Sub
7
tiQu

Si l'exemple IE ne fonctionne pas, utilisez celui-ci. Quoi qu'il en soit, cela devrait être plus rapide que de démarrer une instance d'IE.

Voici une solution complète basée sur
http://www.dailydoseofexcel.com/archives/2005/02/23/html-in-cells-ii/

Notez que si votre innerHTML est composé de tous les nombres, par exemple "12345", le formatage HTML ne fonctionne pas complètement dans Excel car il traite les nombres différemment? mais ajoutez un caractère, par exemple un espace de fin à la fin, par exemple. 12345 + "& nbsp;" formats ok.

Sub test()
    Cells(1, 1).Value = "<HTML>1<font color=blue>a</font>" & _
                        "23<font color=red>4</font></HTML>"
    Dim rng As Range
    Set rng = ActiveSheet.Cells(1, 1)
    Worksheet_Change rng, ActiveSheet
End Sub


Private Sub Worksheet_Change(ByVal Target As Range, ByVal sht As Worksheet)

    Dim objData As DataObject ' Set a reference to MS Forms 2.0
    Dim sHTML As String
    Dim sSelAdd As String

    Application.EnableEvents = False

    If Target.Cells.Count = 1 Then

            Set objData = New DataObject
            sHTML = Target.Text
            objData.SetText sHTML
            objData.PutInClipboard
            Target.Select
            sht.PasteSpecial Format:="Unicode Text"
    End If

    Application.EnableEvents = True

End Sub
7
ozmike

J'ai rencontré la même erreur que BornToCode identifiée pour la première fois dans les commentaires de la solution d'origine. Comme je ne connaissais pas Excel et VBA, il m'a fallu une seconde pour comprendre comment mettre en œuvre la solution tiQU. Donc, je l'affiche en tant que solution "Pour les nuls" ci-dessous

  1. Commencez par activer le mode développeur dans Excel: lien
  2. Sélectionnez l'onglet Développeur> Visual Basic.
  3. Cliquez sur Afficher> Code
  4. Collez le code ci-dessous pour mettre à jour les lignes qui nécessitent des références de cellules correctes.
  5. Cliquez sur la flèche verte ou appuyez sur F5
Sub Sample()
    Dim Ie As Object
    Set Ie = CreateObject("InternetExplorer.Application")
    With Ie
        .Visible = False
        .Navigate "about:blank"
        .document.body.InnerHTML = Sheets("Sheet1").Range("I2").Value
             'update to the cell that contains HTML you want converted
        .ExecWB 17, 0
             'Select all contents in browser
        .ExecWB 12, 2
             'Copy them
        ActiveSheet.Paste Destination:=Sheets("Sheet1").Range("J2")
             'update to cell you want converted HTML pasted in
        .Quit
    End With
End Sub
5
hehret

Agréable! Très glissant.

J'ai été déçu qu'Excel ne nous laisse pas coller dans une cellule fusionnée et colle également les résultats contenant une rupture en lignes successives situées sous la cellule "cible", car cela signifiait que cela ne fonctionnait tout simplement pas pour moi. J'ai essayé quelques modifications (dissocier/rétablir, etc.), mais Excel a laissé tomber quoi que ce soit en dessous d'une pause, donc c'était une impasse.

En fin de compte, j'ai mis au point une routine qui gère les balises simples sans utiliser le convertisseur Unicode "natif" à l'origine du problème des champs fusionnés. J'espère que les autres trouveront cela utile:

Public Sub AddHTMLFormattedText(rngA As Range, strHTML As String, Optional blnShowBadHTMLWarning As Boolean = False)
    ' Adds converts text formatted with basic HTML tags to formatted text in an Excel cell
    ' NOTE: Font Sizes not handled perfectly per HTML standard, but I find this method more useful!

    Dim strActualText As String, intSrcPos As Integer, intDestPos As Integer, intDestSrcEquiv() As Integer
    Dim varyTags As Variant, varTag As Variant, varEndTag As Variant, blnTagMatch As Boolean
    Dim intCtr As Integer
    Dim intStartPos As Integer, intEndPos As Integer, intActualStartPos As Integer, intActualEndPos As Integer
    Dim intFontSizeStartPos As Integer, intFontSizeEndPos As Integer, intFontSize As Integer

    varyTags = Array("<b>", "</b>", "<i>", "</i>", "<u>", "</u>", "<sub>", "</sub>", "<sup>", "</sup>")

    ' Remove unhandled/unneeded tags, convert <br> and <p> tags to line feeds
    strHTML = Trim(strHTML)
    strHTML = Replace(strHTML, "<html>", "")
    strHTML = Replace(strHTML, "</html>", "")
    strHTML = Replace(strHTML, "<p>", "")
    While LCase(Right$(strHTML, 4)) = "</p>" Or LCase(Right$(strHTML, 4)) = "<br>"
        strHTML = Left$(strHTML, Len(strHTML) - 4)
        strHTML = Trim(strHTML)
    Wend
    strHTML = Replace(strHTML, "<br>", vbLf)
    strHTML = Replace(strHTML, "</p>", vbLf)

    strHTML = Trim(strHTML)

    ReDim intDestSrcEquiv(1 To Len(strHTML))
    strActualText = ""
    intSrcPos = 1
    intDestPos = 1
    Do While intSrcPos <= Len(strHTML)
        blnTagMatch = False
        For Each varTag In varyTags
            If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                blnTagMatch = True
                intSrcPos = intSrcPos + Len(varTag)
                If intSrcPos > Len(strHTML) Then Exit Do
                Exit For
            End If
        Next
        If blnTagMatch = False Then
            varTag = "<font size"
            If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                blnTagMatch = True
                intEndPos = InStr(intSrcPos, strHTML, ">")
                intSrcPos = intEndPos + 1
                If intSrcPos > Len(strHTML) Then Exit Do
            Else
                varTag = "</font>"
                If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                    blnTagMatch = True
                    intSrcPos = intSrcPos + Len(varTag)
                    If intSrcPos > Len(strHTML) Then Exit Do
                End If
            End If
        End If
        If blnTagMatch = False Then
            strActualText = strActualText & Mid$(strHTML, intSrcPos, 1)
            intDestSrcEquiv(intSrcPos) = intDestPos
            intDestPos = intDestPos + 1
            intSrcPos = intSrcPos + 1
        End If
    Loop

    ' Clear any bold/underline/italic/superscript/subscript formatting from cell
    rngA.Font.Bold = False
    rngA.Font.Underline = False
    rngA.Font.Italic = False
    rngA.Font.Subscript = False
    rngA.Font.Superscript = False

    rngA.Value = strActualText

    ' Now start applying Formats!"
    ' Start with Font Size first
    intSrcPos = 1
    intDestPos = 1
    Do While intSrcPos <= Len(strHTML)
        varTag = "<font size"
        If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
            intFontSizeStartPos = InStr(intSrcPos, strHTML, """") + 1
            intFontSizeEndPos = InStr(intFontSizeStartPos, strHTML, """") - 1
            If intFontSizeEndPos - intFontSizeStartPos <= 3 And intFontSizeEndPos - intFontSizeStartPos > 0 Then
                Debug.Print Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                If Mid$(strHTML, intFontSizeStartPos, 1) = "+" Then
                    intFontSizeStartPos = intFontSizeStartPos + 1
                    intFontSize = 11 + 2 * Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                ElseIf Mid$(strHTML, intFontSizeStartPos, 1) = "-" Then
                    intFontSizeStartPos = intFontSizeStartPos + 1
                    intFontSize = 11 - 2 * Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                Else
                    intFontSize = Mid$(strHTML, intFontSizeStartPos, intFontSizeEndPos - intFontSizeStartPos + 1)
                End If
            Else
                ' Error!
                GoTo HTML_Err
            End If
            intEndPos = InStr(intSrcPos, strHTML, ">")
            intSrcPos = intEndPos + 1
            intStartPos = intSrcPos
            If intSrcPos > Len(strHTML) Then Exit Do
            While intDestSrcEquiv(intStartPos) = 0 And intStartPos < Len(strHTML)
                intStartPos = intStartPos + 1
            Wend
            If intStartPos >= Len(strHTML) Then GoTo HTML_Err ' HTML is bad!
            varEndTag = "</font>"
            intEndPos = InStr(intSrcPos, LCase(strHTML), varEndTag)
            If intEndPos = 0 Then GoTo HTML_Err ' HTML is bad!
            While intDestSrcEquiv(intEndPos) = 0 And intEndPos > intSrcPos
                intEndPos = intEndPos - 1
            Wend
            If intEndPos > intSrcPos Then
                intActualStartPos = intDestSrcEquiv(intStartPos)
                intActualEndPos = intDestSrcEquiv(intEndPos)
                rngA.Characters(intActualStartPos, intActualEndPos - intActualStartPos + 1) _
                    .Font.Size = intFontSize
            End If
        End If
        intSrcPos = intSrcPos + 1
    Loop

    'Now do remaining tags
    intSrcPos = 1
    intDestPos = 1
    Do While intSrcPos <= Len(strHTML)
        If intDestSrcEquiv(intSrcPos) = 0 Then
            ' This must be a Tag!
            For intCtr = 0 To UBound(varyTags) Step 2
                varTag = varyTags(intCtr)
                intStartPos = intSrcPos + Len(varTag)
                While intDestSrcEquiv(intStartPos) = 0 And intStartPos < Len(strHTML)
                    intStartPos = intStartPos + 1
                Wend
                If intStartPos >= Len(strHTML) Then GoTo HTML_Err ' HTML is bad!
                If LCase(Mid$(strHTML, intSrcPos, Len(varTag))) = varTag Then
                    varEndTag = varyTags(intCtr + 1)
                    intEndPos = InStr(intSrcPos, LCase(strHTML), varEndTag)
                    If intEndPos = 0 Then GoTo HTML_Err ' HTML is bad!
                    While intDestSrcEquiv(intEndPos) = 0 And intEndPos > intSrcPos
                        intEndPos = intEndPos - 1
                    Wend
                    If intEndPos > intSrcPos Then
                        intActualStartPos = intDestSrcEquiv(intStartPos)
                        intActualEndPos = intDestSrcEquiv(intEndPos)
                        With rngA.Characters(intActualStartPos, intActualEndPos - intActualStartPos + 1).Font
                            If varTag = "<b>" Then
                                .Bold = True
                            ElseIf varTag = "<i>" Then
                                .Italic = True
                            ElseIf varTag = "<u>" Then
                                .Underline = True
                            ElseIf varTag = "<sup>" Then
                                .Superscript = True
                            ElseIf varTag = "<sub>" Then
                                .Subscript = True
                            End If
                        End With
                    End If
                    intSrcPos = intSrcPos + Len(varTag) - 1
                    Exit For
                End If
            Next
        End If
        intSrcPos = intSrcPos + 1
        intDestPos = intDestPos + 1
    Loop
Exit_Sub:
    Exit Sub
HTML_Err:
    ' There was an error with the Tags. Show warning if requested.
    If blnShowBadHTMLWarning Then
        MsgBox "There was an error with the Tags in the HTML file. Could not apply formatting."
    End If
End Sub

Notez que cela ne sert pas à l'imbrication de balises, mais nécessite seulement une balise de fermeture pour chaque balise ouverte et suppose que la balise de fermeture la plus proche de la balise d'ouverture s'applique à la balise d'ouverture. Les balises correctement imbriquées fonctionnent correctement, tandis que les balises incorrectement imbriquées ne sont pas rejetées et peuvent ou ne peuvent pas fonctionner.

1
E. Ledding

Pour mettre HTML/Word dans une forme Excel et le localiser sur une cellule Excel:

  1. Ecrire mon code HTML dans un fichier temporaire.
  2. Ouvrir le fichier temporaire via Word Interop.
  3. Copiez-le de Word dans le presse-papier.
  4. Ouvrez Excel via Interop.
  5. Définir et sélectionner une cellule dans une plage.
  6. PasteSpecial en tant qu '"objet document Microsoft Word"
  7. Ajustez la ligne Excel à la hauteur de la forme.

De cette manière, même le HTML contenant des tableaux et d’autres éléments ne sera pas divisé en plusieurs cellules.

    private void btnPutHTMLIntoExcelShape_Click(object sender, EventArgs e)
    {
        var fFile = new FileInfo(@"C:\Temp\temp.html");
        StreamWriter SW = fFile.CreateText();
        SW.Write(hecNote.DocumentHtml);
        SW.Close();

        Word.Application wrdApplication;
        Word.Document wrdDocument;
        wrdApplication = new Word.Application();
        wrdApplication.Visible = true;

        wrdDocument = wrdApplication.Documents.Add(@"C:\Temp\temp.html");
        wrdDocument.ActiveWindow.Selection.WholeStory();
        wrdDocument.ActiveWindow.Selection.Copy();

        Excel.Application excApplication;
        Excel.Workbook excWorkbook;
        Excel._Worksheet excWorksheet;
        Excel.Range excRange = null;

        excApplication = new Excel.Application();
        excApplication.Visible = true;
        excWorkbook = excApplication.Workbooks.Add(Type.Missing);
        excWorksheet = (Excel.Worksheet)excWorkbook.Worksheets.get_Item(1);
        excWorksheet.Name = "Work";
        excRange = excWorksheet.get_Range("A1");
        excRange.Select();

        excWorksheet.PasteSpecial("Microsoft Word Document Object");

        Excel.Shape O = excWorksheet.Shapes.Item(1);

        this.Text = $"{O.Height} x {O.Width}";
        ((Excel.Range)excWorksheet.Rows[1, Type.Missing]).RowHeight = O.Height;
    }
0
John Kurtz