VPF::424 Object Required - Форум программистов

SoulKeeper

Дата 14.7.2009, 14:47 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 375
Регистрация: 14.1.2007
Где: Ukraine, Lviv.

Репутация: нет
Всего: 15

Всем привет, есть такой код:

Код


Private Sub Workbook_Open()
    FixAutoFit
End Sub

Private Function FixAutoFit()
    Dim ws As Worksheet
    Dim cell As Range
    
    Application.ScreenUpdating = False
    
    For Each ws In Worksheets
        For Each cell In ws.UsedRange
            If cell.Rows.Count = 1 Then
                If cell.MergeCells And cell.WrapText And IsTopLeftCell(cell) Then
                    FixAutoFitForCell (cell)
                End If
            Else
                MsgBox ("Not Supported:" + cell.Address)
            End If
        Next cell
    Next ws
End Function

Private Function FixAutoFitForCell(cell As Range)
    Dim totalWidth As Single
    Dim oldHeight As Single
    Dim oldWidth As Single
    Dim cellCount As Integer
    Dim ac As Range
    
    cellCount = cell.MergeArea.Columns.Count
    
    For Each ac In cell.MergeArea.Cells
        totalWidth = totalWidth + ac.Width
    Next ac
    
    cell.WrapText = False
    cell.MergeArea.UnMerge
    oldWidth = cell.Width
    cell.Width = totalWidth
    cell.WrapText = True
    cell.Row.AutoFit

    If cell.Height < oldHeight Then
        cell.Height = oldHeight
    End If
    
    cell.Width = oldWidth
End Function

Private Function IsTopLeftCell(cell As Range)
    If cell.Address = cell.MergeArea.Cells(1, 1).Address Then
        IsTopLeftCell = True
    Else
        IsTopLeftCell = False
    End If
End Function

Excel при запуске макроса (а именно при вызове FixAutoFitForCell) выдает ошибку "Run-time Error '424' Object Required'"

Сразу оговорюсь что я Java программист и сюда забрел не от счасливой судьбы smile

По сабжу - не понятно почему вылетает, т.к. IsTopLeftCell принимает аналогичные параметры, но работет.

smile

Naghual

Дата 14.7.2009, 15:21 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49

У вас нигде не инициирована oldHeight и ей не задано значение. Возможно что ошибка в этом.

На будущее, указывайте строку в которой происходит ошибка

--------------------

Я желаю всем Счастья!

SoulKeeper

Дата 14.7.2009, 15:27 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 375
Регистрация: 14.1.2007
Где: Ukraine, Lviv.

Репутация: нет
Всего: 15

Ладно, сделаем по другому smile

Код


Private Sub Workbook_Open()
    FixAutoFit
End Sub

Private Function FixAutoFit()
    Dim ws As Worksheet
    Dim cell As Range
    
    Application.ScreenUpdating = False
    
    For Each ws In Worksheets
        For Each cell In ws.UsedRange.Cells
            If cell.Rows.Count = 1 Then
                If cell.MergeCells And cell.WrapText And IsTopLeftCell(cell) Then
                    FixAutoFitForCell (cell)
                End If
            Else
                MsgBox ("Not Supported:" + cell.Address)
            End If
        Next cell
    Next ws
End Function

Private Function FixAutoFitForCell(cell As Range)
'    Dim totalWidth As Single
'    Dim oldHeight As Single
'    Dim oldWidth As Single
'    Dim cellCount As Integer
'    Dim ac As Range
    
'    cellCount = cell.MergeArea.Columns.Count
    
'    For Each ac In cell.MergeArea.Cells
'        totalWidth = totalWidth + ac.Width
'    Next ac
    
'    cell.WrapText = False
'    cell.MergeArea.UnMerge
'    oldWidth = cell.Width
'    cell.Width = totalWidth
'    cell.WrapText = True
'    cell.Row.AutoFit

'    If cell.Height < oldHeight Then
'        cell.Height = oldHeight
'    End If
    
'    cell.Width = oldWidth
End Function

Private Function IsTopLeftCell(cell As Range)
    If cell.Address = cell.MergeArea.Cells(1, 1).Address Then
        IsTopLeftCell = True
    Else
        IsTopLeftCell = False
    End If
End Function

15-я строка, вызов FixAutoFitForCell.

Ошибка та что и была.

Naghual

Дата 14.7.2009, 15:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49

А... Как насчет того, что это Функция? Как насчет Скобок? Что с возвращаемым значением?

--------------------

Я желаю всем Счастья!

SoulKeeper

Дата 14.7.2009, 15:57 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 375
Регистрация: 14.1.2007
Где: Ukraine, Lviv.

Репутация: нет
Всего: 15

Мой опыт VBA = 3 часа, дедлайн завтра smile

Судя по java, php, c++, c# и другим - функция не обязательно должна возвращать значение. Или в VBA должна?

___
Хотя нет, не должна. FixAutoFit ничего не возвращает, но вызывается...
Функция с аналогчной сигнатурой

Код


Private Function IsTopLeftCell(cell As Range)

вызывется без проблем.

Как-то оно странно, не по человечески smile

Это сообщение отредактировал(а) SoulKeeper - 14.7.2009, 16:01

Naghual

Дата 15.7.2009, 22:57 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49

Как-то странно, но у меня Ваш код не вызывает ошибок.

--------------------

Я желаю всем Счастья!

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Программирование, связанное с MS Office \| Следующая тема »