runtime error...

J

Jim C.

i have the following code that is producing an error...
code works fine seperately, but when linked together they
produce...


run-time error '-2147417848(80010108)':

Automation Error
The object invoked has disconnected from its clients

***********************************************************
Sub RClick1()
Set mybar = CommandBars.Add(Name:="RClick",
Position:=msoBarPopup, Temporary:=True)
Set Oldmybar1 = mybar.Controls.Add(Type:=msoControlButton)
Set OldmyBar2 = mybar.Controls.Add(Type:=msoControlButton)
Set OldmyBar3 = mybar.Controls.Add(Type:=msoControlButton)
With Oldmybar1
.Caption = "Delete"
.OnAction = "mDelete"
End With

End Sub


Public Sub mDelete()
Dim bDelete() As Boolean, i As Long, nDeletes As Long
With Application
..ScreenUpdating = False
..Calculation = xlCalculationManual
End With
UserForm1.lbTakeoff.Visible = False
UserForm1.cbCancel.Enabled = False
UserForm1.cbList.Enabled = True
UserForm1.cbEdit.Enabled = True
If UserForm1.lbTakeoff.ListCount = 1 Then
ReDim bDelete(UserForm1.lbTakeoff.ListCount - 1) As Boolean
For i = 0 To UserForm1.lbTakeoff.ListCount - 1
bDelete(i) = UserForm1.lbTakeoff.Selected(i)
Next i
nDeletes = 0
For i = 0 To UBound(bDelete)
If bDelete(i) Then
ThisWorkbook.Worksheets(1).Rows(i + 2 - nDeletes).Delete
nDeletes = nDeletes + 1
End If
Next i
UserForm1.cbDelete.Enabled = False
Sheets("sheet2").Range("a1:c1").Delete
With Application
..ScreenUpdating = True
..Calculation = xlCalculationAutomatic
End With

Else
ReDim bDelete(UserForm1.lbTakeoff.ListCount - 1) As Boolean
For i = 0 To UserForm1.lbTakeoff.ListCount - 1
bDelete(i) = UserForm1.lbTakeoff.Selected(i)
Next i
nDeletes = 0
For i = 0 To UBound(bDelete)
If bDelete(i) Then
ThisWorkbook.Worksheets(1).Rows(i + 2 - nDeletes).Delete
nDeletes = nDeletes + 1
End If
Next i
With Application
..ScreenUpdating = True
..Calculation = xlCalculationAutomatic
End With
End If
UserForm1.lbTakeoff.MultiSelect = fmMultiSelectSingle
UserForm1.mAuto
UserForm1.lbTakeoff.ListIndex = 0
UserForm1.cbCriteria.Enabled = True

End Sub
***********************************************************

Any suggestions? I'm Lost... lol
 
J

jim c.

this is the event that shows commandbar... error happens
when line "end sub" is executed...


***********************************************************
Private Sub lbTakeoff_MouseDown(ByVal Button As Integer,
ByVal Shift As Integer, ByVal X As Single, ByVal Y As
Single)


If Button = 2 Then
CommandBars("rclick").ShowPopup
End If


End Sub
***********************************************************
 
J

jim c.

moved code from mousedown to mouseup and everything is
fine... i dont know why this works, but i'll take it... lol
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top