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>
в это:
Это тест. Будет ли этот текст жирным или курсивом?
6 ответов
Да, это возможно:) На самом деле пусть Internet Explorer сделает всю грязную работу за вас;)
ПРОВЕРЕНО И ИСПЫТАНО
Мои предположения
- Я предполагаю, что HTML-текст находится в ячейке A1 Sheet1. Вы также можете использовать переменную вместо.
- Если у вас есть столбец, полный значений HTML, просто поместите приведенный ниже код в цикл
КОД
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
СНАПШОТ
НТН
Sid
Я столкнулся с той же ошибкой, которую BornToCode впервые обнаружил в комментариях к исходному решению. Будучи незнакомым с Excel и VBA, мне потребовалась секунда, чтобы понять, как реализовать решение tiQU. Так что я выкладываю это как решение "Для чайников" ниже
- Сначала включите режим разработчика в Excel: Ссылка
- Выберите вкладку разработчика> Visual Basic
- Нажмите Вид> Код
- Вставьте приведенный ниже код, обновляя строки, которые требуют правильных ссылок на ячейки.
- Нажмите зеленую стрелку бега или нажмите 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
Вы можете скопировать HTML-код в буфер обмена и вставить его обратно в виде текста Unicode. 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
Если пример IE не работает, используйте этот. В любом случае это должно быть быстрее, чем запускать экземпляр IE.
Вот полное решение на основе
http://www.dailydoseofexcel.com/archives/2005/02/23/html-in-cells-ii/
Заметьте, если ваш innerHTML представляет собой все числа, например "12345", форматирование HTML не полностью работает в 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
Я знаю, что этот поток является древним, но после назначения innerHTML, ExecWB работал для меня:
.ExecWB 17, 0
'Select all contents in browser
.ExecWB 12, 2
'Copy themА затем просто вставьте содержимое в Excel. Поскольку эти методы подвержены ошибкам во время выполнения, но прекрасно работают после одной или двух попыток в режиме отладки, вам может потребоваться указать Excel повторить попытку в случае возникновения ошибки. Я решил это, добавив этот обработчик ошибок в подпрограмму, и он отлично работает:
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Ницца! Очень гладко
Я был разочарован тем, что 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
Обратите внимание, что это не заботится о вложении тегов, вместо этого требуется только закрывающий тег для каждого открытого тега, и предполагается, что закрывающий тег, ближайший к открывающему тегу, применяется к открывающему тегу. Правильно вложенные теги будут работать нормально, в то время как неправильно вложенные теги не будут отклонены и могут работать или не работать.
Чтобы поместить HTML/Word в форму Excel и найти его в ячейке Excel:
- Напишите мой HTML-код во временный файл.
- Откройте временный файл через Word Interop.
- Скопируйте его из Word в буфер обмена.
- Откройте Excel через Interop.
- Установите и выберите ячейку в диапазоне.
- PasteSpecial как "объект документа Microsoft Word"
- Отрегулируйте строку 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;
}
У всех вас есть правильные решения, и с их помощью вы сможете реализовать именно это.
Инструменты - это регулярные выражения, linq, поисковая система, vb.net или C# и интернет.
Поиск "HTML таблица для набора данных". Затем выполните поиск "набор данных для Excel без установленного Excel".
Я думаю, что с этими условиями вы могли бы соединить это.;)
Но вот некоторые решения.
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-таблицу, которая преобразуется в правильные, давая правильное представление. Но взгляд это все, что есть. так что я прочитал это в отрыве от дерьма мета-стилей и обернул его в действительный html-канал, чтобы получить набор данных и записать их. наслаждаться.
Я думаю, что регулярное выражение может помочь вам собрать другую часть HTML...
<table[^>]*>(.*?)</table> == <html[^>]*>(.*?)</html>
Кредиты идут авторам указанного кода. Я просто собрал это.