Текст HTML с тегами для форматированного текста в ячейке Excel

Есть ли способ взять HTML и импортировать его в excel, чтобы он был отформатирован как богатый текст (желательно с помощью VBA)? В принципе, когда я вставляю в ячейку Excel, я хочу включить это:

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

в это:

Это тест. Будет ли этот текст жирным или курсивным

Ответы

Ответ 1

Да, это возможно:) На самом деле пусть Internet Explorer сделает для вас грязную работу;)

ИСПЫТАНИЕ И ИСПЫТАНИЕ

МОИ ПРЕДПОЛОЖЕНИЯ

  • Я предполагаю, что текст html находится в ячейке A1 листа Sheet1. Вместо этого вы можете использовать переменную.
  • Если у вас есть столбец, полный значений html, просто введите код ниже в цикле

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

СНАПШОТ

enter image description here

НТН

Сид

Ответ 2

Вы можете скопировать HTML-код в буфер обмена и вставить его обратно как текст в Юникоде. Excel будет отображать HTML в ячейке. Отметьте это сообщение http://www.dailydoseofexcel.com/archives/2005/02/23/html-in-cells-ii/

Соответствующий макрокоманд из сообщения:

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

Ответ 3

Если пример IE не работает, используйте этот. В любом случае это должно быть быстрее, чем запуск экземпляр IE.

Вот полное решение на основе
http://www.dailydoseofexcel.com/archives/2005/02/23/html-in-cells-ii/

Обратите внимание, что если ваш innerHTML - все числа, например '12345', форматирование HTML dosen't полностью работает в excel, поскольку он обрабатывает номер по-разному? но добавьте символ, например конечное пространство в конце, например. 12345 + "& nbsp;" форматы в порядке.

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

Ответ 4

Я знаю, что эта ветка древняя, но после присвоения innerHTML ExecWB работал у меня:

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

Ответ 5

Я столкнулся с той же ошибкой, которую BornToCode впервые обнаружил в комментариях к исходному решению. Будучи незнакомым с Excel и VBA, мне потребовалась секунда, чтобы понять, как реализовать решение tiQU. Так что я выкладываю это как решение "Для чайников" ниже

  1. Сначала включите режим разработчика в Excel: Ссылка
  2. Выберите вкладку "Разработчик"> Visual Basic
  3. Нажмите Вид> Код
  4. Вставьте приведенный ниже код, обновляя строки, которые требуют правильных ссылок на ячейки.
  5. Нажмите зеленую стрелку бега или нажмите 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

Ответ 6

У всех вас есть правильные решения, и с горсткой из них вы можете реализовать именно это.

нужны инструменты регулярных выражений, linq, поисковая система, vb.net или С# и интернет.

Найдите "html table to dataset". Затем выполните поиск "набора данных, чтобы преуспеть без предварительного исправления".

Я думаю, что с этими терминами вы можете собрать все вместе.;)

Но вот какое-то решение.

           Using sr As StreamReader = New StreamReader(fileName, Encoding.UTF8)
                result = sr.ReadToEnd()
            End Using
            result = result.Substring(result.IndexOf("<tab"))
            Dim sb As New StringBuilder
            sb.AppendLine("<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"" ""http://www.w3.org/TR/html4/loose.dtd"">")
            sb.AppendLine("<html>")
            sb.AppendLine("<head>")
            sb.AppendLine("<meta http-equiv=""Content-Type"" content=""text/html; charset=iso-8859-1" > "")
            sb.AppendLine("<title>Title</title>")
            sb.AppendLine("</head>")
            sb.AppendLine("<body>")
            sb.Append(result)
            sb.AppendLine("</body>")
            sb.AppendLine("</html>")
            result = sb.ToString()
            File.Move(fileName, System.IO.Path.GetFileNameWithoutExtension(fileName) + ".txt")
            Dim ds As DataSet = GetTableAsDataSet.ConvertHTMLTablesToDataSet(result)
            If (DataSetToExcel.WriteXLSFile(fileName, ds) = True) Then

http://www.dotnetfunda.com/articles/show/51/convert-html-tables-to-a-dataset

http://www.codeproject.com/Tips/313731/How-to-convert-DataSet-to-Excel-workbook-xls-using

Для простоты мой входной файл является html-таблицей, которая сопоставляет с excel право, давая правильный вид. Но это все. поэтому я прочитал его в полосе от мета-стиля и обернул его в действительный html-канал, чтобы получить набор данных и записать данные. наслаждаться.

Я думаю, что регулярное выражение может помочь вам в сборе другой части html...

<table[^>]*>(.*?)</table> == <html[^>]*>(.*?)</html>

Кредиты идут авторам указанного кода. Я просто собрал его.

Ответ 7

Ницца! Очень гладко

Я был разочарован тем, что Excel не позволяет вставлять в объединенную ячейку, а также вставляет результаты, содержащие разрыв в последовательные строки под ячейкой "target", поскольку это означало, что это просто не работает для меня. Я попытался несколько настроек (unmerge/remerge и т.д.), Но затем Excel упал что-нибудь ниже перерыва, так что это был тупик.

В конечном итоге я разработал подпрограмму, которая будет обрабатывать простые теги, а не использовать "родной" конвертер Unicode, который вызывает проблему с объединенными полями. Надеюсь, что другие найдут это полезным:

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

Обратите внимание, что это не заботится о вложении тегов, вместо этого требуется только закрывающий тег для каждого открытого тега, и предполагается, что закрывающий тег, ближайший к открывающему тегу, применяется к открывающему тегу. Правильно вложенные теги будут работать нормально, в то время как неправильно вложенные теги не будут отклонены и могут работать или не работать.

Ответ 8

Чтобы поместить HTML/Word в форму Excel и найти ее в ячейке Excel:

  1. Запишите мой HTML во временный файл.
  2. Откройте временный файл через Word Interop.
  3. Скопируйте его из Word в буфер обмена.
  4. Откройте Excel через Interop.
  5. Установите и выберите ячейку для диапазона.
  6. PasteSpecial как "объект документа Microsoft Word"
  7. Отрегулируйте ряд Excel по высоте формы.

Таким образом, даже HTML с таблицами и другим материалом не разделяется на несколько ячеек.

    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;
    }