Solved

Saving A FlexGrid

Posted on 1998-07-15
14
775 Views
Last Modified: 2011-10-03
 I have a Flex grid displaying an Access Query.  I have read the contents and replaced certain text with graphics ("red" = red.gif).  Does anyone have
        any code that would allow the user to save this display in a format that could be brought into other MS products as a table with complete editing
        capability.
0
Comment
Question by:clarwc
  • 6
  • 4
  • 4
14 Comments
 
LVL 1

Expert Comment

by:wford
Comment Utility
to get this strait,

You want to be able to port this flexigrid, with graphics, as a table to other apps such as work and excel, or just to a specific app , such as excel.

Also do you know how many (or at least a maximum value) of records you would be looking at?
0
 
LVL 2

Expert Comment

by:mtoft
Comment Utility
One solution that comes to mind is to implement a function that parses the entire flexgrid and returns rich text (RTF). Rich text has rtf-codes for tables (Like word tables), and pictures.
Word/Excel/WP and other applications will be able to read that.

Good luck!
0
 

Author Comment

by:clarwc
Comment Utility
wford,

The ultimate goal for the table would be Powerpoint.  I just figured that if I were able to get it into Word or Excel that dropping it onto a Powerpoint slide would be easy.  As far as records are concerned, I will have seven fields and probably no more than 250-300 records.


mtoft,

I have no idea how to parse the flexgrid and return RTF with my tables.  It sounds like something that might work because I could use an OLE object to open the file in Word or Excel.  Any suggestions as to how to do it???
0
 
LVL 1

Expert Comment

by:wford
Comment Utility
Hmmm, just of the top of my head..

two ideas come to mind
1.
Have you considered using VB for applications, I find it a bit clunky, but you can open word, create a table with the dimensions of your flexigrid, then scan through the flexigrid and copy that text or images into the equivilent cell, then you can save, or select the table and export.

This is normaly slow and painful,but may be just the thing if you do this operation rarely and mostly on you own computer.

2.
Parse the stuff into HTML, it's a little bit more forgiving than RTF and ofice 97 and onwards will support it, or at least do the HTML to RTF translation for you.

This is a little better, not as slow,but  less automated.

0
 

Author Comment

by:clarwc
Comment Utility
HTML sunds like the best bet but I have no idea how to do that.  The code I am using to populate the Flexgrid is:




Private Sub CmdBack_Click()
    FrmProgData.Hide

   
End Sub



Private Sub FG1_GotFocus()
   
    FG1.Font.Name = "arial"
    FG1.Font.Size = "8"
    FG1.Font.Bold = True
    FG1.Cols = 8
    s$ = "          |<Code                   |<Program Title                                           |<Cost      |<Sched |<Perf       |<Remarks                                                     |<Updated      "
    FG1.FormatString = s$
    FG1.WordWrap = True
   
   
   
    For nCnt1 = 1 To FG1.Rows - 1
        For nColNum = 3 To 5
          Select Case FG1.TextMatrix(nCnt1, nColNum)
            Case "Red"
              FG1.CellPictureAlignment = flexAlignCenterCenter
              sPicFile = "c:\205gui\YelRed.gif"
            Case "Green"
              FG1.CellPictureAlignment = flexAlignCenterCenter
              sPicFile = "c:\205gui\Grnball.gif"
            Case "Yellow"
              FG1.CellPictureAlignment = flexAlignCenterCenter
              sPicFile = "c:\205gui\Yellball.gif"
            Case Else
              sPicFile = ""
          End Select
          If sPicFile <> "" Then
            FG1.Col = nColNum
            FG1.Row = nCnt1
            Set FG1.CellPicture = LoadPicture(sPicFile)
            FG1.TextMatrix(nCnt1, nColNum) = ""
          End If
        Next nColNum
      Next nCnt1

    Call fixflex
   

End Sub

Private Sub fixflex()
    Dim nrow As Integer
   
    LblCellText.Width = FG1.ColWidth(6)
   
    For nrow = 1 To FG1.Rows - 1
        LblCellText.Caption = FG1.TextMatrix(nrow, 6)
        FG1.RowHeight(nrow) = LblCellText.Height + 240
    Next nrow
    End Sub
   

Any help you can give would be greatly appreciated...

Warren
0
 
LVL 1

Expert Comment

by:wford
Comment Utility
OK, well, I will not submit this as an answer cause I have not yet finished it, but on the 1st solution, I have this so far. Keep in mind,It seems to work, but I am missing the the picture insert syntax. I'll post as far as I'ive got today, so that you, or others can move ahead, (I have to sleep, and do some work, I know not why!)

Dim WordX As Object
Dim TblRow As Integer, TblCol As Integer
dim nC as integer, nR as integer

Set WordX = GetObject(, "Word.Application")
    If Err.Number <> 0 Then                             'Error case, no current Word app
        Err.Clear                                       'Clear Err object
        RetVal = Shell("Your path for Word", 6)       'start word in shell
        If RetVal = 0 Then MsgBox "MS Word not installed": Exit Sub    'if shell command not successful exit print
        Set WordX = GetObject(, "Word.Application")                 'get control of new word application
    End If
    WordX.Documents.Add 'open new document
    'look for dimensions of your flexigrid
    TblRow = MSFlexGrid1.Rows
    'watch for hidden columns, or ones with no width
    TblCol = MSFlexGrid1.Cols
    'create the table as you want it
    With WordX.Activedocument
        Set myRange = .Range(Start:=0, End:=0)
        .Tables.Add Range:=myRange, NumRows:=TblRow, NumColumns:=TblCol
        'setup col widths. Note: tables are 1 based and flexi grids are 0 based
        For n = 1 To tblcols
            ColWdth = MSFlexGrid1.ColWidth(n - 1)
            .Tables(1).Columns(n).SetWidth ColumnWidth:=ColWdth, RulerStyle:=wdAdjustNone
        Next n
        'you can setup rows, styles etc... here
        'Now just fill in your data
        For nC = 1 To TblCol
            'set cell contents
            MSFlexGrid1.Col = nC - 1
            For nR = 1 To TblRow
                MSFlexGrid1.Col = nC - 1
                'See if there is a picture
                If MSFlexGrid1.CellPicture = 0 Then
                    .Tables(1).cell(nR, nC).Range.Text = Trim(MSFlexGrid1.Text)
                Else
                    'Its only this that does not work so far
                    'Set .Tables(1).cell(nR, nC). =MSFlexGrid1.CellPicture
                End If
            Next nR
        Next nC
    End With

Pop this into a sub or command button and haveMS Word open and it should work, except for inserting the  pictures. I stress, this is just a rough go at the problem, I have not tested it much, and there are many refinements to be made on the layout of the table, style and font, scaleing to fit the page etc... If this looks like what you want, leave a message and I will post the finish version tomorrow (my time) :>

Hope it helps
0
 
LVL 2

Accepted Solution

by:
mtoft earned 500 total points
Comment Utility
This Flexgrid to HTML converter places a file called "Index.htm" in the directory set by the SAVE function.

Does it solve your problem?

Regards
/MTOFT


' Call this to save the flexgrid
Public Sub SAVE(FlexGrid As Object)
    ' Make sure these match your own drive
    ChDrive "F:"
    ChDir "\Temp\HTML\"
       
    ' Save the HTML
    SaveFlexgridAsHTML FlexGrid
End Sub


'*********************************************************************
'Function
'  SaveFlexGridAsHTML
'Saves a Index.HTML file in the given directory, calculates from the
'flexgrid parameter
Public Function SaveFlexgridAsHTML(ByVal FlexGrid As Object) As Boolean
    Dim lRow As Long
    Dim lCol As Long
    Dim lColSpan As Long
    Dim lRowSpan As Long
    Dim sHTML As String
   
    ' Assumes error
    SaveFlexgridAsHTML = False
   
    ' <HTML> TAG
    sHTML = "<HTML>" & _
        "<TITLE>FlexGrid</TITLE>" & _
        "<META NAME=""GENERATOR"" CONTENT=""FlexToHTML"">"
 
    ' <TABLE> TAG
    sHTML = sHTML & "<TABLE BORDER=""" & Abs(FlexGrid.Gridlines <> 0) & """ BGCOLOR=""#ffffff"">" & vbNewLine
 
    ' <TD><TR> TAGS
    For lRow = 0 To FlexGrid.Rows - 1
        sHTML = sHTML & vbTab & "<TR>" & vbNewLine
        For lCol = 0 To FlexGrid.Cols - 1
            ' We handle merged cells expensively...
            lColSpan = GetColSpan(FlexGrid, lRow, lCol)
            lRowSpan = GetRowSpan(FlexGrid, lRow, lCol)
            If lColSpan > 1 Then
                sHTML = sHTML & vbTab & vbTab & "<TD COLSPAN=""" & lColSpan & """"
            ElseIf lRowSpan > 1 Then
                sHTML = sHTML & vbTab & vbTab & "<TD ROWSPAN=""" & lRowSpan & """"
            ElseIf lColSpan = 0 Or lRowSpan = 0 Then
                ' Sometimes i really miss the continue operator !
                GoTo Continue
            Else
                sHTML = sHTML & vbTab & vbTab & "<TD"
            End If
 
            If (CLng(FlexGrid.CellBackColor) <> CLng(FlexGrid.BackColor)) And Len(FlexGrid.Text) <> 0 Then
                sHTML = sHTML & " BGCOLOR=""#" & GetHexicColorCode(FlexGrid.CellBackColor) & """ >"
            Else
                sHTML = sHTML & ">"
            End If
 
            FlexGrid.Row = lRow
            FlexGrid.Col = lCol
 
            ' If there's a picture in the current cell, then we save it
            If FlexGrid.CellPicture <> 0 Then SavePicture FlexGrid.CellPicture, PictureName(FlexGrid)
           
            Select Case FlexGrid.CellAlignment
            Case 0, 1, 2
                sHTML = sHTML & "<P ALIGN=""LEFT"">"
            Case 3, 4, 5
                sHTML = sHTML & "<P ALIGN=""CENTER"">"
            Case 6, 7, 8
                sHTML = sHTML & "<P ALIGN=""RIGHT"">"
            Case 9
                sHTML = sHTML & "<P ALIGN=""LEFT"">"
            End Select
 
            ' Cell format
            If (CLng(FlexGrid.CellForeColor) <> CLng(FlexGrid.ForeColor)) And Len(FlexGrid.Text) <> 0 Then sHTML = sHTML & "<FONT COLOR=""#" & GetHexicColorCode(FlexGrid.CellForeColor) & """>"
            If FlexGrid.CellFontBold = True Then sHTML = sHTML & "<STRONG>"
            If FlexGrid.CellFontItalic = True Then sHTML = sHTML & "<EM>"
            If FlexGrid.CellFontUnderline = True Then sHTML = sHTML & "<U>"
            If FlexGrid.CellPicture <> 0 Then sHTML = sHTML & "<IMG SRC=""" & PictureName(FlexGrid) & """>"
           
            ' The actual Cell Text
            sHTML = sHTML & FlexGrid.Text
           
            ' End cell formats
            If FlexGrid.CellFontBold = True Then sHTML = sHTML & "</STRONG>"
            If FlexGrid.CellFontItalic = True Then sHTML = sHTML & "</EM>"
            If FlexGrid.CellFontUnderline = True Then sHTML = sHTML & "</U>"
            If (CLng(FlexGrid.CellForeColor) <> CLng(FlexGrid.ForeColor)) And Len(FlexGrid.Text) <> 0 Then sHTML = sHTML & "</FONT>"
           
            sHTML = sHTML & "</P>"
            sHTML = sHTML & "</TD>" & vbNewLine
Continue:
        Next lCol
        sHTML = sHTML & vbTab & "</TR>" & vbNewLine
    Next lRow
   
    ' END </TABLE> TAG
    sHTML = sHTML & "</TABLE>" & vbNewLine
   
   
    ' Save the HTML to file
    Dim lHandle As Long
    lHandle = FreeFile
   
    Open "Index.htm" For Binary As #lHandle
    Put #lHandle, , sHTML
    Close #lHandle
   
    ' Success
    SaveFlexgridAsHTML = True
End Function


Private Function GetColSpan(FlexGrid As Object, ByVal Row As Long, Col As Long) As Long
    Dim lRow As Long
    Dim lCol As Long
    Dim I As Long
    Dim lSpan As Long
    If FlexGrid.MergeRow(Row) = False Then
        lSpan = 1
    Else
        FlexGrid.Row = Row
        FlexGrid.Col = Col
        ' Are we part of some colspan?
        If Compare(FlexGrid, Row, Col - 1, Row, Col) = True Then
            GetColSpan = 0
        Else
            lSpan = 1
            For I = Col To FlexGrid.Cols - 2
                If Compare(FlexGrid, Row, I, Row, I + 1) Then
                    lSpan = lSpan + 1
                Else
                    Exit For
                End If
            Next I
        End If
    End If
    GetColSpan = lSpan
End Function

Private Function GetRowSpan(FlexGrid As Object, ByVal Row As Long, Col As Long) As Long
    Dim lRow As Long
    Dim lCol As Long
    Dim I As Long
    Dim lSpan As Long
 
    If FlexGrid.MergeCol(Col) = False Then
        lSpan = 1
    Else
        FlexGrid.Row = Row
        FlexGrid.Col = Col
        ' Are we part of some rowspan?
        If Compare(FlexGrid, Row - 1, Col, Row, Col) = True Then
            GetRowSpan = 0
        Else
            lSpan = 1
            For I = Row To FlexGrid.Rows - 2
                If Compare(FlexGrid, I, Col, I + 1, Col) Then
                    lSpan = lSpan + 1
                Else
                    Exit For
                End If
            Next I
        End If
    End If
    GetRowSpan = lSpan
End Function

'Compares two cells in a flexgrid, returns true if they are equal
Private Function Compare(FlexGrid As Object, ByVal R1 As Long, ByVal C1 As Long, ByVal R2 As Long, ByVal C2 As Long) As Boolean
    If R1 < 0 Or C1 < 0 Or R2 < 0 Or C2 < 0 Then
        Compare = False
    ElseIf FlexGrid.TextMatrix(R1, C1) = "" Or FlexGrid.TextMatrix(R2, C2) = "" Then
        Compare = False
    ElseIf FlexGrid.TextMatrix(R1, C1) = FlexGrid.TextMatrix(R2, C2) Then
        Compare = True
    Else
        Compare = False
    End If
End Function

'Converts OLE_COLOR into RRGGBB
Private Function GetHexicColorCode(ByVal Color As Long) As String
    Dim lpszRed As String
    Dim lpszGreen As String
    Dim lpszBlue As String
    lpszBlue = Left(CStr(Hex(Color And RGB(0, 0, 255))), 2)
    lpszGreen = String(2 - Len(Left(CStr(Hex(Color And RGB(0, 255, 0))), 2)), "0") & Left(CStr(Hex(Color And RGB(0, 255, 0))), 2)
    lpszRed = String(2 - Len(Left(CStr(Hex(Color And RGB(255, 0, 0))), 2)), "0") & Left(CStr(Hex(Color And RGB(255, 0, 0))), 2)
    GetHexicColorCode = lpszRed & lpszGreen & lpszBlue
End Function

'Returns a filename for a picture in the current cell
Private Function PictureName(FlexGrid As Object) As String
    PictureName = "P" & FlexGrid.Row & "_" & FlexGrid.Col & ".bmp"
End Function



0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 

Author Comment

by:clarwc
Comment Utility
mtoft,

Looks like just what I need.  A couple of questions though.  I added a "Save" command button to my flexgrid and inserted the code from the save function in your code example.  When I try to execute I get an error message saying "Object Required and the debugger takes me to the line that says    
0
 

Author Comment

by:clarwc
Comment Utility
mtoft,

Looks like just what I need.  A couple of questions though.  I added a "Save" command button to my flexgrid and inserted the code from the save function in your code example.  When I try to execute I get an error message saying "Object Required and the debugger takes me to the line that says

SaveFlexgridAsHTML FlexGrid

Also when I inserted the code into my application the following line was red:

COLOR=""#" & GetHexicColorCode(FlexGrid.CellForeColor) & """>"

I think that means there is something missing.

If I attach the save function to a Save button then when would I call the code for the function SaveFlexgridAsHTML?

Thanks so much for all you have done to help me out.....

Warren
0
 
LVL 1

Expert Comment

by:wford
Comment Utility
I can help with the line it should be

COLOR= "#" & GetHexicColorCode(FlexGrid.CellForeColor) & ">"

But this is only for the syntax

I will not bother with my completed solution, unless you realy want it

Good luck
0
 

Author Comment

by:clarwc
Comment Utility
wford,

I am desperate for ANY solution to my problem.  If you are both working on it for me I could split the points.
0
 
LVL 2

Expert Comment

by:mtoft
Comment Utility
Hmm, the line looks OK to me...
Did you insert the function GetHexicColorCode ?

If you wish, I can email you the project.



The correct syntax is:

If (CLng(FlexGrid.CellBackColor) <> CLng(FlexGrid.BackColor)) And Len(FlexGrid.Text) <> 0 Then
    sHTML = sHTML & " BGCOLOR=""#" & GetHexicColorCode(FlexGrid.CellBackColor) & """ >"
Else
    sHTML = sHTML & ">"
End If

0
 

Author Comment

by:clarwc
Comment Utility
Was I correct in creating the Save button and moving the code for  the save function there???

Also why do I get an error message saying "Object Required and the debugger takes me to the line that says

       SaveFlexgridAsHTML FlexGrid

If you want to E-Mail me your code my address is clarwc@ispec.com  I would love to try ANYTHING that might work for me.....


Thanks again

Warren
0
 
LVL 2

Expert Comment

by:mtoft
Comment Utility
Ok, i mailed u the project...
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now