я не понимаю, чего мне не хватает в моем коде (ограниченное знание VBA) - PullRequest
Новая
       6

я не понимаю, чего мне не хватает в моем коде (ограниченное знание VBA)

0 голосов
/ 17 октября 2019

При удалении записи из моей пользовательской формы vba я получил ошибку:

"Произошла ошибка: ошибка объекта номер 91 или переменная блока не установлена"

С моим ограниченным знанием vba, я изо всех сил пытаюсь понять, в чем проблема, пожалуйста, кто-нибудь может посоветовать?

Мои данные записываются в журнал истории (sheet3), но затем отображается сообщение об ошибке.

спасибо 

  Private Sub cmdDelete_Click()


    'declare the variables
    Dim findvalue As Range 'done
    Dim cDelete As VbMsgBoxResult 'done
    Dim cNum As Integer 'done
    Dim DataSH As Worksheet 'done
    Dim Addme As Range 'done
    Dim HistorySH As Worksheet 'done
    Dim x As Integer

    'error statement
    On Error GoTo errHandler:
    'hold in memory and stop screen flicker
    Application.ScreenUpdating = False
    Set DataSH = Sheet1
    Set HistorySH = Sheet3
    Set Addme = HistorySH.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

    'check for values
    If txtID.Value = "" Or txtLocation.Value = "" Then
    MsgBox "There Is No Data To Delete"
    Exit Sub
    End If
    'give the user a chance to change their mind
    cDelete = MsgBox("Are You Sure That you Want To Delete This Pallet", vbYesNo + vbDefaultButton2, "Are you sure?")
    If cDelete = vbYes Then
    'find the row
    Set findvalue = DataSH.Range("B:B").Find(What:=Me.txtID.Value, _
    LookIn:=xlValues, LookAt:=xlWhole)


    'update the values in the HistoryLog

    With HistorySH
    'add the unique reference ID then all other values
    Addme.Offset(0, -1) = txtID.Value
    Addme.Offset(0, 0).Value = "Deleted"
    Addme.Offset(0, 1).Value = Me.txtSize
    Addme.Offset(0, 2).Value = Me.txtLocation
    Addme.Offset(0, 3).Value = Me.cboType
    Addme.Offset(0, 4).Value = Me.txtDescription
    Addme.Offset(0, 5).Value = Me.txtContact
    Addme.Offset(0, 6).Value = Me.txtDate.Value
    Addme.Offset(0, 7).Value = Format(Now(), "hh:mm:")
    Addme.Offset(0, 8).Value = UserName()

    End With

    'delete the entire row
    findvalue.EntireRow.Delete
    End If
    'clear the controls
    cNum = 7
    For x = 1 To cNum
    Me.Controls("txt" & x).Value = ""
    Next
    'unprotect all sheets for the advanced filter
    'Unprotect_All
    'filter the data
    DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheet6.Range("$L$1:$L$2"), CopyToRange:=Sheet6.Range("$N$1:$w$1"), _
    Unique:=False
    'if no data exists then clear the rowsource
    If Sheet6.Range("N2").Value = "" Then
    lstData.RowSource = ""
    Else
    'add the filtered data to the rowsource
    lstData.RowSource = Sheet6.Range("outdata").Address(external:=True)
    End If

    'sort the database by "Location"
    DataSH.Select
    With DataSH
    .Range("DataTable").Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess
    End With

    'sort the HistoryLog by "ID"
    HistorySH.Select
    With HistorySH
    .Range("DataTable2").Sort Key1:=Range("B9"), Order1:=xlAscending, Header:=xlGuess

    End With
    'Protect all sheets
    'Protect_All
    'return to sheet
    Sheet2.Select
    'error block
    On Error GoTo 0
    Exit Sub
    errHandler:
    'Protect all sheets if error occurs
    'Protect_All
    'show error information in a messagebox
    MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " & _
    Err.Number & vbCrLf & Err.Description & vbCrLf & "Please notify the administrator"



End Sub
...