Click here to Skip to main content
15,867,330 members
Articles / Programming Languages / Visual Basic

Export UI Controls Aspect Information from 'Form' to Excel sheet

Rate me:
Please Sign up or sign in to vote.
5.00/5 (2 votes)
11 Jan 2010CPOL2 min read 17K   389   2   1
Exports UI control settings from a Form to an Excel sheet.

Executive summary

In this article, we will see how to export control details of a VB form into an Excel sheet in a simple manner.

Nowadays, many tools (both online and standalone) are available in market to upgrade code or translate or convert code from one programming language to another and so on, but do they concentrate on the UI layer too? The answer is doubtful.

Yes, UI look and feel is mostly considered the least priority, which really consumes 75% of your time. They have cosmetic values that give aesthetic effects to the user, as they will distract the client easily as his end users might be used to the legacy screens they usually expect.

ASP to ASP.NET upgrade comes as a built-in component with Visual Studio.

Introduction

In case of VB application conversion, rewriting to another language really needs a huge effort for the UI layer, mainly in the look and feel aspect. Usually, developers open a VB form and get each and every property of each control and apply the same in the converted code too.

Purpose

Instead of opening a VB form (UI Layer) manually to get the height, width (properties) and other styles of each control, we can export it programmatically using a simple VB code into an Excel sheet, with form name as the spreadsheet name, and use the sheet while setting control values in the rewritten/reengineered/migrated program file to maintain consistency in the UI look and feel.

How to use it?

Copy the following code in your form and call it in the button click event to generate the Excel sheet with the control setting information.

VBScript
Private Function GetFormData(ByRef xi_astrData As String) As String

    Call LetPropertyType

    'On Error GoTo LoadFormErr
    Dim p_strLine               As String
    Dim p_astrData()            As String
    Dim p_objFSO                As FileSystemObject
    Dim p_objTextStream         As TextStream

    ' This is the data
    Dim p_strControlDetail      As String
    Dim p_strFormName           As String
    Dim p_sFormName             As String
    Dim p_sTOP                  As String
    Dim p_sLeft                 As String
    Dim p_sHEIGHT               As String
    Dim p_sWIDTH                As String
    Dim p_sIndex                As String
    Dim p_sTabIndex             As String
    Dim p_strCntrlName          As String
    Dim p_strCntrlType          As String
    Dim p_sCaption              As String
    Dim p_skipControl           As String
    Dim p_strControlName        As String
    Dim p_strControl            As String
    Dim p_strControlProperties  As String
    Dim p_strControlTypes()     As String
    Dim p_strControlType        As String


   ' ------------------------------------------
   ' Clear the textbox
   ' ------------------------------------------

    p_strControlDetail = vbNullString
    p_strControlProperties = vbNullString

    ' ------------------------------------------
    ' Open the file
    ' ------------------------------------------

    On Error GoTo LoadFormErr2
    Set p_objFSO = New FileSystemObject
    Set p_objTextStream = p_objFSO.OpenTextFile(fileName:=xi_astrData, _
                                       IOMode:=ForReading, _
                                       Create:=False)

    On Error GoTo LoadFormErr

    Do While Not p_objTextStream.AtEndOfStream
        p_strLine = p_objTextStream.ReadLine()
        p_astrData = Split(p_strLine, "=")

        If Len(Trim$(p_strLine)) > 0 Then
        '===============================================
        ' Getting Control type of the Form
        '=================================================
            If UCase$(Left$(Trim$(p_strLine), 6)) = "BEGIN " Then
                rsForm.AddNew
                rsForm!FormName = p_sFormName
                rsForm!ControlType = p_strCntrlName
                rsForm!ControlName = p_strCntrlType

                If (Len(p_sIndex) > 0) Then
                    rsForm![ControlName] = p_strCntrlType + _
                       "(" + p_sIndex + ")"
                End If

                rsForm!Caption = p_sCaption
                rsForm!Index = p_sIndex
                rsForm!Top = p_sTOP

                If (Len(p_sTOP) > 0) Then
                    rsForm![Top(*065)] = _
                      Conversion.CStr((Conversion.Int(p_sTOP) * 0.065))
                End If

                rsForm!Width = UCase$(Trim$(p_sWIDTH))

                If (Len(p_sWIDTH) > 0) Then
                    rsForm![WIDTH(*065)] = _
                      Conversion.CStr((Conversion.Int(p_sWIDTH) * 0.065))
                End If

                rsForm!Left = UCase$(Trim$(p_sLeft))

                If (Len(p_sLeft) > 0) Then
                    rsForm![Left(*065)] = _
                      Conversion.CStr((Conversion.Int(p_sLeft) * 0.065))
                End If

                rsForm!Height = UCase$(Trim$(p_sHEIGHT))

                If (Len(p_sHEIGHT) > 0) Then
                    rsForm![Height(*065)] = _
                      Conversion.CStr((Conversion.Int(p_sHEIGHT) * 0.065))
                End If

                rsForm!TabIndex = UCase$(Trim$(p_sTabIndex))
                rsForm.Update
                rsForm.MoveFirst

                p_sCaption = ""
                p_sTOP = ""
                p_sLeft = ""
                p_sHEIGHT = ""
                p_sWIDTH = ""
                p_sIndex = ""
                p_strCntrlName = ""
                p_strCntrlType = ""
                p_sTabIndex = ""
                p_strControl = UCase$(Trim$(p_strLine))
                p_strControl = UCase$(Replace(p_strControl, "BEGIN ", _
                                      "", 1, -1, vbBinaryCompare))
                p_strControl = UCase$(Replace(p_strControl, " ", _
                                      ",", 1, -1, vbBinaryCompare))
                p_strControlTypes = Split(p_strControl, ",")
                p_strControlType = p_strControlTypes(0) + ":" + _
                                   p_strControlTypes(1)
                p_strCntrlName = p_strControlTypes(0)
                p_strCntrlType = p_strControlTypes(1)

                If (p_strControlTypes(0) = "VB.FORM") Then
                    p_sFormName = p_strControlTypes(1)
                End If
            End If

            Select Case UCase$(Trim$(p_astrData(0)))
                Case "CAPTION"
                    p_sCaption = p_astrData(1)
                Case "CLIENTHEIGHT"
                    p_sHEIGHT = UCase$(Trim$(p_astrData(1)))
                Case "CLIENTWIDTH"
                    p_sWIDTH = UCase$(Trim$(p_astrData(1)))
                Case "CLIENTTOP"
                    p_sTOP = UCase$(Trim$(p_astrData(1)))
                Case "CLIENTLEFT"
                    p_sLeft = UCase$(Trim$(p_astrData(1)))
                Case "INDEX"
                    p_sIndex = UCase$(Trim$(p_astrData(1)))
                Case "TABINDEX"
                    p_sTabIndex = UCase$(Trim$(p_astrData(1)))
                Case "HEIGHT"
                    p_sHEIGHT = UCase$(Trim$(p_astrData(1)))
                Case "WIDTH"
                    p_sWIDTH = UCase$(Trim$(p_astrData(1)))
                Case "TOP"
                    p_sTOP = UCase$(Trim$(p_astrData(1)))
                Case "LEFT"
                    p_sLeft = UCase$(Trim$(p_astrData(1)))
                Case "NAME"
                    p_strControlProperties = p_strControlProperties + _
                                vbCrLf + "NAME : " + p_astrData(1)
                '  Case "ICON"
                '  Case "KEYPREVIEW"
                '  Case "LINKTOPIC"
                '  Case "ENABLED"
                '  Case "ALIGN"
                '  Case "ALIGNMENT"
                '  Case "DRAGICON"
                Case "USEIMAGELIST"
                '  Case "PICTUREBACKGROUNDUSEMASK"
                '  Case "HASFONT"
                '  Case "IMAGELIST"
                '  Case "DATAFIELDLIST"
                Case Else
                    'do nothing
            End Select
        End If

    Loop
    p_objTextStream.Close
    Set p_objFSO = Nothing
    GetFormData = "" ' p_strControlType + _
                  vbCrLf + p_strControlProperties
    Exit Function

LoadFormErr:
    MsgBox "Error in LoadForm function" & vbCrLf & _
            "Error was: " & Err.Number & _
            ", " & Err.Description
    Exit Function

LoadFormErr2:
    MsgBox "Error opening the Form, " & xi_astrData & vbCrLf & _
           "Error: " & Err.Number & ", " & Err.Description
End Function

Helper methods for the above method builds a Recordset object with the expected fieldname to store the control property values, and create an Excel sheet to export the data from the Recordset.

Here is how we add the required properties as field names in the Recordeset:

VBScript
Private Function Buildrs() As ADODB.Recordset//

    Dim rs As ADODB.Recordset

    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.CursorType = adOpenStatic
    rs.Fields.Append "FormName", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "ControlType", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "ControlName", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "CAPTION", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "HEIGHT", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "HEIGHT(*065)", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "WIDTH", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "WIDTH(*065)", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "TOP", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "TOP(*065)", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "LEFT", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "LEFT(*065)", adVarChar, 100, adFldIsNullable
    rs.Fields.Append "INDEX", adVarChar, 3, adFldIsNullable
    rs.Fields.Append "TABINDEX", adVarChar, 5, adFldIsNullable

   ' rs.Fields.Append "PropertyValue(*065)", _
   '                  adVarChar, 100, adFldIsNullable
    rs.Open

    Set Buildrs = rs
End Function

Here is how we create an Excel sheet to bind the Recordset to it:

VBScript
////
Public Function CreateExcelSS(ByVal objRs As ADODB.Recordset)

    Dim rst As ADODB.Recordset
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xl2Sheet As Excel.Worksheet
    Dim fileName()  As String
    Dim conSheetName  As String
    Dim i As Integer
    Dim FC As Byte ' # fields from crosstab query.

On Error GoTo HandleErr

    ' Create Excel Application object
    Set xlApp = New Excel.Application
    ' Create a new workbook
    Set xlBook = xlApp.Workbooks.Add

    xlApp.DisplayAlerts = False
    xlApp.DisplayAlerts = True
    xlApp.Worksheets.Add

    ' Capture reference to first worksheet
    Set xlSheet = xlBook.ActiveSheet
    fileName = Split(m_strFileName, "\")
    conSheetName = fileName(UBound(fileName) - 1)
    xlSheet.Name = conSheetName    ' Change the worksheet name

    ' Create recordset
    Set rst = New ADODB.Recordset
    Set rst = objRs
    FC = rst.Fields.Count

    With xlSheet
        For i = 1 To FC
            ' Copy field names to Excel using count of fields, which is
            ' necessary because the number of output fields 
            ' in a crosstab query is not fixed.
            ' Bold the column headings and insert field names. Starting
            ' position A1. The variable 'i' advances the cursor one cell 
            ' to the right for each additional field.

            With .Cells(1, i)
                .Value = rst.Fields(i - 1).Name
                .Font.Bold = True
            End With
        Next

        ' Copy all the data from the recordset into the spreadsheet.
        .Range("A2").CopyFromRecordset rst
        
        ' Format the data
        ' Causes all columns to autofit.
        For i = 1 To FC
            .Columns(i).AutoFit
        Next
    End With

    rst.Close

    'Stop
    'Display the Excel chart
    xlApp.Visible = True
    ' xlApp.close

ExitHere:
    On Error Resume Next
    ' Clean up
    rst.Close
    Set rst = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Function

HandleErr:
    MsgBox Err & ": " & Err.Description, , _
           "Error in CreateExcelSS"
    Resume ExitHere
    Resume

End Function

What does it do?

The code opens the VB form file into a reader stream and reads it to get the properties you need for all the controls, and writes the same into an Excel sheet.

Conclusion

This article will help you in exporting control details of a VB form into an Excel sheet in a simple manner.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Architect
India India
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions

 
General- Pin
rahele12-Jan-10 20:05
rahele12-Jan-10 20:05 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.