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