If you are looking for a snippet i don't have or want to submit Email Me
Visual Basic Snippets
Allow certain characters in a textbox
'1 textbox
'put in keypress procedure of textbox Const Numbers$ = "0123456789." If KeyAscii <> 8 Then If InStr(Numbers, Chr(KeyAscii)) = 0 Then MsgBox "error" KeyAscii = 0 Exit Sub End If End If
top
APP Already Running?
'vb
If App.PrevInstance Then msgbox "Program is already running. Exit Sub End If
top
Center Form
'vb
Top = Screen.Height / 2 - Height / 2 Left = Screen.Width / 2 - Width / 2
top
Clear all Textboxes on Form
'vb
Public Sub ClearAllText(frm As Form, ctl As Control) For Each ctl In frm If TypeOf ctl Is TextBox Then ctl.Text="" End If Next ctl
top
Clipboard Cut Text
'Need VB, 1 textbox
ClipBoard.SetText Text1.SelText Text1.SelText = ""
top
ClipBoard Copy Text
'Need VB, 1 textbox
ClipBoard.SetText Text1.SelText
top
Clipboard Paste Text
'Need VB, 1 textbox
Text1.SelText = ClipBoard.GetText
top
Delete File
'vb
On Error GoTo error Kill FilePath$ Exit Sub error: MsgBox Err.Description, vbExclamation, "Error"
top
Directory Exist?
'vb5+
f$ = "C:\WINDOWS" dirFolder = Dir(f$, vbDirectory) If dirFolder <> "" Then strmsg = MsgBox("This folder already exists.", vbCritical) 'directory exists action here End If
top
File Exist?
'vb4+
Public Function FileExists(strPath As String) As Integer FileExists = Not (Dir(strPath) = "") End Function
top
File Size
'vb
Dim FileSize As Long FileSize& = FileLen("C:\SOMEFILE.TXT") msgbox filesize& & " bytes"
top
Get screen size in pixels
'vb
Width% = Screen.Width \ App.TwipsPerPixelX Height% = Screen.Height \ App.TwipsPerPixelY
top
Highlight Textbox Text on Focus
'textbox
Sub Text1_GotFocus() Text1.SelStart = 0 Text1=SelLength = Len(Text1) End Sub
top
Limit text input
'vb
Function LimitTextInput(source) As String 'put the next line in the Textbox_KeyPress event 'KeyAscii = LimitTextInput(KeyAscii) 'change Numbers with any other character Const Numbers$ = "0123456789." 'backspace =8 If source <> 8 Then If InStr(Numbers, Chr(source)) = 0 Then LimitTextInput = 0 Exit Function End If End If LimitTextInput = source End Function
top
No textbox popup menu
'textbox
If button=2 Then text1.enabled=false popupmenutext1.enabled=true text1.setfocus
top
Numer of characters in a textbox including spaces
'textbox
Dim TheNum as string TheNum$ = Len(Text1) Msgbox TheNum$
top
PW Protect
'Need 1 button and 1 textbox
If Text1 = "password" Then MsgBox "Thats the pw" Else MsgBox "Wrong pw try again" End If
top
Reverse a string
'vb5+
Text1.Text = StrReverse("String")
top
Search a Listbox
'Need 1 button, 1 textbox, 1 listbox 'Name textbox = txtSearch, Name listbox = lstSearch
Dim theList As Long Dim textToSearch as String Dim theListText As String textToSearch = LCase(txtSearch.Text) For theList = 0 To lstSearch.ListCount - 1 theListText = LCase(lstSearch.List(theList)) If theListText = textToSearch Then lstSearch.Text = textToSearch Next
top
Sendkey Controls
'vb
^ = Control {enter} = Enter % = Alt {Del} = Delete {ESCAPE} = Escape {TAB} = Tab + = Shift {BACKSPACE} = Backspace {BREAK} = Break {CAPLOCKS} = Caps Lock {CLEAR} = Clear {DELETE} = Delete {DOWN} = Down Arrow {LEFT} = Left Arrow {RIGHT} = Right Arrow {UP} = Up Arrow {NUMLOCK} = Num Lock {PGDN} = Page Down {PGUP} = Page Up {SCROLLLOCK} = Scroll Lock {F1} = F1 .......Use {F2} {F3} and so on for others... {HOME} = home {INSERT} = Insert
top
Textbox Scroll to Bottom
'1 Textbox
Text1.SelStart = Len(Text1.Text)
top
Time and Date
'vb
Msgbox "The time is " & Time Msgbox "The date is " & Date
top
Uppercase and Lowercase a string
'vb
text1.text = lcase("String") text1.text = ucase("String")
top
