VB_小技巧     获取X字符串包含字母“B”的数量，最简单方法===========================    UBound(Split(x, "B"))剪贴板相关===========================================================　　'全选 　　Private Sub mnuSelectAll_Click() 　　RichTextBox1.SelStart = 0 　　RichTextBox1.SelLength = Len(RichTextBox1.Text) 　　End Sub 　　 　　'粘贴 　　Private Sub mnuPaste_Click() 　　RichTextBox1.SelText = Clipboard.GetText 　　End Sub 　　 　　'查找 　　Private Sub mnuFind_Click() 　　sFind = InputBox("请输入要查找的字、词：", "查找内容", sFind) 　　RichTextBox1.Find sFind 　　End Sub 　　 　　'继续查找 　　Private Sub mnuFindOn_Click() 　　RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength + 1 　　RichTextBox1.Find sFind, , Len(RichTextBox1) 　　End Sub TextBox操作==========================================================1、限制只能输入数字参考下列程序：Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii < 48 Or KeyAscii > 57 ThenKeyAscii = 0End IfEnd Sub2、屏蔽特定字符Private Sub Text1_KeyPress(KeyAscii As Integer)    Dim sTemplate As String    sTemplate = "!@#$%^&*()_+-="   '用来存放不接受的字符    If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then        KeyAscii = 0    End IfEnd Sub识别鼠标两键同时按下=================================================Dim OneDown As DoubleDim ToDown As IntegerPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)    ToDown = 0    If OneDown + 0.1 < Timer Then        OneDown = Timer        Do While OneDown + 0.1 > Timer            DoEvents            If ToDown <> 0 Then Exit Do        Loop        If ToDown <> 0 Then            Print ToDown + Button        Else            Print Button        End If    Else        ToDown = Button    End IfEnd Sub消息框中按钮之定义===================================================    MsgBox strMsg1, c1+c2+c3 , strMsg2    其中  strMsg1   为提示信息          strMsg2   为标题内容          c1+c2+c3  定义按钮形式，具体如下：          c1: 按钮的类型            0    vbOkOnly             只有一个按钮“确定”            1    vbOkCancel           两个按钮“确定”和“取消”            2    vbAbortRetryIgnore   三个按钮“终止”、“重试”和“忽略”            3    vbYesNoCancel        三个按钮“是”、“否”和“取消”            4    vbYesNo              两个按钮“是”和“否”            5    vbRetryCancel        两个按钮“重试”和“取消”              返回值：  vbOk          1   确定                        vbCancel      2   取消                        vbAbort       3   终止                        vbRetry       4   重试                        vbIgnore      5   忽略                        vbYes         6   是                        vbNo          7   否          c2: 图标的类型                     16   vbCritical           ×            32   vbQuesion            ？            48   vbExclamation        ！            64   vbInformation        i        c3: 默认焦点            0    vbDefalaultButton1   左起第一个按钮自动获得焦点            256  vbDefalaultButton2   左起第二个按钮自动获得焦点            512  vbDefalaultButton3   左起第三个按钮自动获得焦点        和为：   00  0000  0000　B             　　c3   c2    c1   例： 1.   i = MsgBox " 是否要删除该条记录 ? ", 1+32+0 , " 请确认"        2.   MsgBox " 是否要删除 ! ", 0+32+0 , " 请...."数据库===============================================================1)判断表的存在Function M_fucScanTable(strTName As String) As Integer ' 搜索表 strTableName     On Error GoTo OpenErr     Set MyRsm = New Recordset   MyRsm.Open "Select * From " & strTName,Cn, adOpenKeyset, adLockOptimistic        MyRsm.MoveLast        M_fucScanTable = MyRsm.RecordCount        ' 返回记录数，0 为空表        MyRsm.Close        Set MyRsm = Nothin        Exit Function    OpenErr:        M_fucScanTable = -1                                   ' 无表    End Function   2)动态建立表       strSQL = "CREATE TABLE " & strTName & _        "( Xh char(3) Not Null Primary key,Mc char(10),Xb char(2)," & _        "Csrq char(10),Zw char(20),Gz numeric(9,2),Bz char(30),Xp image )"       cn.Execute strSQL, , adCmdText       其中： Primary key 为设置主键（唯一）3)插入记录     Insert         strSQL = "Insert Into A01(Xh,Mc,Xb,Csrq,Zw) " & _       "Values ( '" & Xhp & "','" & Mcp & "','" & Xbp &"','" &Rqp& "','" & Zwp & "' "        Cn.Execute strSQL4)导出表格到excel    Dim newxls As Excel.Application    Dim newbook As Excel.Workbook    Dim newsheet As Excel.Worksheet    Set newxls = CreateObject("excel.application")    newxls.Visible = True    Set newbook = newxls.Workbooks.Add    Set newsheet = newbook.Worksheets(1)    For i = 0 To 7        For j = 0 To 4            MSFlexGrid1.Row = i            MSFlexGrid1.col = j            newsheet.Cells(1, 3) = Trim(Combo1.Text) & "班"            newsheet.Cells(1, 4) = "第" & bytXq & "学期"            newsheet.Cells(1, 5) = "课程表"            newsheet.Cells(i + 3, j + 2) = Trim(MSFlexGrid1.TextMatrix(i, j))        Next j    Next i    注意此项操作你先要 引用 excelctl type library 和 microsoft excel 9.0 object library隐藏任务栏===========================================================Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _            ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Sub Form_Load()        SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3End Sub获取CPU信息的方法引用Microsoft WMI Scripting V1.2 LibraryPrivate Function GetProcessorID()Dim A1 As SWbemServicesDim A2 As SWbemObjectSetDim A3 As SWbemObjectDim A4 As SWbemPropertySetDim A5 As SWbemPropertySet A1 = GetObject("winmgmts:")Set A2 = A1.InstancesOf("Win32_Processor")For Each A3 In A2   With A3    If .Properties_.Count > 0 Then     Set A4 = .Properties_     For Each A5 In A4      'A5.Name为信息名称      'A5.Value为信息值      '如果只获取CpuID可以不修改一下代码，否则可以创建一个Text,改为多行文本来接收A5.Name和A5.Value的信息。      'text1.text = A5.Name & ":" & A5.Value      If InStr(StrConv(A5.Name, 2), "processorid") <> 0 Then        GetProcessorID = A5.Value      End If     Next    End If   End WithNextEnd Function一个实现Winsock直接获得返回数据的函数================================主要应用：有时候不希望Winsock的数据收发独立，即希望发送数据直接获得结果。这个函数正实现了这一功能备注:    1、带有“*”的部分已经被省略，主要功能是激活一个进度条用来监视等待数据下载的时间    2、这个函数需要两个事件协作完成       1)KeyPass事件，用来确定是否按下Esc终止等待       2)DataArrival事件，用来确定是否传回数据函数使用方法:    SendData 数据,[是否立即获取数据],[*是否前台执行],[超时时间]    []为可选参数Dim Ws as WinsockDim DbInfo As StringPublic KeyPassEsc As Boolean    ''是否按下Esc，传输进度条用Public Function SendData(Db As String, Optional GetDb As Boolean = True, Optional FormTop As Boolean = True, Optional EndTime As Integer = 10) As String''发送数据函数    Dim ToTime As Double    ''定义连接超时时间    ToTime = Timer + EndTime        ''初始化终止开关    DbGetOk = False    KeyPassEsc = False    Ws.SendData Db  ''''发送数据    Do While ToTime > Timer ''''侦听接收情况        DoEvents        If GetDb = False Or DbGetOk Or KeyPassEsc Then            Exit Do        End If    Loop    If DbGetOk Then        SendData = DbInfo    ElseIf GetDb Then        SendData = "获得数据超时，请尝试重新执行程序！"    End IfEnd FunctionPrivate Sub WS_DataArrival(ByVal bytesTotal As Long) ''当新数据到达时出现    Ws.GetData DbInfo, vbString    DbGetOk = TrueEnd SubPrivate Sub Form_KeyPress(KeyAscii As Integer) ''是否按下Esc    If KeyAscii = 27 Then KeyPassEsc = TrueEnd Sub'********************************************'MSFlexGrid在强制整行选则情况下实现排序''功能：在单击表头时对根据当前列进行排序，在单'      击数据区域时进行整行选择''2005-09-12 FieldMAX'******************************************** Private Sub Form_Load()'创建一个8*8的MSFlexGrid并在其中填入随机数Dim i As LongDim j As LongMSFlexGrid1.Rows = 8MSFlexGrid1.Cols = 8MSFlexGrid1.FormatString = "     |  A  |  B  |  C  |  D  |  E  |  F  |  G  "For i = 1 To 7    MSFlexGrid1.TextMatrix(i, 0) = i    For j = 1 To 7        MSFlexGrid1.TextMatrix(i, j) = Int(Rnd * 1000)        n = n + 1    NextNextEnd Sub Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)'在MSFlexGrid的实际应用中经常需要强制整行选并且还需要排序功能，'但是由于MSFlexGrid本身的缺陷，在正常强况下是无法实现两则兼得的。'唯一的变通方法就是使用MouseDown或MouseUp事件独有的"X","Y"坐标来'确定点击的列，在进行排序。Dim i As LongDim Cw As Long'如果Y坐标点击的是表头区域If y > MSFlexGrid1.Top And y < MSFlexGrid1.RowHeight(0) + MSFlexGrid1.Top Then    Cw = MSFlexGrid1.Left'用循环语句判断X在那一列，I代表列数    For i = 0 To MSFlexGrid1.Cols - 1        Cw = Cw + MSFlexGrid1.ColWidth(i)        If x < Cw Then Exit For    Next    MSFlexGrid1.Col = i     '定位列坐标    MSFlexGrid1.Sort = 1    '进行升序排列End IfEnd Sub

评论