Using Colored Labels As Process Indicators

Rood67 · August 7th, 2007, 05:24 PM

Hello,
I am at my wits end trying to figure out why Access 2007 VBA is doing what it is doing. Below is a complete copy of the code behind a command button on a form. The intended purpose of the form and code is to create tables based on data selected from AS400 database files.

**NOTE** The SQL works fine, this is not my problem **NOTE**

My problem is however, that I have labels on the form that I want to change the caption and color for as each SQL process is executed. What I get is the initial stage from the form opening, and the final stage when the code exits. Nothing in between changes. The SQL runs, the tables are created, but no labels are updated.

After looking at this code, can someone please explain to me what VBA is doing and how I can get it to do what I want.

**2nd NOTE** The huge For / Next loops was a failed attempt to slow execution down in case that was the problem. It didn't help **2nd NOTE**

____________________
Private Sub cmdGenerateTables_Click()
On Error GoTo Err_cmdGenerateTables_Click

Dim Q, strSQL As String
Dim c, x As Double
Dim lngGreen, lngRed As Long

Q = Chr$(34)
lngGreen = RGB(0, 255, 0)
lngRed = RGB(255, 0, 0)

'This is for the querry Make OEPDORD
'strSQL = "SELECT RTrim([ORDN]) AS OrdNr, RTrim([ORDLN]) AS OrdLnNr, RTrim([IMCD]) AS ItemCode, " _
' & "DATA2000_OEPDORD.CRQOR AS CustOrderQty, DATA2000_OEPDORD.CRUSP AS Price " _
' & "INTO tbl_oepdord " _
' & "FROM DATA2000_OEPDORD " _
' & "WHERE (((RTrim([ORDN]))>146352));"

'This is for the querry Make CUPMMOF
strSQL = "SELECT RTrim([MOFICD]) AS ItemCode, RTrim([MOFMNM]) AS Format, RTrim([MOFTLE]) AS Title, " _
 & "Right(RTrim([MOFFRM]),2) AS Y, DATA2000_CUPMMOF.MOFSTD AS StreetDate, RTrim([MOFFRM]) AS Form, " _
 & "RTrim([MOFBOX]) AS Box, DATA2000_CUPMMOF.MOFGNR AS Genre, DATA2000_CUPMMOF.MOFSDO AS Studio, " _
 & "DATA2000_CUPMMOF.MOFRTG AS Rating, DATA2000_CUPMMOF.MOFRNK AS Rank, DATA2000_CUPMMOF.MOFTHM AS Theme, " _
 & "DATA2000_CUPMMOF.MOFQOO AS QtyOnOrder, RTrim([MOFTYP]) AS Type " _
 & "INTO tbl_cupmmof " _
 & "FROM DATA2000_CUPMMOF " _
 & "WHERE (((RTrim([MOFICD])) Like " & Q & LD & Chr$(42) & Q & ") AND ((DATA2000_CUPMMOF.MOFSTD)>#12/31/2006#));"

Me.lblOEPDORDs.Caption = "Runing"
Me.lblOEPDORDs.BackColor = lngGreen

c = 0
For c = 1 To 50000: Next c

' Dim stDocName As String

 DoCmd.SetWarnings False
 DoCmd.RunSQL strSQL
' stDocName = "01a-qry_MakeOEPDORD"
' DoCmd.OpenQuery stDocName, acNormal, acEdit
 DoCmd.SetWarnings True

c = 0
For c = 1 To 50000: Next c

Me.lblOEPDORDs.Caption = "Done"
Me.lblOEPDORDs.BackColor = lngRed

c = 0
For c = 1 To 50000: Next c

'This is for the querry Make ICLMMSTA
strSQL = "SELECT RTrim(DATA2000_ICLMMSTA!IMCD) AS ItemCode, RTrim([IMMPNO]) AS WaxCode, " _
 & "RTrim([IMCDSK]) AS UPC, DATA2000_ICLMMSTA.ITSP AS Price, RTrim([IMDSC1]) AS Title, " _
 & "RTrim([IEDESC]) AS ExtendDesc, Mid(DATA2000_ICLMMSTA!IMCD,3,1) AS Y " _
 & "INTO tbl_iclmmsta " _
 & "FROM DATA2000_ICLMMSTA LEFT JOIN DATA2000_ICPDEXD ON DATA2000_ICLMMSTA.IMCD = DATA2000_ICPDEXD.IMCD " _
 & "WHERE (((Mid([DATA2000_ICLMMSTA]![IMCD],3,1))>" & Q & 6 & Q & "));"

c = 0
For c = 1 To 50000: Next c

Me.lblICLMMSTAs.Caption = "Runing"
Me.lblICLMMSTAs.BackColor = lngGreen

c = 0
For c = 1 To 50000: Next c

' Dim stDocName As String

 DoCmd.SetWarnings False
 DoCmd.RunSQL strSQL
' stDocName = "01a-qry_MakeOEPDORD"
' DoCmd.OpenQuery stDocName, acNormal, acEdit
 DoCmd.SetWarnings True

c = 0
For c = 1 To 50000: Next c

Me.lblICLMMSTAs.Caption = "Done"
Me.lblICLMMSTAs.BackColor = lngRed

c = 0
For c = 1 To 5000: Next c

Exit_cmdGenerateTables_Click:
 Exit Sub

Err_cmdGenerateTables_Click:
 MsgBox Err.Description
 Resume Exit_cmdGenerateTables_Click

End Sub

Private Sub Form_Load()

Dim lngGreen, lngRed, lngWhite As Long

lngGreen = RGB(0, 255, 0)
lngRed = RGB(255, 0, 0)
lngWhite = RGB(255, 255, 255)

Me.lblOEPDORDs.BackColor = lngWhite
Me.lblICLMMSTAs.BackColor = lngWhite

Me.lblOEPDORDs.Caption = "Waiting"
Me.lblICLMMSTAs.Caption = "Waiting"

End Sub
____________________

Thanks in advance,
Scott

Rood67

mmcdonal · August 8th, 2007, 09:17 AM

That's not going to work since the sub runs, and then any label and etc color changes won't happen until after the sub exits and the form is repainted. Is that what is happening now?

I would suggest breaking this into modules and then having the first sub call a module, then paint the label from that module, and then have that sub/module call the next, and paint the screen from that sub/module, etc, on down the line. That way subs are exiting all down the line instead of just once.

Did that help?

mmcdonal

Rood67 · August 8th, 2007, 02:09 PM

Thanks for the suggestion. I'm going to go code that now and see if that works.

I hope I'm understanding exactly what you stated. As one sub/mod calls another, the exiting of the new sub/mod will force the form to update. Or, have I misunderstood, in which case I'll go ahead and ask now as I may not readily find how to do it... is there a VBA command to force the form to repaint?

I'm going to code, but I'll check back for a reply regardless.

Again, thanks in advance,
Scott

Rood67

mmcdonal · August 9th, 2007, 06:38 AM

I am sure there must be a repaint... I can't find it.

Anyway, I don't think that would happen until after the sub ends anyway.

It is a good idea to modularize sections of code anyway so that it becomes easier to modify a section at a time if things change. Sort of an SOA approach.

mmcdonal

Rood67 · August 9th, 2007, 09:21 AM

Hello again,

Here's the code that I have so far. This is a re-write of the original to convert it to sub calls. However, this results in the same issue. I open the form and get my three white Waiting labels. The SQL generates the tables, and I get three red Done labels. The only time I ever got the desired green Running label what when the VBA stopped due to an error of having too many ( in one of my strings.

If you are looking at this code and asking yourself why did I make the sub's public; it is because that it what I found on a website when I had a different error.

I truly hope that this winds up being an easy fix. I don't understand why this is proving to be so difficult.
____________________
Public lngGreen As Long
Public lngRed As Long
Public lngWhite As Long
Public Q As String

Private Sub cmdGenerateTables_Click()
On Error GoTo Err_cmdGenerateTables_Click

' call makeOEPDORD
 Call makeCUPMMOF
 Call makeICLMMSTA

Exit_cmdGenerateTables_Click:
 Exit Sub

Err_cmdGenerateTables_Click:
 MsgBox Err.Description
 Resume Exit_cmdGenerateTables_Click
End Sub
Private Sub Form_Load()

 lngGreen = RGB(0, 255, 0)
 lngRed = RGB(255, 0, 0)
 lngWhite = RGB(255, 255, 255)
 Q = Chr$(34)

 Me.lblOEPDORD.BackColor = lngWhite
 Me.lblICLMMSTA.BackColor = lngWhite
 Me.lblCUPMMOF.BackColor = lngWhite

 Me.lblOEPDORD.Caption = "Waiting"
 Me.lblICLMMSTA.Caption = "Waiting"
 Me.lblCUPMMOF.Caption = "Waiting"
End Sub
Public Sub makeOEPDORD()
 Dim strSQL As String
' This is for the querry Make OEPDORD
 strSQL = "SELECT RTrim([ORDN]) AS OrdNr, RTrim([ORDLN]) AS OrdLnNr, RTrim([IMCD]) AS ItemCode, " _
 & "DATA2000_OEPDORD.CRQOR AS CustOrderQty, DATA2000_OEPDORD.CRUSP AS Price " _
 & "INTO tbl_oepdord " _
 & "FROM DATA2000_OEPDORD " _
 & "WHERE (((RTrim([ORDN]))>146352));"
 Me.lblOEPDORD.Caption = "Runing"
 Me.lblOEPDORD.BackColor = lngGreen

 Call SQL(strSQL)
 Call updateOEPDORD
End Sub
Public Sub updateOEPDORD()
 Me.lblOEPDORD.Caption = "Done"
 Me.lblOEPDORD.BackColor = lngRed
 Call DC
End Sub
Public Sub DC()
 Dim c As Long
 c = 0
 For c = 1 To 2000: Next c
End Sub
Public Sub SQL(strSQL As String)
 DoCmd.SetWarnings False
 DoCmd.RunSQL strSQL
 DoCmd.SetWarnings True
End Sub
Public Sub makeCUPMMOF()
 'This is for the querry Make CUPMMOF
 Dim strSQL As String
 strSQL = "SELECT RTrim([MOFICD]) AS ItemCode, RTrim([MOFMNM]) AS Format, RTrim([MOFTLE]) AS Title, " _
 & "Right(RTrim([MOFFRM]),2) AS Y, DATA2000_CUPMMOF.MOFSTD AS StreetDate, RTrim([MOFFRM]) AS Form, " _
 & "RTrim([MOFBOX]) AS Box, DATA2000_CUPMMOF.MOFGNR AS Genre, DATA2000_CUPMMOF.MOFSDO AS Studio, " _
 & "DATA2000_CUPMMOF.MOFRTG AS Rating, DATA2000_CUPMMOF.MOFRNK AS Rank, DATA2000_CUPMMOF.MOFTHM AS Theme, " _
 & "DATA2000_CUPMMOF.MOFQOO AS QtyOnOrder, RTrim([MOFTYP]) AS Type " _
 & "INTO tbl_cupmmof " _
 & "FROM DATA2000_CUPMMOF " _
 & "WHERE ((RTrim([MOFICD])) Like " & Q & "LD" & Chr$(42) & Q & ") AND ((DATA2000_CUPMMOF.MOFSTD)>#12/31/2006#);"
 Me.lblCUPMMOF.Caption = "Runing"
 Me.lblCUPMMOF.BackColor = lngGreen
 Call SQL(strSQL)
 Call updateCUPMMOF
End Sub
Public Sub updateCUPMMOF()
 Me.lblCUPMMOF.Caption = "Done"
 Me.lblCUPMMOF.BackColor = lngRed
 Call DC
End Sub
Public Sub makeICLMMSTA()
'This is for the querry Make ICLMMSTA
 Dim strSQL As String
 strSQL = "SELECT RTrim(DATA2000_ICLMMSTA!IMCD) AS ItemCode, RTrim([IMMPNO]) AS WaxCode, " _
 & "RTrim([IMCDSK]) AS UPC, DATA2000_ICLMMSTA.ITSP AS Price, RTrim([IMDSC1]) AS Title, " _
 & "RTrim([IEDESC]) AS ExtendDesc, Mid(DATA2000_ICLMMSTA!IMCD,3,1) AS Y " _
 & "INTO tbl_iclmmsta " _
 & "FROM DATA2000_ICLMMSTA LEFT JOIN DATA2000_ICPDEXD ON DATA2000_ICLMMSTA.IMCD = DATA2000_ICPDEXD.IMCD " _
 & "WHERE (((Mid([DATA2000_ICLMMSTA]![IMCD],3,1))>" & Q & 6 & Q & "));"
 Me.lblICLMMSTA.Caption = "Runing"
 Me.lblICLMMSTA.BackColor = lngGreen
 Call SQL(strSQL)
 Call updateICLMMSTA
End Sub
Public Sub updateICLMMSTA()
 Me.lblICLMMSTA.Caption = "Done"
 Me.lblICLMMSTA.BackColor = lngRed
 Call DC
End Sub
____________________
I appreciate all the help thus far mmcdonal, the code rewrite, even if I can't get the desired colored processing effect to work, the code is much easier to deal with now.

TIA,
Scott

Rood67

Rood67 · October 8th, 2007, 04:26 PM

I found the solution to my problem and thought I had posted it here. The short of it is this...
__________
Public Sub DC()
 Dim c As Long
 c = 0
 For c = 1 To 8000: Next c
 Me.SetFocus
 Me.Repaint
End Sub
__________
The answer lies in the setting focus to the form, then using the Repaint option. So my sub routine (DC aka Display Change) is called anytime I make a change to wording or color of a label.

Rood67