Question

我在MS Word中创建一个MACRO，需要能够（基本上）将word中的表格内容复制并粘贴到excel中。

免责声明：这似乎过于复杂化;但是，这种方法是必需的，因为它是一种更复杂处理的设置。

长话短说，我遍历文档中的每个表格，然后遍历表格中的每个单元格，并将文本放入Excel工作表中的相应单元格中。

我有excel对象的这些声明：

'Objects
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlRange As Excel.Range

在我的循环底部，我有以下代码：

xlBook.Worksheets(x).Activate
Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
xlRange.Text = tString

最后一行是抛出一个＆＃34;所需的对象＆＃34;错误。变量tstring被定义为一个字符串，并在循环中设置。

完整代码：

Sub CopyTablesToExcel()
    'Constants
    Const COLUMN_INDEX = 1
    Const ROW_INDEX = 2

    'Ints
    Dim x As Integer, y As Integer, z As Integer 'Counters
    Dim numTables As Integer 'Number of tables in the word file
    Dim numSheets As Integer 'Number of sheets in the excel file
    Dim LastCell(1 To 2) As Integer   'Used to keep track of the last cell of a newly created excel table
    Dim map() As Integer 'Holds a map of the table columns

    'strings
    Dim xlBookName As String 'Name of the excel workbook
    Dim tString As String 'Temporary string

    'Objects
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlRange As Excel.Range

    'Initialize
    Set xlBook = xlApp.Workbooks.Add
    numSheets = xlBook.Worksheets.count
    numTables = ActiveDocument.Tables.count

    'Save the new book
    xlBookName = InputBox("Enter the ticker symbol:")
    xlBook.SaveAs FileName:=xlBookName

    'Show the file?
    xlApp.Visible = True

    'Make sure there are enough sheets
    If numSheets < numTables Then
        For x = 1 To (numTables - numSheets)
            xlBook.Worksheets.Add
            numSheets = numSheets + 1
        Next
    End If

    'Cycle through every table in the document and paste it to the worksheet
    For z = 1 To numTables 'Cycle through tables
        'Keep track of the last cell in the table
        LastCell(COLUMN_INDEX) = ActiveDocument.Tables(z).Columns.count
        LastCell(ROW_INDEX) = ActiveDocument.Tables(z).rows.count

        For x = ActiveDocument.Tables(z).rows(ActiveDocument.Tables(z).rows.count).Cells.count To 1 Step -1 'Cycle through columns
            'Used selections to support horizontally merged cells
            ActiveDocument.Tables(z).rows(ActiveDocument.Tables(z).rows.count).Cells(x).Select
            Selection.SelectColumn
            For y = Selection.Cells.count To 1 Step -1 'Cycle through cells
                tString = Selection.Cells(y).Range.Text

                'Move the content into excel
                xlBook.Worksheets(x).Activate
                Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
                Debug.Print Chr(65 + x) & y 'Prints as expected
                xlRange.Text = tString
            Next
        Next
    Next
End Sub

我相信这是因为MACRO无法正确设置xlRange。 debug.print的输出是正确的，格式为＆＃34; A＃＆＃34;。

编辑：

If Not xlRange Is Nothing Then
    xlRange.Text = tString 'Still errors
End If

以上将评估为true但仍然会在标记的行

处抛出错误

Answer 1

我看到两件事：

.Text是一个只读属性。我希望有一个＆＃34;无法设置范围对象的文本属性＆＃34;这一行出错：

xlRange.Text = tString

更改为：

xlRange.Value = tString

此外，您的范围分配可能是错误的。我不知道你为什么要做CHR(65)而不是简单地＆＃34; A＆＃34;，但问题是这一行：

Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)

此处您添加 x到65，然后Chr函数会返回任何可能引发错误的结果。值x大于25很可能会引发错误，因为Chr(65 + x)不会计算到有效的范围地址。

既然您在评论中澄清了您打算这样做的事情（例如，＆＃34; A＆＃34; + 1 =＆＃34; B＆＃34;等等），那么可能更好如果没有其他原因，它似乎更清晰，并以较少模糊的方式利用Excel对象模型：

Set xlRange = xlBook.ActiveSheet.Range("A" & y).Offset(,x)

MS Word VBA：从word控制excel工作簿 - 对象所需的错误

1 个答案: