Miscellaneous VB 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
APP Already Running?
'vb
If App.PrevInstance Then
msgbox "Program is already running.
Exit Sub
End If
Center Form
'vb
Top = Screen.Height / 2 - Height / 2
Left = Screen.Width / 2 - Width / 2
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
Clipboard Cut Text
'Need VB, 1 textbox
ClipBoard.SetText Text1.SelText
Text1.SelText = ""
ClipBoard Copy Text
'Need VB, 1 textbox
ClipBoard.SetText Text1.SelText
Clipboard Paste Text
'Need VB, 1 textbox
Text1.SelText = ClipBoard.GetText
Delete File
'vb
On Error GoTo error
Kill FilePath$
Exit Sub
error: MsgBox Err.Description, vbExclamation, "Error"
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
File Exist?
'vb4+
Public Function FileExists(strPath As String) As Integer
FileExists = Not (Dir(strPath) = "")
End Function
File Size
'vb
Dim FileSize As Long
FileSize& = FileLen("C:\SOMEFILE.TXT")
msgbox filesize& & " bytes"
Get screen size in pixels
'vb
Width% = Screen.Width \ App.TwipsPerPixelX
Height% = Screen.Height \ App.TwipsPerPixelY
Highlight Textbox Text on Focus
'textbox
Sub Text1_GotFocus()
Text1.SelStart = 0
Text1=SelLength = Len(Text1)
End Sub
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
No textbox popup menu
'textbox
If button=2 Then
text1.enabled=false
popupmenu menuname
text1.enabled=true
text1.setfocus
Numer of characters in a textbox including spaces
'textbox
Dim TheNum as string
TheNum$ = Len(Text1)
Msgbox TheNum$
PW Protect
'Need 1 button and 1 textbox
If Text1 = "password" Then
MsgBox "Thats the pw"
Else
MsgBox "Wrong pw try again"
End If
Reverse a string
'vb5+
Text1.Text = StrReverse("String")
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
Sendkey Controls
| ^ | 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 |
Textbox Scroll to Bottom
'1 Textbox
Text1.SelStart = Len(Text1.Text)
Time and Date
'vb
Msgbox "The time is " & Time
Msgbox "The date is " & Date
Uppercase and Lowercase a string
'vb
text1.text = lcase("String")
text1.text = ucase("String")
Special Instructions
These code snippets were recovered from vbcodesource.com, which went offline years ago.
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.