FlexGrid Color Row, Saving DAT Files, Excel Spreadsheet Help!

Dear Reader,

As you can tell from the title this Thread is a little scatterbrained and I apologize. Basically my problem is this. I have a FlexGrid with a color changing button that when you select the color and hit "Apply" it changes the Row of the FlexGrid. Now, the FlexGrid is tied directly into an Excel Spreadsheet that the user Opens by going to File>Open. So here is my problem,

In the FlexGrid, say I changed Row #1 to Red because the in the Spreadsheet that the User opened inside the FlexGrid, Row #1 was a bad column of data. Not bad like incorrect but bad as in the information was not the kind they were looking for. Therefore, the whole point of the color coding stuff is to label bad, good, problems, etc.

The code that I have for the Color Coding is as follows, and contains DAT file information:

Code:

---


Private Sub ApplyColor(PColor As Long)
    With fgROList
        .FillStyle = flexFillRepeat
        .Col = .FixedCols
        .ColSel = .Cols - 1
        .CellBackColor = PColor
        .FillStyle = flexFillSingle
    End With
End Sub
   
Private Sub cmdApplycolor_Click()
    ApplyColor commonDialogColorBox.Color
End Sub

Private Sub cmdSelectColor_Click()
    With commonDialogColorBox
        .Flags = cdlCCRGBInit Or cdlCCFullOpen
        .ShowColor
        lblColor.BackColor = .Color
    End With
End Sub

Private Sub DoSomething()
    With fgROList
        .Rows = 10
        .Cols = 5
        .SelectionMode = flexSelectionByRow
        .FocusRect = flexFocusNone
    End With
    LoadFlexFormat
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    SaveFlexFormat
End Sub

Private Sub SaveFlexFormat()
Dim fso As Object, TS As Object, i As Long
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set TS = fso.CreateTextFile(App.Path & "\FlexColors.DAT", True)

    With fgROList
        .Col = .FixedCols
        For i = fgROList.FixedRows To fgROList.Rows - 1
            .Row = i
            TS.WriteLine fgROList.CellBackColor
        Next
    End With
   
    TS.Close
    Set TS = Nothing
    Set fso = Nothing
End Sub

Private Sub LoadFlexFormat()
Dim fso As Object, TS As Object, StrItem As String
   
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    If Dir(App.Path & "\FlexColors.DAT") = vbNullString Then
        Set fso = Nothing
        Exit Sub
    Else
        Set TS = fso.OpenTextFile(App.Path & "\FlexColors.DAT", 1)
    End If
   
    With fgROList
        Do While Not TS.AtEndOfStream
            StrItem = TS.ReadLine
            If TS.Line - 1 < .Rows Then
                .Row = TS.Line - 1
                If CLng(StrItem) <> 0 Then ApplyColor CLng(StrItem)
            End If
        Loop
        .Row = .FixedRows
        .Col = .FixedCols
        .ColSel = .Cols - 1
    End With
       
    TS.Close
    Set TS = Nothing
    Set fso = Nothing
End Sub

---

This all applies to the FlexGrid called fgROList.

The problem, I think, lies with Excel. Maybe the Colored Rows need to be changed simultaneously in the Spreadsheet as well as the Rows in VB? I'm not sure. Another worthy statement might be to review the possibility that when the DAT file saves it might not Open and Apply it to the Spreadsheet that it opens. Because keep in mind every employee here opens up a different Spreadsheet.

So, if Employee #1 opened Spreadsheet X up and marked Rows #1 and #2 as Blue. I need that same Spreadsheet to have those colors applied if Employee #2 opened up Spreadsheet X the next day.

Let me know if I left out any information or if you need anymore. I would zip the whole folder but it's bigger than the requirements.

My code is at your disposal so if you have any questions, comments, or replies I would GREATLY appreciate them.

Quote:

---

..the FlexGrid is tied directly into an Excel Spreadsheet that the user Opens by going to File>Open..

---

What do you mean by that? Like a bound control? Are you using code to do this or it's just about setting a property?

That function was actually set up by another person in the office so I apologize on that. I worded that horribly. As far as I know, it's a connected database? He uses ADOBD to establish a connection I know that. ADO has been the one thing that has confused me to no end so I decided to draw my attention somewhere else before smashing the computer out of frustration. I can get you the code where there is the File>Open function if that helps!

Yes, it's important to see how are you getting data from Excel to the Flexgrid and viceversa.

Sometimes you need to learn some new things to be able to continue your work, ADO is not difficult. Btw, are you a programmer?

Here is the Code when the User hits File, and then Open (CTRL + O), let me know if this helps!

Code:

---

Private Sub mnuOpen_Click()
On Error Resume Next
Dim pattern As String
Dim blnFileOpen As Boolean

    pattern = "Excel(*.xls)|*.xls"
    CommonDialog1.Filter = pattern
    CommonDialog1.ShowOpen
    strROBlitZFilePath = CommonDialog1.FileName
   
    If strROBlitZFilePath = "" Then Exit Sub
  'Need to Add QC Column
  ' AddQA
   
    blnFileOpen = chkFileOpen(strROBlitZFilePath)
 

    If blnFileOpen = True Then
        MsgBox "Please close the following file and open in the file in RO Viewer app" & vbCrLf & strROBlitZFilePath, vbCritical, "RO Viewer"
        Exit Sub
    End If
   
    blnFileOpen = chkFileOpen(strVehicleInfoFilePath)
    If blnFileOpen = True Then
        MsgBox "Please close the following file and open the BlitZ app again" & vbCrLf & strVehicleInfoFilePath, vbCritical, "BlitZ"
        Unload Me
        Exit Sub
    End If



    lblROFileName.Caption = "File:" & strROBlitZFilePath
    OpenConnectionRO (strROBlitZFilePath)
    'Create the Bookmark Sheet
    CreateBookMarkSheet
   
    CreateQCSheet
   
    If blnFisrtTimeQA = True Then
       
        UpdateQAData
        blnFisrtTimeQA = False
    End If

   
    If CheckROFormat = False Then
        MsgBox "The following file structure is not correct ,Please contact the Snap-on Admin" & vbCrLf & strROBlitZFilePath, vbCritical, "RO Viewer"
        Exit Sub
   
    End If

loadROList



End Sub

---

That's not he code handling Excel, I assume the interesting part comes inside these subs:

Code:

---

    OpenConnectionRO (strROBlitZFilePath)
    CreateBookMarkSheet 
    CreateQCSheet

---

This project has caused me an immense amount of frustration because I have to set up a different window kind of like the one he has here, but that's another story. The reason I'm referencing that is because he pointed me to a code that he said would do that for me, all I had to do was copy and paste and switch a few things around. But the code beat me. I'll post it below! Again, sorry for posting irrelevant information I'm still very beginner. Here is the code he presented to me:

Code:

---

Private Sub loadROList()



On Error Resume Next
    Dim rsROList As ADODB.Recordset
    Dim strSql As String
    Dim nIndex As Integer
 
   
   


    lngUnTouchedRos = 0
    lngUsableRos = 0
    lngNotUsableRos = 0
    lngDuplicateRos = 0
         
        fgROList.Clear (flexClearEverywhere)
        fgROList.Rows = 0
        fgROList.Cols = 15
        fgROList.Rows = 1
       
        fgROList.FixedRows = 1
        fgROList.TextMatrix(0, 0) = "RO"
        fgROList.TextMatrix(0, 1) = "UnTouched"
        fgROList.ColDataType(1) = flexDTBoolean
        fgROList.TextMatrix(0, 2) = "Usable"
        fgROList.ColDataType(2) = flexDTBoolean
        fgROList.TextMatrix(0, 3) = "NotUsable"
        fgROList.ColDataType(3) = flexDTBoolean
        fgROList.TextMatrix(0, 4) = "IsDuplicate"
        fgROList.ColDataType(4) = flexDTBoolean
        fgROList.TextMatrix(0, 5) = "RORating"
        fgROList.Cell(flexcpBackColor, 0, 5, 0, 5) = vbRed
        fgROList.ColComboList(5) = "#0;Excellent|#1;Good|#2;Bad "
        fgROList.TextMatrix(0, 6) = "ShopID"
        fgROList.TextMatrix(0, 7) = "Keywords"
        fgROList.TextMatrix(0, 8) = "Year"
        'fgROList.ColComboList(1) = "#0;NotUsable |#1;Usable |#2;UnTouched"
       
        fgROList.TextMatrix(0, 9) = "Make"
        fgROList.TextMatrix(0, 10) = "Model"
        fgROList.TextMatrix(0, 11) = "Trim"
        fgROList.TextMatrix(0, 12) = "Engine"
        fgROList.TextMatrix(0, 13) = "Odometer"
        fgROList.TextMatrix(0, 14) = "QC Completed"



    nIndex = 1
  strSql = "Select distinct  RepairOrderNo,ROStatus,RORATING,ShopID,Keywords,ModelYear,Make,model,Trim,EngineDisplacementLiters,Odometer from [ROS$] WHERE RepairOrderNo <> 0 Order by RepairOrderNo "
  Set rsROList = New ADODB.Recordset
    rsROList.Source = strSql
    rsROList.ActiveConnection = cnnRO
    rsROList.Open
   
    'rsROList.Fields.Append "XYX", adChar, 20
   
    Do Until rsROList.EOF = True
       
            fgROList.AddItem "", nIndex
            fgROList.TextMatrix(nIndex, 0) = rsROList!RepairOrderNo
         
         
           
            Select Case rsROList!ROStatus
                Case "UnTouched"
                    fgROList.TextMatrix(nIndex, 1) = 1
                    lngUnTouchedRos = lngUnTouchedRos + 1
                Case "Usable"
                    fgROList.TextMatrix(nIndex, 2) = 1
                    lngUsableRos = lngUsableRos + 1
                Case "NotUsable"
                    fgROList.TextMatrix(nIndex, 3) = 1
                    lngNotUsableRos = lngNotUsableRos + 1
                Case "Duplicate"
                    fgROList.TextMatrix(nIndex, 4) = 1
                    lngDuplicateRos = lngDuplicateRos + 1
            End Select
           
           
            fgROList.TextMatrix(nIndex, 5) = rsROList!RORATING
            fgROList.TextMatrix(nIndex, 6) = rsROList!ShopID
            fgROList.TextMatrix(nIndex, 7) = rsROList!Keywords
            fgROList.TextMatrix(nIndex, 8) = rsROList!ModelYear
            fgROList.TextMatrix(nIndex, 9) = rsROList!Make
            fgROList.TextMatrix(nIndex, 10) = rsROList!Model
            fgROList.TextMatrix(nIndex, 11) = rsROList!Trim
            fgROList.TextMatrix(nIndex, 12) = rsROList!EngineDisplacementLiters
            fgROList.TextMatrix(nIndex, 13) = rsROList!Odometer
           
            If chkBlitZExist(rsROList!RepairOrderNo) = True Then
             
                fgROList.TextMatrix(nIndex, 14) = chkQCCompleted(rsROList!RepairOrderNo)
            Else
                fgROList.TextMatrix(nIndex, 14) = "NoTip"
         
            End If
           
            'Select the BookMark
            If strRepairOrder = rsROList!RepairOrderNo And strRepairOrder <> "" Then
                fgROList.IsSelected(nIndex) = True
                fgROList.ShowCell nIndex, 0
                lngBookMarkRow = nIndex
                loadRODetails (strRepairOrder)
               
                If chkBlitZExist(strRepairOrder) = False Then
                  cmdOpenBlitZ.Enabled = False
                Else
                  cmdOpenBlitZ.Enabled = True
                End If
           
               
            End If
           
           
            nIndex = nIndex + 1
   
        rsROList.MoveNext
    Loop
   
    If lngBookMarkRow <> 1 Then fgROList.IsSelected(1) = False
     
    rsROList.Close
  ' rsROList.Fields.Append "XYX", adChar, 20
    Set rsROList = Nothing
   
    fgROList.AutoSize 0
    fgROList.AutoSize 1
    fgROList.AutoSize 2
    fgROList.AutoSize 3
    fgROList.AutoSize 4
    fgROList.AutoSize 5
    fgROList.AutoSize 6
    fgROList.AutoSize 7
    fgROList.AutoSize 8
    fgROList.AutoSize 9
    fgROList.AutoSize 10
    fgROList.AutoSize 11
    fgROList.AutoSize 12
    fgROList.AutoSize 13
     
    lblUsable.Caption = "Usable: " & CStr(lngUsableRos)
    lblNotUsable.Caption = "Not Usable: " & CStr(lngNotUsableRos)
    lblUntouched.Caption = "Untouched: " & CStr(lngUnTouchedRos)
    lblDuplicate.Caption = "Duplicate: " & CStr(lngDuplicateRos)

End Sub

---

There is also another thing I came across that is the function he uses to save everything from that Flex Grid he already set up, if that makes sense. So maybe there is something in there that can help me save the color of the row I change also, here is that "save" code:

Code:

---

Private Sub subSaveRO()

Dim nIndex As Long
Dim strSql As String
 
 On Error Resume Next
 Set rsROList = New ADODB.Recordset
 rsROList.ActiveConnection = cnnRO
 rsROList.LockType = adLockOptimistic
 'Dim cmdROList As New ADODB.Command
 'Set cmdROList = New ADODB.Command

   
    lblSave.Caption = "Please wait the Files is saving...."
 
For nIndex = 1 To fgROList.Rows - 1

        If fgROList.TextMatrix(nIndex, 0) = "" Then Exit Sub
        strSql = "Select * from [ROS$] WHERE  RepairOrderNo = " & fgROList.TextMatrix(nIndex, 0)
        rsROList.Source = strSql
        rsROList.Open

        Do Until rsROList.EOF = True
            If fgROList.TextMatrix(nIndex, 1) = "1" Or fgROList.TextMatrix(fgROList.Row, 1) = "-1" Then    'UnTouched
                rsROList!ROStatus = "UnTouched"
            End If

            If fgROList.TextMatrix(nIndex, 2) = "1" Or fgROList.TextMatrix(nIndex, 2) = "-1" Then  'Usable
                rsROList!ROStatus = "Usable"
            End If
            If fgROList.TextMatrix(nIndex, 3) = "1" Or fgROList.TextMatrix(nIndex, 3) = "-1" Then  'NotUsable
                rsROList!ROStatus = "NotUsable"
            End If
           
            If fgROList.TextMatrix(nIndex, 4) = "1" Or fgROList.TextMatrix(nIndex, 4) = "-1" Then  'Duplicate
                rsROList!ROStatus = "Duplicate"
            End If
           
            rsROList!RORATING = fgROList.TextMatrix(nIndex, 5)
            rsROList.Update
            rsROList.MoveNext
        Loop
    rsROList.Close
           
Next



'Save the bookmark


    Set rsBookMark = New ADODB.Recordset
    rsBookMark.ActiveConnection = cnnRO
    rsBookMark.LockType = adLockOptimistic
    strSql = "Select * from [BookMark$] "
    rsBookMark.Source = strSql
    rsBookMark.Open
    rsBookMark!RepairOrderNo = strRepairOrder
    rsBookMark.Update
    rsBookMark.Close
   

lblSave.Caption = ""

End Sub

---

Ok, I see your code works on Excel by using it as a DB, creating a Recordset from a Query. This is the correct way to do it but it only allows you to handle data, not formatting in Excel. So the good news is you won't touch this code, leave it alone as it is. But you'll need to add Automation, i don't think there exist another approach. Please read the thread about Excel Automation in the FAQ thread, because that's what you need now, here is the link: Tutorial/FAQ: How to Automate Excel from VB6 (or VB5/VBA)

This is a list of things you're gonna need to solve to make it work:

1) Path to Excel file (filename included): The path to the XLS file that corresponds (contain) the data loaded in the Flexgrid, is this path available when your App is executing, maybe in a label or TextBox? It surely has been used when creating the connection to Excel in the code you posted: cnnRO is the Connection but you didn't include the code where this Connection is being open (including ConnectionString).

2) Identify the Worksheet: Is it a workbook with many Worksheets? Do you know which worksheet index or name has the one you need to work with? Or is it just a worksheet/spreadsheet alone?

3) Matching Rows: I can see in the code you posted that the Flexgrid is loaded from Excel using this line:

Code:

---

      SELECT DISTINCT RepairOrderNo,ROStatus,RORATING,ShopID,Keywords,ModelYear,Make,
                      model,Trim,EngineDisplacementLiters,Odometer
        FROM [ROS$]
        WHERE RepairOrderNo <> 0
    ORDER BY RepairOrderNo

---

See the words i painted in black. Distinct means bring only distinct rows, if the row is duplicated then retrieve only one. Order by means altering the order of the rows to order them by one or more fields. So, these 2 things (Distinct and Order By) are adding a new problem: to be able to format rows in Excel using your Flexgrid as reference you need to match rows from the Flexgrid with the ones in the worksheet/spreadsheet in Excel and you won't be able to do this if you change this order or remove rows when bringing data from Excel to Flexgrid. Then, what can we do about this?

You need to solve these 3 points, I think number (3) will be the one that will keep you thinking :)
When you have the path, worksheet and matched rows then i think it can be done. The Excel table itself can even be found using UsedRange so where the data starts and where it ends (cells) is not a problem.

Thank you jcis for all your wonderful help. If I could improve your reputation more than I already have I would. Thank you for teaching me HOW to do it and not just filling in the blanks for me. Even more, thank you for defining the terms. You've certainly made programming funner for me. I'll post another Thread regarding Automation if I run into anything at the end of the day.