Мы используем макрос для удаления строк данных из нашей базы данных Excel, которые были помечены как завершенные / выполненные. это кодировка ...

Private Sub cmdRemove_Click()
    Dim varResult As VbMsgBoxResult
    varResult = MsgBox("Are you sure you want to remove all completed tasks? Ensure that the database has been backed up before running this operation.", vbYesNo)
    If varResult = vbYes Then
        Database.RemoveCompletedRequests
    End If
    MsgBox "Operation completed.", vbInformation
End Sub

другая часть этого кода, на которую ссылаются:...

Public Sub RemoveCompletedRequests()
    Dim i, j As Integer
    Dim varRequests() As Request
    varRequests = GetAllRequests

    For i = LBound(varRequests) To UBound(varRequests)
        If varRequests(i).Type = eDrafting Or varRequests(i).Type = eProject Then
            Dim varTasks() As Task
            Dim blnDelete As Boolean
            blnDelete = True
            varTasks = GetAllTasksByRequestNumber(varRequests(i).RequestNumber)
            For j = LBound(varTasks) To UBound(varTasks)
                If HasCompletedStatus(varTasks(j)) = False Then
                    blnDelete = False
                End If
            Next j
            If blnDelete Then
                For j = LBound(varTasks) To UBound(varTasks)
                    DeleteTask varTasks(j)
                Next j
                DeleteRequest varRequests(i)
            End If
        Else
            Dim varTask As Task
            varTask = GetPrimaryTaskByRequestNumber(varRequests(i).RequestNumber)
            If HasCompletedStatus(varTask) Then
                DeleteTask varTask
                DeleteRequest varRequests(i)
            End If
        End If
    Next i
End Sub

vb указывает, что макрос зависает в строке: database.removecompletedrequests в первом разделе кода, который я предоставил выше.

Что мне нужно сделать, чтобы решить эту проблему?

Модуль базы данных существует с функцией "RemoveCompletedRequests" ... кодирование для этого ...

Public Sub RemoveCompletedRequests()
Dim i, j As Integer
Dim varRequests() As Request
varRequests = GetAllRequests

For i = LBound(varRequests) To UBound(varRequests)
    If varRequests(i).Type = eDrafting Or varRequests(i).Type = eProject Then
        Dim varTasks() As Task
        Dim blnDelete As Boolean
        blnDelete = True
        varTasks = GetAllTasksByRequestNumber(varRequests(i).RequestNumber)
        For j = LBound(varTasks) To UBound(varTasks)
            If HasCompletedStatus(varTasks(j)) = False Then
                blnDelete = False
            End If
        Next j
        If blnDelete Then
            For j = LBound(varTasks) To UBound(varTasks)
                DeleteTask varTasks(j)
            Next j
            DeleteRequest varRequests(i)
        End If
    Else
        Dim varTask As Task
        varTask = GetPrimaryTaskByRequestNumber(varRequests(i).RequestNumber)
        If HasCompletedStatus(varTask) Then
            DeleteTask varTask
            DeleteRequest varRequests(i)
        End If
    End If
Next i
End Sub

Private Sub DeleteRequestRow(pintRow As Integer)
Dim intRow As Integer
Dim ws As Worksheet
Set ws = Sheets.Item(mstrRequestsTable)
intRow = pintRow

While ws.Cells(intRow + 1, 1) <> ""
    ShiftRow mstrRequestsTable, intRow + 1, intRow, mintColumnsInRequestsTable
    intRow = intRow + 1
Wend
End Sub

Private Sub DeleteRequest(pvarRequest As Request)
    DeleteRequestRow FindRequestRowByRequestNumber(pvarRequest.RequestNumber)
End Sub

Private Sub DeleteTaskRow(pintRow As Integer)
Dim intRow As Integer
Dim ws As Worksheet
Set ws = Sheets.Item(mstrTasksTable)
intRow = pintRow

While ws.Cells(intRow + 1, 1) <> ""
    ShiftRow mstrTasksTable, intRow + 1, intRow, mintColumnsInTasksTable
    intRow = intRow + 1
Wend
End Sub

' Deletes the task as well as removing all merge links to this task.
Private Sub DeleteTask(pvarTask As Task)
    ClearMergesForReferenceNumber pvarTask.ReferenceNumber
    DeleteTaskRow FindTaskRowByReferenceNumber(pvarTask.ReferenceNumber)
End Sub

' Shifts a row of data to a different row, clearing the old row
Private Sub ShiftRow(pstrTable As String, pintSourceRow As Integer, pintTargetRow As Integer, pintNumberOfColumns As Integer)
Dim i As Integer
Dim ws As Worksheet
Set ws = Sheets.Item(pstrTable)

If pintSourceRow <> pintTargetRow Then
    For i = 1 To pintNumberOfColumns
        ws.Cells(pintTargetRow, i) = ws.Cells(pintSourceRow, i)
        ws.Cells(pintSourceRow, i) = ""
    Next i
End If
End Sub

Private Sub ClearMergesForReferenceNumber(pstrReferenceNumber As String)
Dim i As Integer
Dim varTasks() As Task
varTasks = GetAllTasks

For i = LBound(varTasks) To UBound(varTasks)
    If varTasks(i).MergedWithReferenceNumber = pstrReferenceNumber Then
        varTasks(i).MergedWithReferenceNumber = ""
    End If
Next i
End Sub

1 ответ1

0

Я не верю, что вам нужно ссылаться на модуль, который содержит макрос. Чтобы быть понятным, удалите Database. из Database.RemoveCompletedRequests . Если вы настаиваете на этом, вам следует избегать именования модулей, которые могут быть перепутаны с объектами. То есть вы можете вместо этого вызвать ваш модуль modDatabase .

Некоторые другие указатели: Все переменные должны быть объявлены /Dim'd в начале модуля. Например , в RemoveCompletedRequests вы объявляете переменные каждый раз, когда просматриваете цикл For /Next. Переместите их в начало вашей сабы.

Наконец, когда вы пишете что-то вроде Dim i, j As Integer , i объявляется как вариант, а не как целое число. Вам необходимо четко указать эти объявления: Dim i as Integer, j As Integer .

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .