Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 25 of 25

Thread: VB6 Stop that command click

  1. #21
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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]

  2. #22
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    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

  3. #23
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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]

  4. #24
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,184
    Location
    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]

  5. #25
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    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? 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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •