这里编程新手。我很快就获得了一段vba代码,这使我能够将文本表单字段数据和单选按钮数据从Word导出到Excel中。
当宏运行时,它会将选定的输出从一组单选按钮放入单个Excel工作表,并将文本表单字段中的文本输出放入同一文档中的另一个工作表。 excel文件启用了.xlsm宏。
如果提供的txt响应相对较短,最多只有几个句子,代码就像梦一样。但是,如果我运行宏来包含一个较长的文本表单字段响应(包括529个字符),这会导致运行时类型不匹配'错误(13)。我猜我一定要超过某种角色限制?或者它与文本格式有关? txt表单字段本身的属性设置为“无限制”'和'常规文字'。这是代码:
Option Explicit
Sub ExportResponsesToExcel()
Dim arrOptionButtons() As String
Dim dicOptionButtons As Object
Dim dicFormFields As Object
Dim oInlineShape As InlineShape
Dim oInlineShapes As InlineShapes
Dim oOptionButton As OptionButton
Dim oFormFields As FormFields
Dim oFormField As FormField
Dim Col As Long
Dim oDoc As Document
Dim xlApp As Object
Dim xlWB As Object
Set oDoc = ActiveDocument
If oDoc Is Nothing Then
MsgBox "No document is active.", vbExclamation
Exit Sub
End If
Set oInlineShapes = oDoc.InlineShapes
Col = 0
If oInlineShapes.Count > 0 Then
ReDim arrOptionButtons(1 To 2, 1 To oInlineShapes.Count)
Set dicOptionButtons = CreateObject("Scripting.Dictionary")
dicOptionButtons.CompareMode = vbTextCompare
For Each oInlineShape In oInlineShapes
If oInlineShape.Type = wdInlineShapeOLEControlObject Then
If TypeName(oInlineShape.OLEFormat.Object) = "OptionButton" Then
Set oOptionButton = oInlineShape.OLEFormat.Object
If Not dicOptionButtons.Exists(oOptionButton.GroupName) Then
Col = Col + 1
arrOptionButtons(1, Col) = oOptionButton.GroupName
If oOptionButton.Value = True Then
arrOptionButtons(2, Col) = oOptionButton.Caption
End If
dicOptionButtons.Add oOptionButton.GroupName, Col
Else
If oOptionButton.Value = True Then
arrOptionButtons(2, dicOptionButtons(oOptionButton.GroupName)) = oOptionButton.Caption
End If
End If
End If
End If
Next oInlineShape
If Col > 0 Then
ReDim Preserve arrOptionButtons(1 To 2, 1 To Col)
End If
End If
Set oFormFields = oDoc.FormFields
If oFormFields.Count > 0 Then
Set dicFormFields = CreateObject("Scripting.Dictionary")
dicFormFields.CompareMode = vbTextCompare
For Each oFormField In oFormFields
dicFormFields(oFormField.Name) = oFormField.Range.Text
Next oFormField
End If
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo 0
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
End If
Set xlWB = xlApp.workbooks.Add(-4167) 'create an XL workbook containing one worksheet
With xlWB.activesheet
.Range("A1").Value = "Form Field Name"
.Range("B1").Value = "Form Field Text"
If oFormFields.Count > 0 Then
.Range("A2").Resize(dicFormFields.Count).Value = xlApp.transpose(dicFormFields.keys)
.Range("B2").Resize(dicFormFields.Count).Value = xlApp.transpose(dicFormFields.items)
End If
.Columns("A:B").AutoFit
.Name = "Form Fields"
End With
With xlWB.worksheets.Add
.Range("A1").Value = "Question"
.Range("B1").Value = "Response"
If Col > 0 Then
.Range("A2").Resize(Col, 2).Value = xlApp.transpose(arrOptionButtons)
End If
.Columns("A:B").AutoFit
.Name = "Option Buttons"
End With
AppActivate xlWB.Name
Set dicOptionButtons = Nothing
Set dicFormFields = Nothing
Set oInlineShape = Nothing
Set oInlineShapes = Nothing
Set oOptionButton = Nothing
Set oFormField = Nothing
Set oFormFields = Nothing
Set oDoc = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
非常感谢任何帮助 - 谢谢Cal