2015-11-09 2 views
3

Я работаю со списком Excel и хочу включить:Преобразование форматированного текста в теги форматирования HTML

Quercus agrifolia вара. oxyadenia (Torr.) J.T. Howell

в:

<i>Quercus agrifolia</i> var. <i>oxyadenia</i> (Torr.) J.T. Howell 

У меня есть Rich Text форматированный список с форматированием применяется, но я хочу, чтобы отправить его в Access с тегами форматирования явно включенных вокруг родственного текста.

+0

Если это требует VBA (это * возможно * нет), вы должны опубликовать то, что вы пытались и где/как это не удалось. – pnuts

+0

@pnuts Макро здесь (http://community.hpe.com/t5/Quality-Center-Support-and-News/Retain-the-formatting-while-exporting-from-Excel-to-QC/td-p/5217106) делает противоположное тому, что я хочу, конвертируя html помеченный текст в расширенный текст в excel. Я хочу, чтобы в моей ячейке были явные html-теги, поэтому я могу экспортировать форматирование, которое было ранее применено к значениям ячеек. Надеюсь, что ответы на вопросы и спасибо – SeanB

ответ

7

Я искал, чтобы сделать то же самое, и нашел ответ на MSDN по адресу: Convert contents of a formatted excel cell to HTML format

Я надеюсь, что это поможет вам, как хорошо, он использует Excel макрос.

Edit: При использовании этого мне нужно, чтобы изменить код для вложенных тегов, пожалуйста, найти мои обновления макроса ниже:

Function fnConvert2HTML(myCell As Range) As String 
    Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn As Boolean 
    Dim i, chrCount As Integer 
    Dim chrCol, chrLastCol, htmlTxt, htmlEnd As String 

    bldTagOn = False 
    itlTagOn = False 
    ulnTagOn = False 
    colTagOn = False 
    chrCol = "NONE" 
    'htmlTxt = "<html>" 
    htmlTxt = "" 
    chrCount = myCell.Characters.Count 

    For i = 1 To chrCount 
    htmlEnd = "" 
     With myCell.Characters(i, 1) 
      If (.Font.Color) Then 
       chrCol = fnGetCol(.Font.Color) 
       If Not colTagOn Then 
        htmlTxt = htmlTxt & "<font color=#" & chrCol & ">" 
        colTagOn = True 
       Else 
        If chrCol <> chrLastCol Then htmlTxt = htmlTxt & "</font><font color=#" & chrCol & ">" 
       End If 
      Else 
       chrCol = "NONE" 
       If colTagOn Then 
        htmlEnd = "</font>" & htmlEnd 
        'htmlTxt = htmlTxt & "</font>" 
        colTagOn = False 
       End If 
      End If 
      chrLastCol = chrCol 

      If .Font.Bold = True Then 
       If Not bldTagOn Then 
        htmlTxt = htmlTxt & "<b>" 
        bldTagOn = True 
       End If 
      Else 
       If bldTagOn Then 
        'htmlTxt = htmlTxt & "</b>" 
        htmlEnd = "</b>" & htmlEnd 
        bldTagOn = False 
       End If 
      End If 

      If .Font.Italic = True Then 
       If Not itlTagOn Then 
        htmlTxt = htmlTxt & "<i>" 
        itlTagOn = True 
       End If 
      Else 
       If itlTagOn Then 
        'htmlTxt = htmlTxt & "</i>" 
        htmlEnd = "</i>" & htmlEnd 
        itlTagOn = False 
       End If 
      End If 

      If .Font.Underline > 0 Then 
       If Not ulnTagOn Then 
        htmlTxt = htmlTxt & "<u>" 
        ulnTagOn = True 
       End If 
      Else 
       If ulnTagOn Then 
        'htmlTxt = htmlTxt & "</u>" 
        htmlEnd = "</u>" & htmlEnd 
        ulnTagOn = False 
       End If 
      End If 

      If (Asc(.Text) = 10) Then 
       htmlTxt = htmlTxt & htmlEnd & "<br>" 
      Else 
       htmlTxt = htmlTxt & htmlEnd & .Text 
      End If 

     End With 
    Next 

    If colTagOn Then 
     htmlTxt = htmlTxt & "</font>" 
     colTagOn = False 
    End If 
    If bldTagOn Then 
     htmlTxt = htmlTxt & "</b>" 
     bldTagOn = False 
    End If 
    If itlTagOn Then 
     htmlTxt = htmlTxt & "</i>" 
     itlTagOn = False 
    End If 
    If ulnTagOn Then 
     htmlTxt = htmlTxt & "</u>" 
     ulnTagOn = False 
    End If 
    'htmlTxt = htmlTxt & "</html>" 
    fnConvert2HTML = htmlTxt 
End Function 

Function fnGetCol(strCol As String) As String 
    Dim rVal, gVal, bVal As String 
    strCol = Right("000000" & Hex(strCol), 6) 
    bVal = Left(strCol, 2) 
    gVal = Mid(strCol, 3, 2) 
    rVal = Right(strCol, 2) 
    fnGetCol = rVal & gVal & bVal 
End Function 
+2

Спасибо, что работает! – SeanB

Смежные вопросы