文本表单字段中的字符数导致运行时错误13(类型不匹配)

时间:2016-07-04 15:30:09

标签: excel-vba vba excel

这里编程新手。我很快就获得了一段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

0 个答案:

没有答案