为什么某些数据从Word导入Excel时字体是黄色,而在Word中却不是?

为什么某些数据从Word导入Excel时字体是黄色,而在Word中却不是?

学生在 Word 中填写一些表格,有时他们必须使用特定颜色的字体才能获得满分。我使用 VBA 从他们提交的文档中导入他们的数据和字体颜色。大多数结果看起来正确,但有些结果显示为黄色或橙色字体。

最可能的原因是原始文件中的字体颜色是这些色调,或者在再次运行宏之前没有进行任何格式清理,但我已经检查过以确保不是这种情况。我研究的另一种可能性是黄色来自 Word 文件受保护时出现的黄色编辑字段。我使用了一些代码来解决这个问题,但没有效果。完整脚本的代码如下:

Public Sub ImportWordData(folderPath As String)
    Dim wordApp As Word.Application
    Dim wordDoc As Word.Document
    Dim fso As Scripting.FileSystemObject
    Dim aFold As Scripting.Folder, aFile As Scripting.File
    Dim rngOutput As Range
    Dim wRange(0 To 20) As Word.Range
    Dim strOutput As String
    Dim lColor(0 To 20) As Long, lBColor(0 To 20) As Long
    Dim lTable(0 To 1) As Long
    Dim i As Long, x As Long, y As Long, z As Long
    
    wksRaw.Cells.Clear
    
    Set fso = New FileSystemObject
    Set aFold = fso.GetFolder(folderPath)
    Set wordApp = New Word.Application
    Set rngOutput = wksRaw.Range("B2")
    lTable(0) = wksStart.Range("G5").Value
    lTable(1) = wksStart.Range("G6").Value
    
    For Each aFile In aFold.Files
        
        If InStr(1, aFile.Name, "~") > 0 Or InStr(1, aFile.Name, "Importer") Then GoTo SkipLoop
              
        Set wordDoc = wordApp.Documents.Open(aFold.Path & Application.PathSeparator & aFile.Name)
        Call FixHighlights(wordApp, wordDoc)
        
        Set wRange(0) = wordDoc.Tables(lTable(0)).Rows(3).Cells(3).Range
        Set wRange(1) = wordDoc.Tables(lTable(0)).Rows(3).Cells(1).Range
        lColor(0) = wordDoc.Tables(lTable(0)).Rows(3).Cells(3).Range.Font.Color
        lColor(1) = wordDoc.Tables(lTable(0)).Rows(3).Cells(3).Range.Font.Color
        
        Debug.Print ("0: " & lColor(0) & " 1: " & lColor(1))
        x = 10
        
        For i = 3 To 10
            Set wRange(i - 1) = wordDoc.Tables(lTable(0)).Rows(i).Cells(2).Range
            lColor(i - 1) = wordDoc.Tables(lTable(0)).Rows(i).Cells(2).Range.Font.Color
        Next i
                
        For i = 2 To 6 Step 2
            Set wRange(x) = wordDoc.Tables(lTable(1)).Cell(19, i).Range
            lColor(x) = wordDoc.Tables(lTable(1)).Cell(19, i).Range.Font.Color
            x = x + 1
        Next i
    
        For i = 4 To 13
            If i = 8 Then i = 10
            Set wRange(x) = wordDoc.Tables(lTable(1)).Cell(i, 2).Range
            lColor(x) = wordDoc.Tables(lTable(1)).Cell(i, 2).Range.Font.Color
            x = x + 1
        Next i

        rngOutput.Cells(z + 1, 1).Value = wordDoc.Name
        
        For i = 0 To 20
            strOutput = WorksheetFunction.Trim(WorksheetFunction.Clean(wRange(i).Text))
            rngOutput.Cells(z + 1, i + 2).Value = strOutput
            rngOutput.Cells(z + 1, i + 2).Font.Color = lColor(i)
        Next i
        
        z = z + 1
        wordDoc.Close False
        
SkipLoop:
    Next aFile
    
    wksRaw.UsedRange.EntireColumn.ColumnWidth = 15
    
    On Error Resume Next
    wksRaw.Activate
    On Error GoTo 0

    wordApp.Quit False
    
    Set fso = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing
    On Error GoTo 0
    
End Sub

Sub FixHighlights(wApp As Word.Application, wDoc As Word.Document)
    Dim oFF As FormField
    
    On Error Resume Next
    wDoc.FormFields.Shaded = False

    If wDoc.ProtectionType = wdAllowOnlyFormFields Then wDoc.Unprotect

    For Each oFF In wDoc.FormFields
        oFF.Range.HighlightColorIndex = wdNoHighlight
    Next

    wDoc.Protect wdAllowOnlyFormFields, NoReset:=True, Password:=""
    wApp.ActiveWindow.View.ShadeEditableRanges = False
    On Error GoTo 0
    
End Sub

下图是一个例子;我将表格单元格(图片下半部分)中的日期导入 Excel,它变成黄色。

黄色字体来自Word Table

相关内容