General Problem For new User

This the code bank for the newly appear user who face some common problem always or starting. :bigyello:

1) Only Numeric value in the text box

VB Code:

Function OnlyNum(Key As Integer)
If Key <> 45 And Key <> 8 Then
If Not IsNumeric(Chr(Key)) Then
Key = 0
End If
End If
End Function
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
Call OnlyNum(KeyAscii)
End Sub

2) Only Alphabetic in the text box

VB Code:

Function OnlyAlphabets(Key As Integer)
If Not (Key >= 65 And Key <= 123 Or Key = 8 Or Key = 32) Then
Key = 0
End If
End Function
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
Call OnlyAlphabets(KeyAscii)
End Sub

3) Remove Special character

VB Code:

Function SpecialCharacter(Key As Integer)
If ((Key < 65 Or Key > 93) And (Key < 97 Or Key > 125) And (Key < 48 Or Key > 59) And (Key <> 41) And (Key <> 40) And (Key <> 44) And (Key <> 45) And (Key <> 46) And (Key <> 32) And (Key <> 8)) Then
Key = 0
'Special Character are not Allowed
End If
End Function
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
Call SpecialCharacter(KeyAscii)
End Sub

4) Clear all controls on the forums

VB Code:

Public Sub ClearAllText(frm As Form)
Dim ctl As Control
For Each ctl In frm.Controls
    If TypeOf ctl Is TextBox Then: ctl.Text = ""
    If TypeOf ctl Is ComboBox Then: ctl.ListIndex = -1
    If TypeOf ctl Is OptionButton Then: ctl.Value = False
    If TypeOf ctl Is CheckBox Then: ctl.Value = 0
Next ctl
Exit Sub
End Sub
 
Private Sub Form_Load()
Call ClearAllText(Me)
End Sub

5) Clear particular control

VB Code:

Public Sub Clear_Particular_Control(frm As Form, F As Frame)
'Code For Crearing Particular Control That is In the Frame
Dim Ctr As Control
For Each Ctr In frm.Controls
If TypeOf Ctr Is TextBox Then
If Ctr.Container = F Then
    Ctr.Text = ""
End If
End If
Next
End Sub
 
Private Sub Command1_Click()
Call Clear_Particular_Control(Me, Frame1)
End Sub

6) Check Only One decimal in the textbox

VB Code:

Public Sub Check_Decimal(T As TextBox, Key As Integer)
'Controls - How to allow only number and only one occurence of decimal character in text box
Select Case Key
Case Is < 32               ' Control keys are OK.
Case 46
If InStr(1, T.Text, ".") <> 0 Then Key = 0
Case 48 To 57              ' This is a digit.
Case Else                  ' Reject any other key.
Key = 0
End Select
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
Call Check_Decimal(Text1, KeyAscii)
End Sub

7) Print Any Grid

VB Code:

Public Sub PrintGrid(MyGrid As MSFlexGrid)
‘Change the type of the Grid in you code in definition of the function
On Error Resume Next
Dim OldWidth As Integer
 
OldWidth = MyGrid.Width
MyGrid.Width = Printer.Width
Printer.PaintPicture MyGrid.Picture, 0, 0
Printer.EndDoc
MyGrid.Width = OldWidth
End Sub
 
Private Sub Command1_Click()
Call PrintGrid(MSFlexGrid1)
End Sub

8) Convert Grid Data to Excel

VB Code:

Public Sub FlexToExcel(MyGrid As MSFlexGrid)
Dim xlObject    As Excel.Application
Dim xlWB        As Excel.Workbook
Set xlObject = New Excel.Application
'This Adds a new woorkbook, you could open the workbook from file also
Set xlWB = xlObject.Workbooks.Add
 
Clipboard.Clear 'Clear the Clipboard
With MyGrid
'Select Full Contents (You could also select partial content)
    .Col = 0               'From first column
    .Row = 0               'From first Row (header)
    .ColSel = .Cols - 1    'Select all columns
    .RowSel = .Rows - 1    'Select all rows
    Clipboard.SetText .Clip 'Send to Clipboard
End With
 
With xlObject.ActiveWorkbook.ActiveSheet
    .Range("A1").Select 'Select Cell A1 (will paste from here, to different cells)
    .Paste              'Paste clipboard contents
End With
 
' This makes Excel visible
xlObject.Visible = True
End Sub
 
Private Sub Command1_Click()
Call FlexToExcel(MSFlexGrid1)
End Sub

9) Center Position Of the form

VB Code:

Public Sub Cent(frm As Form)
X = (Screen.Width - frm.Width) / 2
frm.Top = 0
frm.Move X
End Sub
 
Private Sub Form_Load()
Call Cent(Me)
End Sub

10) Database connection

VB Code:

Public Con  As New ADODB.Connection
Function Open_Connection()
If Con.State = 1 Then
    Con.Close
End If
With Con
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DatabaseName.mdb;Persist Security Info=False"
    'Change the database Name
    .ConnectionTimeout = 30
    .CursorLocation = adUseClient
    .Open
End With
End Function
 
Private Sub Form_Load()
Call Open_Connection
End Sub

To Be Continued........ :thumb:

1) Add Dsn run Time

VB Code:

Option Explicit
Public Const ODBC_ADD_SYS_DSN = 4
Public Const ODBC_REMOVE_SYS_DSN = 6
Public Const VbapiNull = 0
 
Public x As Integer
Public Con As New ADODB.Connection
Public strdriver As String
Public strAttributes As String
Public Declare Function sqlconfigdatasource Lib "ODBCCP32.DLL" Alias "SQLConfigDataSource" (ByVal hundparent As Long, ByVal frequest As Long, ByVal lpszDriver As String, ByVal lpszattributes As String) As Long
Public inet As Long
Sub Main()
strdriver = "Microsoft Access Driver (*.mdb)"
strAttributes = "DSN=Ifw" & Chr$(0) 'This Make a dsn Name ifw
strAttributes = strAttributes & "DBQ=" & App.Path & "\Salary.mdb" & Chr$(0) 'Salary.mdb is the database name
strAttributes = strAttributes & "PWD=5385" '5385 is the password of the database
inet = sqlconfigdatasource(VbapiNull, ODBC_ADD_SYS_DSN, strdriver, strAttributes)
If inet Then
Else
Exit Sub
End If
Con.CursorLocation = adUseClient
Con.Open "DSN=ifw"
Form1.Show
End Sub

To be continued.. :thumb: