Query Tables and Screen Flickers

[ClimoC]

Ahoy

No, this is not about ScreenUpdating = True/False

Neither is it because you've turned SU off, and then used 'Select' or 'DoEvents' etc in your code.

When running an update for a QueryTable (once a second), 3 'buttons' (activeX image controls with code behind them) flicker - though I see no reference to selecting and/or screenupdating in my code

Is this purely something about refreshing a querytable that I can't fix?

Is there a subclass or API call I can intercept to stop drawing the images alone?

Much much googling on this has returned fruitless

My code:

Public Sub ActivateConn()

    Dim strFilespec As String
    Dim strConn As String
    Dim sqlStr As String

    Set RecSet = New ADODB.Recordset
    Set cnImportConn = New ADODB.Connection
    strFilespec = "\\FilepathServeretc\Filename.accdb"
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilespec & ";Persist Security Info=False;"

    strsql = "SELECT * FROM [work]"
    Debug.Print strsql
    
On Error Resume Next
    With cnImportConn
                    .CursorLocation = adUseClient
                    .Open strConn
                    .CommandTimeout = 0
                    Set RecSet = .Execute(strsql)
    End With
If Err.Number <> 0 Then
        Application.StatusBar = "Connection to Desktop Failed"
End If
On Error GoTo 0
End Sub

Public Sub AddNewRecord()

     strsql = "INSERT INTO [work] (txdate, channel, programme, available, assigned, startdate, duedate, description, tape, status) " & _
     "VALUES (#" & txdate & "#, '" & channel & "', '" & programme & "', " & available & ", '" & assigned & "', #" & startdate & "#, #" & _
     duedate & "#, '" & description & "', '" & tape & "', '" & status & "')"

cnImportConn.Execute (strsql)

End Sub

Public Sub ReadRec()

    ThisWorkbook.Sheets("Sheet2").Range("A1").CopyFromRecordset RecSet
    
End Sub

Public Function WriteRec(ByVal ID As Long, Field As String, Val As Variant)
If cnImportConn Is Nothing Then Run "ActivateConn"
If Field = "ID" Then Exit Function
Select Case True
            Case Field Like "*date"
                    Val = "#" & Val & "#"
            Case Field Like "*vail*"
                    Val = CBool(Val)
            Case Else
                    Val = "'" & Val & "'"
End Select
            
     strsql = "UPDATE [work] SET " & Field & " = " & Val & " WHERE ID = " & ID
     
cnImportConn.Execute (strsql)

End Function

Public Function Refreshing()
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
On Error Resume Next
'If cnImportConn Is Nothing Then Run "ActivateConn"
ThisWorkbook.Sheets("WorkFlow").ListObjects(1).QueryTable.Refresh BackgroundQuery:=False
Err.Clear
On Error GoTo 0
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
Application.EnableCancelKey = xlInterrupt
End Function

Sub startcatchdelete()
Application.OnKey "{DELETE}", "CaughtDelete"
End Sub

Sub stopcatchdelete()
Application.OnKey "{DELETE}"
End Sub

Public Sub CaughtDelete()
If cnImportConn Is Nothing Then Run "ActivateConn"
If Selection.Address = ActiveCell.EntireRow.Address Then
            ID = Cells(ActiveCell.Row, 2).Value
            strsql = "DELETE * FROM [work] WHERE ID = " & ID
            cnImportConn.Execute (strsql)
Else
            Selection.ClearContents
End If
End Sub

Sub QueryTableRefresh()
Dim qt As QueryTable
vSetTime = Now + TimeValue("00:00:01")
 
Application.OnTime vSetTime, "QueryTableRefresh"

Refreshing

End Sub

Sub EndRefresh()
On Error Resume Next
Application.OnTime EarliestTime:=vSetTime, Procedure:="QueryTableRefresh", Schedule:=False
On Error GoTo 0
End Sub

In short, there's no REASON why I couldn't just use the selection_change event to fire the same macros as the buttons but... well... it doesn't look anywhere near as good (I have a thing about making VB apps look as good as the code behind them is smart)

 

[RoryA]

why use Excel at all then?