2015-05-29 5 views
0

Я получаю вышеуказанную ошибку в своем коде Excel ниже. Этот код предназначен для переустановки высоты строк строк с объединенными ячейками. Код был скопирован непосредственно с сайта поддержки Microsoft и работает отлично, если используется только один раз.Excel 2013 VBA: Ошибка -2147417848 Метод 'Выбрать' объекта 'Range' failed

В моей петле ниже, это infact прекрасно работает на 1-й шесть объединенных ячеек.

Ошибка возникает только на линии:

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

при выполнении 24-й итерации «для» петли. Значение ErrorFile_LastRow равно 43. Первая объединенная ячейка находится в строке 18. Строка 24 имеет не объединенные ячейки. Я нашел несколько актуальную статью от Майкрософт по адресу https://support.microsoft.com/en-us/kb/319832 и, как таковой, добавил ссылки oXL в приведенном ниже коде. Основываясь на той же статье, я добавил NewWorksheet в оскорбительные строки, но ничто из этого не помогло.

Такая же ошибка возникает в одной и той же строке на той же самой итерации без каких-либо из вышеперечисленных изменений или о том, сколько и сколько приложений выполняется. Я даже пытался перезагрузить свой ноутбук и убедиться, что только макрос работает без какого-либо другого офисного приложения, но даже это, похоже, не помогает.

Infact, если кто-то может сказать мне, как отрегулировать высоту строки объединенных ячеек, не используя «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

Я не вижу очевидной причины для отказа этой конкретной строки кода. Ошибка, которую вы получаете, почти всегда связана с попыткой «Выбрать» ячейки из «Worksheet», который не является «ActiveSheet». Добавьте строку до строки ошибки, чтобы убедиться, что вы действительно находитесь на правом листе: 'Debug.Print ActiveSheet.Name = NewWorksheet.Name'. Так как это «сложный макрос», есть ли у вас какие-либо события «Worksheet_Change» или «Worksheet_SelectionChange»? Это может привести к хаосу со всеми выборами. –

ответ

0

делают иск ErrorFile_LastRow инициализируется где-то.

+0

Извините, я пропустил копирование этого кода здесь. Я добавил его к фрагменту выше. Значение ErrorFile_LastRow - 43. – user4954633

Смежные вопросы