2015-05-29 65 views
0

我在下面的Excel代码中收到上述错误。此代码用于重新排列合并单元格的行高度。该代码直接从微软的支持网站复制,并且如果仅使用一次就可以正常工作。Excel 2013 VBA:错误-2147417848对象'范围'的方法'选择'失败

在我的循环下面,它实际上在第一个六个合并的单元格上工作得很好。在执行“for”循环的24次迭代

NewWorksheet.Range(NewWorksheet.Cells(RowCounter, 5), NewWorksheet.Cells(RowCounter, 6)).Select 

错误只发生就行了。 ErrorFile_LastRow的值是43.第一个合并的单元格在第18行。第24行有未合并的单元格。我从https://support.microsoft.com/en-us/kb/319832的微软发现了一个有点相关的文章,并在下面的代码中添加了oXL引用。基于同一篇文章,我在违规行中添加了NewWorksheet,但没有任何帮助。

在完全相同的迭代regregless任何上述更改或什么和多少应用程序正在运行的同一行上发生相同的错误。我甚至试图重新启动我的笔记本电脑,并确保只有宏运行没有其他办公应用程序,但即使这似乎没有帮助。事实上,如果有人可以告诉我如何调整合并单元格的行高而不使用'Select','ActiveCell'等,这将是最好的,因为我试图不使用这些类型的命令以增加代码的健壮性&速度,并且确保宏不停止处理,因为我正在处理另一个应用程序。

培训相关的代码段(宏本身是非常复杂的): -

Dim oXL As Excel.Application 
Dim NewWorkbook As Workbook 
Dim NewWorksheet As Worksheet 
Dim ErrorFile_LastRow As Long 
Dim MergedHeight As Single 
Dim MergedWidth As Single 
Dim PossNewRowHeight As Single 
Dim lngRowCount As Long 
Dim lngColCount As Long 
Dim i As Long 
Dim RowCounter As Long 
Dim ActiveCellWidth As Single 

Set oXL = Excel.Application 

    oXL.Workbooks.Add 
    '------------------------------------------------------------------------------------------------- 
    ' Create a workbook handle for the new workbook 
    '------------------------------------------------------------------------------------------------- 
    Set NewWorkbook = oXL.ActiveWorkbook 
    '---------------------------------------------------------------------------------------------------------- 
    ' Use the new workbook handle. 
    '---------------------------------------------------------------------------------------------------------- 
    With NewWorkbook 
     '------------------------------------------------------------------------------------------------- 
     ' Create a new worksheet handle for the new workbook. 
     '------------------------------------------------------------------------------------------------- 
     Set NewWorksheet = .Sheets(1) 
    End With 

    '---------------------------------------------------------------------------------------------------------- 
    ' Use the new worksheet handle. 
    '---------------------------------------------------------------------------------------------------------- 
    With NewWorksheet 
     '------------------------------------------------------------------------------------------------- 
     ' Capture the last row of data to process. 
     '------------------------------------------------------------------------------------------------- 
     ErrorFile_LastRow = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 
     .Range(Cells(1, 1), Cells(ErrorFile_LastRow, 6)).Select 
    End With 

    NewWorksheet.Activate 
    Application.PrintCommunication = True 
    NewWorksheet.PageSetup.PrintArea = Selection.Address 
    '------------------------------------------------------------------------------------------------- 
    ' Adjust the row height to fit the data. 
    '------------------------------------------------------------------------------------------------- 
    For RowCounter = 2 To ErrorFile_LastRow 
     If RowCounter <> ErrorFile_LastRow Then 
      NewWorksheet.Range(NewWorksheet.Cells(RowCounter, 5), NewWorksheet.Cells(RowCounter, 6)).Select 
     Else 
      NewWorksheet.Range(Cells(RowCounter, 1), Cells(RowCounter, 6)).Select 
     End If 
     If ActiveCell.MergeCells Then 
      With ActiveCell.MergeArea 
       If .WrapText = True Then 
        lngRowCount = .Rows.Count 
        lngColCount = .Columns.Count 
        MergedHeight = Selection.Height 
        For i = 1 To lngColCount 
         MergedWidth = .Cells(1, i).ColumnWidth + 1 + MergedWidth 
        Next i 
        If MergedHeight > 409.5 Then 
         MergedHeight = 409.5 
        End If 
        If MergedWidth > 409.5 Then 
         MergedHeight = 409.5 
        End If 
        ActiveCellWidth = ActiveCell.ColumnWidth 
        .MergeCells = False 
        .Cells(1).RowHeight = MergedHeight 
        .Cells(1).ColumnWidth = MergedWidth 
        .EntireRow.AutoFit 
        PossNewRowHeight = .Cells(1).RowHeight 
        .MergeCells = True 
        .Cells(1).ColumnWidth = ActiveCellWidth 
        For i = 1 To lngRowCount 
         .Cells(i, 1).RowHeight = PossNewRowHeight/lngRowCount 
        Next i 
       End If 
      End With 
     End If 
    Next RowCounter 
+0

我没有看到该特定行代码失败的明显原因。您得到的错误几乎总是与尝试从不是“ActiveSheet”的“工作表”中的“选择”单元格有关。在错误行之前添加一行以确认您确实位于正确的表单上:“Debug.Print ActiveSheet.Name = NewWorksheet.Name”。既然这是一个“复杂的宏”,你是否有任何“Worksheet_Change”或“Worksheet_SelectionChange”事件?这些可能会对所有正在进行的选择造成严重破坏。 –

回答

0

化妆起诉ErrorFile_LastRow某处初始化。

+0

对不起,我错过了在这里复制代码。我将它添加到上面的代码片段中。 ErrorFile_LastRow的值是43。 – user4954633

相关问题