從單元格中提取文本內容（使用粗體，斜體等）

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