个人收藏的VB精典实用源代码。
若朋友您想要问如何才能学好vb，或者入门需要看什么教材一类的问题，建议你抱着一颗刻苦钻研的心去面对这门学问，多动脑，少提问，遇到不知道的，多查资料，多看看帖子，或者用断点来亲自试验。实在不会了，请在此贴中查找您的常见问题，如果还没有，那请您发出新贴，向各位高手讨教：）
查找方法：按ctrl+f，输入要查找的问题关键字即可
每个问题中间用///分隔，这只是一部分最常见到的问题，以后会逐渐更新。
////////////////////////////////////////////////////////////////////////////////////
如何用VB建立快捷方式
Private Declare Function fCreateShellLink Lib \(ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
Sub Command1_Click() Dim lReturn As Long '添加到桌面
lReturn = fCreateShellLink(\'添加到程序组
lReturn = fCreateShellLink(\'添加到启动组
lReturn = fCreateShellLink(\End Sub
//////////////////////////////////////////////////////////////////////////////////// 如何让程序在 Windows 启动时自动执行？
有以下二个方法：
方法1: 直接将快捷方式放到启动群组中。
方法2:
在注册档 HKEY_LOCAL_MACHINE 中找到以下机码 \\Software\\Microsoft\\Windows\\CurrentVersion\\Run 新增一个字串值，包括二个部份
1. 名称部份：自己取名，可设定为 AP 名称。
2. 资料部份：则是包含 '全路径档案名称' 及 '执行参数'
例如：
Value Name = Notepad
Value Data = c:\\windows\\notepad.exe
////////////////////////////////////////////////////////////////////////////////////
在 TextBox 中如何限制只能输入数字？
参考下列程序：
Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End Sub
////////////////////////////////////////////////////////////////////////////////////
我希望 TextBox 中能不接受某些特定字符，例如 '@#$%\，有没有简单一点的写法？
方法有好几种, 以下列举二种：
方法1: 可以使用 IF 或 Select Case 一个个判断, 但如果不接受的字符多时, 较麻烦! 方法2: 将要剔除的字符统统放在一个字串中，只要一个 IF 判断即可 !! 如下： Private Sub Text1_KeyPress(KeyAscii As Integer) Dim sTemplate As String
sTemplate = \用来存放不接受的字符 If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then KeyAscii = 0 End If End Sub
//////////////////////////////////////////////////////////////////////////////////// 如何让鼠标进入 TextBox 时自动选定 TextBox 中之整串文字？
这个自动选定反白整串文字的动作，会使得输入的资料完全取代之前在 TextBox 中的所有字符。
Private Sub Text1_GotFocus() Text1.SelStart = 0
Text1.SelLength = Len(Text1) End Sub
//////////////////////////////////////////////////////////////////////////////////// 如何检查软盘驱动器里是否有软盘？
使用：
Dim Flag As Boolean
Flag = Fun_FloppyDrive(\
If Flag = False Then MsgBox \驱没有准备好，请将磁盘插入驱动器！\
'-------------------------------
'函数:检查软驱中是否有盘的存在 '-------------------------------
Private Function Fun_FloppyDrive(sDrive As String) As Boolean On Error Resume Next
Fun_FloppyDrive = Dir(sDrive) <> \End Function
////////////////////////////////////////////////////////////////////////////////////
如何弹出和关闭光驱托盘？
Option Explicit
Private Declare Function mciSendString Lib \Alias \(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Sub Command1_Click()
mciExecute \弹出光驱 Label2.Caption = \弹出\End Sub
Private Sub Command2_Click() Label2.Caption = \关闭\
mciExecute \合上光驱 Unload Me End End Sub
//////////////////////////////////////////////////////////////////////////////////// 如何让你的程序在任务列表隐藏
Private Declare Function RegisterServiceProcess Lib \(ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib \
'请你试试 Ctrl+Alt+Del 是不是你的程序隐藏了
Private Sub Command1_Click()
i = RegisterServiceProcess(GetCurrentProcessId, 1) End Sub
//////////////////////////////////////////////////////////////////////////////////// 如何用程序控制滑鼠游标 (Mouse Cursor) 到指定位置？
以下这个例子，当 User 在 Text1 中按下 'Enter' 键后，滑鼠游标会自动移到 Command2 按钮上方
请在声明区中加入以下声明：
'16 位版本： ( Sub 无传回值 )
Declare Sub SetCursorPos Lib \
'32 位版本： ( Function 有传回值，Integer 改成 Long )
Declare Function SetCursorPos Lib \
'在 Form1 中加入以下程序码：
Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then
x% = (Form1.Left + Command2.Left + Command2.Width / 2 + 60) / Screen.TwipsPerPixelX y% = (Form1.Top + Command2.Top + Command2.Height / 2 + 360) / Screen.TwipsPerPixelY SetCursorPos x%, y% End If End Sub
//////////////////////////////////////////////////////////////////////////////////// 如何用鼠标移动没有标题的 Form，或移动 Form 中的控制项？
在声明区中放入以下声明：
'16 位版本： ( Sub 无返回值 )
Private Declare Sub ReleaseCapture Lib \
Private Declare Sub SendMessage Lib \(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Long)
'32 位版本： ( Function 有返回值，Integer 改成 Long ) Private Declare Function ReleaseCapture Lib \
Private Declare Function SendMessage Lib \ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'共用常数：
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF012
'若要移动 Form，程序码如下：
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Long
i = ReleaseCapture
i = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0) End Sub
'以上功能也适用于用鼠标在 Form 中移动控制项，程序码如下：
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Long
i = ReleaseCapture
i = SendMessage(Command1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0) End Sub
//////////////////////////////////////////////////////////////////////////////////// 检查文件是否存在？
Function FileExists(filename As String) As Integer Dim i As Integer
On Error Resume Next i = Len(Dir$(filename))
If Err Or i = 0 Then FileExists = False Else FileExists = True End Function
////////////////////////////////////////////////////////////////////////////////////
如何设置对VB数据库连接的动态路径
我个人因为经常作一些数据库方面的程序，对于程序间如何与数据库进行接口的问题之烦是深有体会，因为VB在数据库链接的时候，一般是静态，即数据库存放的路径是固定的，如用VB的DATA，adodc,DataEnvironment 等到作数据库链接时，如果存放数据库的路径被改变的话，就会找不到路经，真是一个特别烦的事。 笔者的解决方法是利用app.path 来解决这个问题。 一、用data控件进行数据库链接，可以这样： 在form_load()过程中放入： private form_load() Dim str As String '定义 str = App.Path
If Right(str, 1) <> \str = str + \End If
data1.databasename=str & \数据库名\data1.recordsource=\数据表名\
VB精典实用源代码（详细）
