从单元格中提取文本内容（使用粗体，斜体等）

Question

我试图使用宏从Excel中提取文本内容。这是我的代码：

Dim i As Integer, j As Integer 
Dim v1 As Variant 
Dim Txt As String 

v1 = Range("A2:C15") 
For i = 1 To UBound(v1) 
    For j = 1 To UBound(v1, 2) 
     Txt = Txt & v1(i, j) 
    Next j 
    Txt = Txt & vbCrLf 
Next i 

MsgBox Txt 

但它是只表示这意味着它不显示如粗体，斜体任何格式的信息，下划线等方面的原始字符..

我想提取文本以及格式化信息。

举例：这是样品文本

预期输出：这是样品文本

实际输出：这是示例文本

有人能解释一下什么是错误的代码，并告诉如果有什么错误？

Answer 1

OK，让我们的算法从@stucharo一点点简单的扩展。

Public Function getHTMLFormattedString(r As Range) As String 

isBold = False 
isItalic = False 
isUnderlined = False 
s = "" 
cCount = 0 
On Error Resume Next 
cCount = r.Characters.Count 
On Error GoTo 0 

If cCount > 0 Then 

    For i = 1 To cCount 

    Set c = r.Characters(i, 1) 

    If isUnderlined And c.Font.Underline = xlUnderlineStyleNone Then 
    isUnderlined = False 
    s = s & "</u>" 
    End If 

    If isItalic And Not c.Font.Italic Then 
    isItalic = False 
    s = s & "</i>" 
    End If 

    If isBold And Not c.Font.Bold Then 
    isBold = False 
    s = s & "</b>" 
    End If 


    If c.Font.Bold And Not isBold Then 
    isBold = True 
    s = s + "<b>" 
    End If 

    If c.Font.Italic And Not isItalic Then 
    isItalic = True 
    s = s + "<i>" 
    End If 

    If Not (c.Font.Underline = xlUnderlineStyleNone) And Not isUnderlined Then 
    isUnderlined = True 
    s = s + "<u>" 
    End If 

    s = s & c.Text 

    If i = cCount Then 
    If isUnderlined Then s = s & "</u>" 
    If isItalic Then s = s & "</i>" 
    If isBold Then s = s & "</b>" 
    End If 

    Next i 

Else 
    s = r.Text 
    If r.Font.Bold Then s = "<b>" & s & "</b>" 
    If r.Font.Italic Then s = "<i>" & s & "</i>" 
    If Not (r.Font.Underline = xlUnderlineStyleNone) Then s = "<u>" & s & "</u>" 
End If 

getHTMLFormattedString = s 
End Function 

要清楚的是，此功能只适用于包含单个单元格的范围。但是，应该很容易为更大范围内的每个单元调用此函数，并将返回的字符串连接成一个。

编辑由OP：

我用下面的代码调用的函数：

Sub ReplaceFormattingTags() 

Dim i As Integer, j As Integer 
Dim rng As Range 
Dim Txt As String 

Set rng = Range("A2:C15") 
For i = 1 To rng.Rows.Count 
    For j = 1 To rng.Columns.Count 
     Txt = Txt & getHTMLFormattedString(rng(i, j)) & " " 
    Next j 
    Txt = Txt & vbCrLf 
Next i 

Debug.Print Txt 

End Sub 

Answer 2

VBA字符串不支持这种格式。它将纯粹从范围中取出字符串。根本没有格式化。如果你想格式化字符串，你不能通过msgbox看到这个。

只有这样做才能将它存储在单元格中，然后格式化单元格。但是，这并不能让你在一个消息框中输出一个格式化的字符串。

如果您打算将字符串放入格式化的单元格中，则需要将格式保存到某处，或者将其从您获取文本的单元格中复制。然后将格式应用于单元格

Answer 3

消息框不允许在不更改系统默认值的情况下进行形成操作，这不是明智的前向方法。如果你想在提示中显示格式化文本，那么你可能最容易创建一个用户表单并适当地设置标签的格式。

例如，你可以决定细胞是否具有使用大胆fomatting：

Dim isBold As Boolean 
isBold = v1(i, j).Font.Bold 

而且使用申请这一个窗体标签字体：

label.Font.Bold = isBold 

如果要输出到一个文本（即.txt）文件，那么这不能存储任何格式信息。你可能希望达到最好的是创建一个标记样式输出，其中：

If isBold Then 
    txt = "<b >mytext< /b>" 'Ignore the spaces 
Else 
    txt = "mytext" 
End If 

的range.Font.Bold属性有三种回报选择：

v1(i, j).Font.Bold = True 'if the entire cell IS bold 
v1(i, j).Font.Bold = False 'if the entire cell IS NOT bold 
v1(i, j).Font.Bold = Null 'if the cell is PARTIALLY bold 

调用IsNull(v1(i, j).Font.Bold)会告诉你，你是否有在部分fomatting细胞。不幸的是，您必须逐个评估字符串中的每个字符以确定粗体字符。这个功能应该确定其中粗体格式中包含传递的Range对象的字符串开启或关闭，并添加适当的标记标签：

Function markup(rng As Range) As String 

Dim chr As Integer 
Dim isCharBold As Boolean 
Dim str As String 
Dim tempChar As Characters 

isCharBold = False 
str = "" 

If IsNull(rng.Font.Bold) Then 
    For chr = 1 To rng.Characters.Count 
     Set tempChar = rng.Characters(chr, 1) 
     If isCharBold Then 
      If tempChar.Font.Bold Then 
       str = str + tempChar.Text 
      Else 
       isCharBold = False 
       str = str & "</b>" & tempChar.Text 
      End If 
     Else 
      If tempChar.Font.Bold Then 
       isCharBold = True 
       str = str + "<b>" & tempChar.Text 
      Else 
       str = str & tempChar.Text 
      End If 
     End If 
    Next chr 
Else 
    str = rng.Value 
End If 

markup = str 

End Function 

注意，Else情况下，只需返回默认字符串值。您可以修改此方法以适用于.Font属性的任何属性，例如删除线，下划线，斜体....

OP中的框架建议您将一系列单元格的内容分配到Variant类型的数组中。这基本上让你在每个数组索引中都有一个未格式化的字符串。在这种情况下，您将无法从数组字符串中提取任何格式。要访问Characters().Font.Bold属性，您必须在Range对象上运行，因此最好直接遍历Range("A2:C15")中的每个单元格。这可以通过修改初始代码等来实现，所以现在调用标记功能：

Sub OutputText() 

Dim i As Integer, j As Integer 
Dim rng As Range 
Dim Txt As String 

Set rng = Range("A2:C15") 
For i = 1 To rng.Rows.Count 
    For j = 1 To rng.Columns.Count 
     Txt = Txt & markup(rng(i, j)) & " " 
    Next j 
    Txt = Txt & vbCrLf 
Next i 

Debug.Print Txt 

End Sub