学生在 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,它变成黄色。