减少代码冗余机房

妖狐艹你老母 2022-05-09 05:33 296阅读 0赞

一：防止往下拉菜单输入：

Private Sub comboRelation2_KeyPress(KeyAscii As Integer) '防止输入字符
        KeyAscii = 0     'keyAscii=0?表示：取消本次输入的字符
    End Sub

二：定义一个检查文本框是否为空的函数：

在模块中设函数：

Public Function testtxt(txt As String) As Boolean         '参数是txt，即文本框内容
        If Trim(txt) = "" Then
           testtxt = False
        Else
           testtxt = True
        End If
    End Function

调用函数判断是不是为空（不仅仅限用文本框）

If Not testtxt(Combouser.Text) Then
        MsgBox "请选择用户级别！", vbOKOnly + vbExclamation, "提示"
        Combouser.SetFocus
        Exit Sub
    End If

三：设置case1：

Case1:
        With MSHFlexGrid1
            .Rows = 1
            .TextMatrix(0, 0) = "序列号"
            .TextMatrix(0, 1) = "教师"
            .TextMatrix(0, 2) = "级别"
            .TextMatrix(0, 3) = "注册日期"
            .TextMatrix(0, 4) = "注册时间"
            .TextMatrix(0, 5) = "注销日期"
            .TextMatrix(0, 6) = "注销时间"
            .TextMatrix(0, 7) = "机器名"
            .TextMatrix(0, 8) = "状态"
        End With

在同一个事件下面直接调用：GoTo Case1

四：限制特殊字符输入：

在模块中定义这个函数：

Public Function IsNumber(KeyAscii As Integer) As Integer
        Select Case KeyAscii
            Case 48 To 57    '只能输入数字
            Case 65 To 90    '只能输入大写字母
            Case 97 To 122   '只能输入小写字母
            Case 8           '只能输入退格
            Case Else       
            KeyAscii = 0     '无效
        End Select
    End Function

在窗体中调用函数：

Private Sub txtid_KeyPress(KeyAscii As Integer)
    Call IsNumber(KeyAscii)
            If Len(txtID) >= 3 Then    
               txtID.Text = ""  
               KeyAscii = 0    '输入字符清零
               MsgBox "输入字符位数过长", vbOKCancel, "提示"
            End If
    End Sub

不能输入特殊字符，也不能超过三个数。

五：导出为Excel：

在模块中放置：

Public Function EduceExcel(myGrid As MSFlexGrid) '定义导出Excel函数  
        Dim xlexc As New Excel.Application  '声明Excel对象
        Dim xlbook As Excel.Workbook   '声明工作簿对象
        Dim xlsheet As Excel.Worksheet  '声明工作表单
        Dim i As Integer
        Dim j As Integer
            If myGrid.Text = "" Then
                MsgBox "没有记录可导出", vbOKOnly + vbExclamation, "警告"
                Exit Function
            Else
                Set xlexc = CreateObject("excel.application")  '调用Excel程序
                Set xlbook = xlexc.Workbooks.Add(1)            '创建新的空白簿   
                Set xlsheet = xlbook.Worksheets(1)   '创建新的工作表单
            For i = 0 To myGrid.Rows - 1
            '填入数据
            For j = 0 To myGrid.Cols - 1
                xlsheet.Cells(i + 1, j + 1) = myGrid.TextMatrix(i, j)        'cell(a,b)表示a行，b列，这样写是因为vb中默认是从0开始的，而Excel是从1开始的
            Next j
            Next i
                xlexc.Visible = True         '显示Excel表格
                Set xlexc = Nothing          '交还控制给Excel
            End If
    End Function

在窗体上调用：

Private Sub CmdDerive_Click()
       Call EduceExcel(MSFlexGrid1)
    End Sub