Как устранить функцию RunTime Ошибка в VBA - PullRequest
0 голосов
/ 10 июля 2019

Я получаю ошибку времени выполнения при вызове моей функции из подпрограммы. Выделенная строка - Do Until IsEmpty(.Cells(x, c)).

Сгенерированная ошибка RunTime Error 1004 Application - defined or object - defined error

КОД

Private LastRow As Long
Private wb As Workbook: Set wb = ThisWorkbook
Private ws As Worksheet: Set ws = wb.Sheets("clientmenu")
Private CellRow As Integer    ' create a variable to hold the cell row
LastRow = Sheet3.Range("a" & Rows.count).End(xlUp).Row + 1
CellRow = ActiveCell.Row

Private x As Long, c As Long, s As Long
Const CONTACT_START As Long = 13 ' Column E
Const COL_PER_CONTACT As Long = 2 ' Columns per Contact
Const CONTACT_DROPS As Long = 14 'Column G
Const COL_PER_DROPS As Long = 2 'Columns per Contact


s = CONTACT_START
c = CONTACT_START
x = Me.lblRow
Z = LastRow

Public Function callDate() As Date
With ThisWorkbook.Sheets("clientmenu")
        ' Look for first empty one
        Do Until IsEmpty(.Cells(x, c))
            c = c + COL_PER_CONTACT
        Loop
        .Cells(x, c) = addnewClient.contact.value
        '.Cells(x, c + 1) = Me.cdates1.Value
    End With
End Function

1 Ответ

0 голосов
/ 10 июля 2019

Вот мое решение

Перемещая переменные внутри функции, я смог получить ожидаемые результаты без ошибок во время выполнения.

Private LastRow As Long
Private CellRow As Integer    ' create a variable to hold the cell row
Private x As Long, c As Long, s As Long, z As Long
Const CONTACT_START As Long = 13 ' Column E
Const COL_PER_CONTACT As Long = 2 ' Columns per Contact
Const CONTACT_DROPS As Long = 14 'Column G
Const COL_PER_DROPS As Long = 2 'Columns per Contact





Public Function callDate() As Date
s = CONTACT_START
c = CONTACT_START
x = CLng(addnewClient.lblRow.Caption)
z = LastRow
LastRow = Sheet3.Range("a" & Rows.count).End(xlUp).Row + 1
CellRow = ActiveCell.Row
With ThisWorkbook.Sheets("clientmenu")
        c = CONTACT_START
        x = CLng(addnewClient.lblRow.Caption)
        ' Look for first empty one
        Do Until IsEmpty(.Cells(x, c))
            c = c + COL_PER_CONTACT
        Loop
        .Cells(x, c) = addnewClient.contact.value
        '.Cells(x, c + 1) = Me.cdates1.Value
    End With
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...