Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Toolbar Button Problem

Status
Not open for further replies.
heprox

heprox

IS-IT--Management
Dec 16, 2002
178
US
I have a toolbar on an application that I use to refresh a flexgrid with different recordsets. Whenever I choose a different button on the toolbar its suppossed to change the columns and records in the flexgrid, however it always just stays the same, what am I missing?

Code: 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo errhandler
Select Case ButtonMenu.Index
    Case 1
        Dim strsql_size As String
        Dim inti As Integer
        Dim wasNull As Boolean
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^SKU                                            |^QTY     |^Size  |^Color  |^First Receive Date  |^UPC   "
        strsql_size = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
            " d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
            " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
            " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
            " order by a.sku_num"
        Set rsmain_6 = New ADODB.Recordset
        rsmain_6.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_6.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_6.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_6("sku_num")
                    MSFItem.TextMatrix(inti, 1) = rsmain_6("qty")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_6("size_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_6("color_des"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_6("first_rcv_dt"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_6("upc_cd"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_6.MoveNext
                Loop
        End If
        Exit Sub
    Case 2
        Dim strsql_store As String
        'Dim inti As Integer
        'Dim wasNull As Boolean
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^Item code     |^QTY   |^Store Code  |^District Code    |^Store Name |^Square Footage  "
        strsql_store = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
            " d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
            " Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
            " and a.itm_cd = '" & txtItemCode.Text & "'" & _
            " group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
        Set rsmain_7 = New ADODB.Recordset
        rsmain_7.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_7.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_7.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_7("itm_cd")
                    MSFItem.TextMatrix(inti, 1) = IfNull(rsmain_7("qty"), wasNull, "")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_7("store_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_7("opt_dist_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_7("store_name"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_7("sq_ft"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_7.MoveNext
                Loop
        End If
        Exit Sub
    Case 3
        Dim strsql_sku As String
        'Dim inti As Integer
        'Dim wasNull As Boolean
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^SKU                        |^Size  |^Color |^First Receive Date |^UPC    "
        strsql_sku = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft," & _
            " b.size_cd, b.color_des from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
            " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
            " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
            " d.store_name , d.op_dist_cd, d.sq_ft, b.size_cd, b.color_des" & _
            " order by a.store_cd, a.sku_num"
        Set rsmain_8 = New ADODB.Recordset
        rsmain_8.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_8.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_8.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_8("sku_num")
                    MSFItem.TextMatrix(inti, 1) = rsmain_8("qty")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_8("size_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_8("color_des"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_8("store_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("store_name"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("op_dist_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("sq_ft"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_8.MoveNext
                Loop
        End If
        Exit Sub
    'Case Else
End Select
errhandler:
    MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
    Exit Sub
End Sub
 
Sort by date Sort by votes
I've always used the Textmatrix method for populating the flexgrid, so I'm completely lost on the Add.Item method? I've got the function working, the only problem is that whenever I click the toolbar button and the flexgrid populates the records skip every other row? I want the rows to alternate color, but not skip rows with the records?

Code: 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Dim strsql As String
  Dim wasNull As Boolean
  On Error GoTo errhandler
  With MSFItem
    .Clear
    .Rows = 2
    Select Case Button.Key
    Case "bmnSize"
      .FormatString = "^SKU    |^QTY   |^Size  |^Color            |^First Receive Date  |^UPC  "
      strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
        " d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
        " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
        " order by a.sku_num"
    Case "bmnStore"
      .FormatString = "^Item code   |^QTY    |Store Code   |^District Code |^Store Name     |^Square Footage   "
      strsql = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
        " d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
        " Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
        " and a.itm_cd = '" & txtItemCode.Text & "'" & _
        " group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
    Case "bmnSKU"
      .FormatString = "^SKU  |^QTY     |^Size  |^Color      |^Store Code  |^Store Name    |^District Code  |^Square Footage   "
      strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft" & _
        " from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
        " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
        " d.store_name , d.op_dist_cd, d.sq_ft order by a.store_cd, a.sku_num"
    End Select
  
    Set rsmain = New ADODB.Recordset
    rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
    If rsmain.EOF Then
      MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
      txtSOH.Text = ""
      Exit Sub
    Else
      Do While Not rsmain.EOF()
        If .TextMatrix(1, 0) = "" Then
          .Row = 1
        Else
          .Rows = .Rows + 1
        End If
        wasNull = False
        Select Case Button.Key
        Case "bmnSize"
          .TextMatrix(.Row, 0) = rsmain("sku_num")
          .TextMatrix(.Row, 1) = rsmain("qty")
          .TextMatrix(.Row, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(.Row, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(.Row, 4) = IfNull(rsmain("first_rcv_dt"), wasNull, "")
          .TextMatrix(.Row, 5) = IfNull(rsmain("upc_cd"), wasNull, "")
        Case "bmnStore"
          .TextMatrix(.Row, 0) = rsmain("itm_cd")
          .TextMatrix(.Row, 1) = IfNull(rsmain("qty"), wasNull, "")
          .TextMatrix(.Row, 2) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(.Row, 3) = IfNull(rsmain("op_dist_cd"), wasNull, "")
          .TextMatrix(.Row, 4) = IfNull(rsmain("store_name"), wasNull, "")
          .TextMatrix(.Row, 5) = IfNull(rsmain("sq_ft"), wasNull, "")
        Case "bmnSKU"
          .TextMatrix(.Row, 0) = rsmain("sku_num")
          .TextMatrix(.Row, 1) = rsmain("qty")
          .TextMatrix(.Row, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(.Row, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(.Row, 4) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(.Row, 5) = IfNull(rsmain("store_name"), wasNull, "")
          .TextMatrix(.Row, 6) = IfNull(rsmain("op_dist_cd"), wasNull, "")
          .TextMatrix(.Row, 7) = IfNull(rsmain("sq_ft"), wasNull, "")
        End Select
               For i = 1 To .Rows - 1 Step 2
                    .Row = i
                    For j = 0 To .Cols - 1
                        .Col = j
                        .CellBackColor = &HC0FFFF
                    Next j
               Next i
        rsmain.MoveNext
      Loop
    End If
  End With
errhandler:
If Err Then
  MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
End If
End Sub

 
Upvote 0 Downvote
here is an example of AddItem:
Code: 
Private Sub Command1_Click()
  With MSFlexGrid1
    .Clear
    .Rows = 1
    .FormatString = "  1  |  2  |  3  |  4  |  5  "
    For i = 1 To 5
      [b].AddItem (i * 1) & vbTab & _
               (i * 2) & vbTab & _
               (i * 3) & vbTab & _
               (i * 4) & vbTab & _
               (i * 5)[/b]
    Next
  End With
End Sub

Visit My Site
PROGRAMMER: (n) Red-eyed, mumbling mammal capable of conversing with inanimate objects.
 
Upvote 0 Downvote
heprox,

I used the latest code example from this thread as an example to demonstrate how you need to reorganize your code.
I eventually didn't test it and it might need some correction but the approach should be clear for you.

Private Function GetFormatString(ByVal pstrButtonKey As sting) As String
Dim strReturn As String

On Error GoTo MethodExit

Select Case pstrButtonKey
Case "bmnSize"
strReturn = "^SKU |^QTY |^Size |Color |^First Receive Date |^UPC "
Case "bmnStore"
strReturn = "^Item code |^QTY |^Store Code |^District Code |^Store Name |^Square Footage "
Case "bmnSKU"
strReturn = "^SKU |^QTY |^Size |^Color |^Store Code |^Store Name |^District Code |^Square Footage "
End Select

MethodExit:
GetFormatString = strReturn

If Err.Number <> 0 Then
MsgBox Err.Description & " in GetFormatString"
End If

End Function

Private Function GetSql(ByVal pstrButtonKey As sting) As String
Dim strReturn As String

On Error GoTo MethodExit

Select Case pstrButtonKey
Case "bmnSize"
strReturn = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
" d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
" Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
" and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
" order by a.sku_num"
Case "bmnStore"
strReturn = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
" d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
" Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
" and a.itm_cd = '" & txtItemCode.Text & "'" & _
" group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
Case "bmnSKU"
strReturn = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft" & _
" from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
" Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
" and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
" d.store_name , d.op_dist_cd, d.sq_ft order by a.store_cd, a.sku_num"
End Select

MethodExit:
GetSql = strReturn

If Err.Number <> 0 Then
MsgBox Err.Description & " in GetSql"
End If

End Function

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim strSql As String
Dim rsMain As Object

On Error GoTo MethodExit

ClearGrid
strSql = GetSql(Button.Key)
Set rsMain = GetDataToPopulateGrid(strSql)

If rsMain.EOF Then
MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
txtSOH.Text = vbNullString
Else
PopulateGrid rsMain, Button.Key
PaintGrid
End If

MethodExit:

Set rsMain = Nothing

If Err.Number <> 0 Then
MsgBox "Errors occured while retreiving the item information" & vbCrLf & _
"Please Click on Reset Button and Redo the process" & vbCrLf & _
Err.Number & ":" & Err.Description, vbCritical, "Error"
End If

End Sub

Private Function GetRowEntries(ByVal pstrButtonKey As String) As Variant
Dim strReturn(8) As String
Dim blnWasNull As Boolean

On Error GoTo ExitMethod

blnWasNull = False

Select Case Button.Key
Case "bmnSize"

strReturn(0) = rsMain("sku_num").Value
strReturn(1) = rsMain("qty").Value
strReturn(2) = IfNull(rsMain("size_cd").Value, blnWasNull, vbNullString)
strReturn(3) = IfNull(rsMain("color_des").Value, blnWasNull, vbNullString)
strReturn(4) = IfNull(rsMain("first_rcv_dt").Value, blnWasNull, vbNullString)
strReturn(5) = IfNull(rsMain("upc_cd").Value, blnWasNull, vbNullString)
strReturn(6) = vbNullString
strReturn(7) = vbNullString

Case "bmnStore"
strReturn(0) = rsMain("itm_cd").Value
strReturn(1) = IfNull(rsMain("qty").Value, blnWasNull, vbNullString)
strReturn(2) = IfNull(rsMain("store_cd").Value, blnWasNull, vbNullString)
strReturn(3) = IfNull(rsMain("op_dist_cd").Value, blnWasNull, vbNullString)
strReturn(4) = IfNull(rsMain("store_name").Value, blnWasNull, vbNullString)
strReturn(5) = IfNull(rsMain("sq_ft").Value, blnWasNull, vbNullString)
strReturn(6) = vbNullString
strReturn(7) = vbNullString

Case "bmnSKU"
strReturn(0) = rsMain("sku_num").Value
strReturn(1) = rsMain("qty").Value
strReturn(2) = IfNull(rsMain("size_cd").Value, blnWasNull, vbNullString)
strReturn(3) = IfNull(rsMain("color_des").Value, blnWasNull, vbNullString)
strReturn(4) = IfNull(rsMain("store_cd").Value, blnWasNull, vbNullString)
strReturn(5) = IfNull(rsMain("store_name").Value, blnWasNull, vbNullString)
strReturn(6) = IfNull(rsMain("op_dist_cd").Value, blnWasNull, vbNullString)
strReturn(7) = IfNull(rsMain("sq_ft").Value, blnWasNull, vbNullString)

End Select

MethodExit:

GetRowEntries = strReturn

If Err.Number <> 0 Then
MsgBox Err.Description & " in GetRowEntries"
End If

End Function


Private Sub PopulateGrid(ByRef pobjRecordSset As Object, ByVal pstrButtonKey As String)
Dim strRowEntries(8) As String

On Error GoTo ExitMethod

MSFItem.FormatString = GetFormatString(Button.Key)

If Not pobjRecordSset Is Nothing Then
Do While Not pobjRecordSset.EOF()

strRowEntries = GetRowEntries(Button.Key)

MSFItem.AddItem strRowEntries(0) & vbTab & _
strRowEntries(1) & vbTab & _
strRowEntries(2) & vbTab & _
strRowEntries(3) & vbTab & _
strRowEntries(4) & vbTab & _
strRowEntries(5) & vbTab & _
strRowEntries(6) & vbTab & _
strRowEntries(7)


pobjRecordSset.MoveNext

Loop
End With


MethodExit:

GetRowEntries = strReturn

If Err.Number <> 0 Then
MsgBox Err.Description & " in PopulateGrid"
End If

End Sub

Private Function GetDataToPopulateGrid(ByVal pstrSQL As String) As Object

On Error GoTo ExitMethod

Dim objRecordset As Object

Set objRecordset = New ADODB.Recordset

objRecordset.Open pstrSQL, cn, adOpenKeyset, adLockReadOnly 'not sure about cn, not enough info for me


MethodExit:

Set GetDataToPopulateGrid = objRecordset
Set objRecordset = Nothing

If Err.Number <> 0 Then
MsgBox Err.Description & " in PopulateGrid"
End If

End Function

Private Sub ClearGrid()
MSFItem.Clear
MSFItem.Rows = 2
End Sub

Private Sub PaintGrid()
Dim i As Integer
Dim j As Integer

Const MY_BEST_COLOR As Long = &HC0FFFF

On Error GoTo MethodExit

With MSFItem
For i = 1 To .Rows - 1 Step 2
.Row = i
For j = 0 To .Cols - 1
.Col = j
.CellBackColor = MY_BEST_COLOR
Next j
Next i
End With

MethodExit:

If Err.Number <> 0 Then
MsgBox Err.Description & " in PaintGrid"
End If

End Sub

vladk
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Ken01
  • Locked
  • Question
Problem with CopyMemory statement
Replies
1
Views
322
strongm
strongm
Andrzejek
  • Locked
  • Question
Graphical command button 2
Replies
2
Views
321
Andrzejek
Andrzejek
Raj Gupta
  • Locked
  • Question
VB6 Focus problem after validation
Replies
4
Views
428
strongm
strongm
Ken01
  • Locked
  • Question
Problem with form names in VB6
Replies
3
Views
325
Ken01
Ken01
sal21
  • Locked
  • Question
Pplease for strongm, ftp problem to download file and copy inn c:\tabulati\
Replies
10
Views
533
sal21
sal21

Part and Inventory Search

Sponsor

Back
Top