23 Handy codes

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
    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
'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


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")