出口UI控件从“形式”Excel表方面的信息

• 下载source code - 5.57 KB

执行概要 在这篇文章中，我们将看到如何以一种简单的方式将VB表单的控制细节导出到Excel表格中。 如今，市场上有许多工具(在线的和独立的)可以用于升级代码，或者将代码从一种编程语言转换为另一种编程语言等等，但是它们也专注于UI层吗?答案是可疑的。 是的，UI外观通常被认为是最不重要的，它确实消耗了75%的时间。它们具有外观价值，可以为用户提供美学效果，因为它们会很容易地分散客户的注意力，因为最终用户可能已经习惯了他们通常期望的遗留屏幕。 ASP ASP。NET升级是Visual Studio的内置组件。 介绍 在VB应用程序的转换中，将其重写为另一种语言确实需要在UI层上付出巨大的努力，主要是在外观和感觉方面。通常，开发人员打开VB窗体，获取每个控件的每个属性，并在转换后的代码中应用相同的属性。 目的 而不是打开一个VB形式(界面层)手动高度,宽度(属性)和其他风格的每个控制,我们可以以编程方式使用一个简单的VB代码导出到一个Excel表,与表单名称表格名称,并使用重写的负债状况的影响,设置控制值/再造工程/程序文件迁移到保持一致性的UI的外观和感觉。 如何使用它? 在窗体中复制以下代码，并在单击按钮事件中调用它，以生成具有控件设置信息的Excel表。 隐藏,收缩,复制Code

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方法用预期的fieldname构建一个记录集对象来存储控件属性值，并创建一个Excel表来从记录集导出数据。 下面是我们如何在记录集中添加必需的属性作为字段名: 隐藏,收缩,复制Code

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

下面是我们如何创建一个Excel表格来绑定记录集: 隐藏,收缩,复制Code

////
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

它是做什么的? 该代码将VB窗体文件打开到一个阅读器流中，并读取它以获得所有控件所需的属性，并将相同的属性写入Excel表中。 结论 这篇文章将帮助你以一种简单的方式将VB窗体的控件细节导出到Excel表格中。 本文转载于：http://www.diyabc.com/frontweb/news2180.html