-
Hey Dave,
The only way I could duplicate your problem is by:
[VBA]
Private Sub Form_Click()
Dim mI As Integer
For mI = 1 To 30
Command1_Click
Next
End Sub
[/VBA]
But each click will process due to it will not iterate in the loop until the command1_click is finished.
The below is the timer. I removed the enabled and the color checks.
[VBA]
Private objExcel As Object
Private objWorkBook As Object
Private objWorksheet As Object
Private Clickcnt As Integer
Private HowLong As Long
Private Sub Command1_Click()
On Error GoTo ErFix
Clickcnt = Clickcnt + 1
If Abs(Timer - HowLong) > 5 Then ' wait for 5 seconds before allowing a new "RUN"
HowLong = Timer
Call InsertFormula
Form1.Hide
StrtXl "C:\clicktest.xls"
objExcel.Run "showuserform1"
ClsSvXl
Call RemoveFormula
Form1.Show
End If
MsgBox Clickcnt 'display the number of times this control has been clicked
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
ClsSvXl
Call RemoveFormula
Form1.Show
End Sub
Sub InsertFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(4)"
ClsSvXl
End Sub
Sub RemoveFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = ""
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(5)"
objExcel.DisplayAlerts = False
ClsSvXl
End Sub
Sub StrtXl(iPthNM As String)
On Error Resume Next
Set objExcel = GetObject("EXCEL.APPLICATION")
If Err.Number <> 0 Then
Err.Clear
Set objExcel = CreateObject("EXCEL.APPLICATION")
End If
objExcel.Visible = True
objExcel.DisplayAlerts = False
If OpenWorkBook(iPthNM) Then
'this is assuming that the sheet exist
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
Else
Set objExcel = Nothing
End If
On Error GoTo 0
End Sub
Function OpenWorkBook(iPthNM As String) As Boolean
Dim mI As Long
If objExcel.Workbooks.Count > 0 Then
For mI = 0 To objExcel.Workbooks.Count
If objExcel.Workbooks(mI).Name = "clicktest.xls" Then
Set objWorkBook = objExcel.Workbooks(mI)
End If
Next
End If
On Error Resume Next
If objWorkBook Is Nothing Then Set objWorkBook = objExcel.Workbooks.Open(iPthNM)
If Err.Number <> 0 Then
MsgBox Err.Description
Err.Clear
Else
OpenWorkBook = True
End If
End Function
Function ClsSvXl() As Boolean
On Error Resume Next
objWorkBook.Save
objWorkBook.Close
objExcel.DisplayAlerts = True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
ClsSvXl = True
Err.Clear
On Error GoTo 0
End Function
[/VBA]
-
Tommy if you do not make the XL application visible (as above somewhere) and comment out the message box...
[VBA]
' MsgBox Clickcnt 'display the number of times this control has been clicked
[/VBA]
You should be able to replicate my problems. The code you posted works perfect until I made these changes... they best represent the actual conditions. The clickcnt is just being used to add some info re. this error. Anyways, I sure appreciate your help... I'm learning lots but if you want to throw in the towel, that's no problem. This hasn't been a fatal error so far, just an annoyance that I would like to resolve. Again, thanks. Dave
-
Dave I commented the Visible. I wrote the number of times the button was clicked to the immediate window. I was able to replicate your problem. I changed the timer to 20 seconds. I threw away 15 clicks. With the posted code it would trhow away about 3-4 clicks per second. The fact that I clicked 40+ made the button macro run several times. Now the question is...... how many clicks do you want to throw away and how long in between allowable clicks do want to wait?
Other than changing the wait period to 20 seconds and writing to the immediate window instead of a msgbox and of course the excel.visible that I didn't post, this is the same code.
The modified code:
[VBA]
Private Sub Command1_Click()
On Error GoTo ErFix
Clickcnt = Clickcnt + 1
If Abs(Timer - HowLong) > 20 Then ' wait for 20 seconds before allowing a new "RUN"
HowLong = Timer
Debug.Print "Running......"
Call InsertFormula
Form1.Hide
StrtXl "C:\clicktest.xls"
objExcel.Run "showuserform1"
ClsSvXl
Call RemoveFormula
Form1.Show
End If
Debug.Print Clickcnt
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
ClsSvXl
Call RemoveFormula
Form1.Show
End Sub
[/VBA]
-
Let me know what speed you PC is and I'll try to replicate if this doesn't work.
[VBA]
Private objExcel As Object
Private objWorkBook As Object
Private objWorksheet As Object
Private Clickcnt As Integer
Private WorkIt As Boolean
Private Sub Command1_Click()
'Dim Clickcnt As Integer
If WorkIt Then
WorkIt = False
Call InsertFormula
Form1.Hide
StrtXl "C:\clicktest.xls"
objExcel.Run "showuserform1"
ClsSvXl
Call RemoveFormula
End If
Form1.Show
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
ClsSvXl
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Command1.Enabled = True '-Added
Form1.Show
End Sub
Sub InsertFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(4)"
ClsSvXl
End Sub
Sub RemoveFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = ""
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(5)"
objExcel.DisplayAlerts = False
ClsSvXl
End Sub
Sub StrtXl(iPthNM As String)
On Error Resume Next
Set objExcel = GetObject("EXCEL.APPLICATION")
If Err.Number <> 0 Then
Err.Clear
Set objExcel = CreateObject("EXCEL.APPLICATION")
End If
objExcel.Visible = True
objExcel.DisplayAlerts = False
If OpenWorkBook(iPthNM) Then
'this is assuming that the sheet exist
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
Else
Set objExcel = Nothing
End If
On Error GoTo 0
End Sub
Function OpenWorkBook(iPthNM As String) As Boolean
Dim mI As Long
If objExcel.Workbooks.Count > 0 Then
For mI = 0 To objExcel.Workbooks.Count
If objExcel.Workbooks(mI).Name = "clicktest.xls" Then
Set objWorkBook = objExcel.Workbooks(mI)
End If
Next
End If
On Error Resume Next
If objWorkBook Is Nothing Then Set objWorkBook = objExcel.Workbooks.Open(iPthNM)
If Err.Number <> 0 Then
MsgBox Err.Description
Err.Clear
Else
OpenWorkBook = True
End If
End Function
Function ClsSvXl() As Boolean
On Error Resume Next
objWorkBook.Save
objWorkBook.Close
objExcel.DisplayAlerts = True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
ClsSvXl = True
Err.Clear
On Error GoTo 0
End Function
Private Sub Form_Paint()
WorkIt = True
End Sub
[/VBA]
-
That's probably the best so far... less code, no waiting, and you can click multiple times on the VB6 form without doing the error cycling phantom auto click thing that I started with... but it still needs the 3 finger salute if you happen to click between the VB6 form hiding and the XL form showing. That's probably a more serious problem than I started with as it used to eventually clear the error(s). Maybe a big sign on the VB6 form... "CLICK IT ONCE STUPID" maybe the answer? :rotlaugh: Thanks Tommy. Dave
ps. Tommy's code posted above this thread was in response to a PM. The previous code posted had worked very well but clicking between the VB6 form hiding and the XL form showing required the task manager's help.
pps. specs say 1.06 GH 256mb of ram.