Jx_Man 987 Nearly a Senior Poster Featured Poster

See if this help :

Private Sub Command1_Click()
List1.Clear
x = 0
For j = 1 To Len(Trim(Text1.Text))
    kt1 = Mid(Trim(Text1.Text), j, 1)
    kta = kta + kt1
    If kt1 = Chr(32) Then
        x = x + 1
        List1.AddItem Trim(kta)
        kta = ""
    End If
Next j

If x >= 0 Then List1.AddItem Trim(kta)

End Sub
EkoX commented: Worked really nice :D +1
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :

Dim ctrAs Control

For Each ctr In Me.Controls
   If TypeOf ctr Is TextBox Then
      If ctr.Text= vbNullString Then
         MsgBox "Textbox empty"

         ctr.SetFocus

         Exit Sub

      End If
  End If
Next ctr
hkdani commented: Excellent suggestions based on in depth knowledge of the language. +5
Sturdy commented: It's a wonderful code sir :) +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

when the input is 12 years and 6 months I want the program to print teenager
I'm not sure how to do that

Input should be 12.6 to get right result.
so you can concatenate textbox1 (for year) and textbox2 (for month) :

Private Sub Command1_Click()
Select Case Val(Text1.Text) & "." & Val(Text2.Text)
    Case 0 To 1
        MS_lbl_category.Text = CStr("infant")
    Case 1 To 2
        MS_lbl_category.Text = CStr("toddlerI")
    Case 2 To 6
        MS_lbl_category.Text = CStr("kindergarten")
    Case 6 To 12
        MS_lbl_category.Text = CStr("child")
    Case 12 To 19
        MS_lbl_category.Text = CStr("teenager")
    Case 19 To 25
        MS_lbl_category.Text = CStr("young adult")
    Case 25 To 40
        MS_lbl_category.Text = CStr("adult")
    Case 40 To 60
        MS_lbl_category.Text = CStr("middle aged")
    Case 60 To 120
        MS_lbl_category.Text = CStr("senior citizen")
    Case Else
        MS_lbl_category.Text = CStr("Are you kidding ?")
End Select
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Highlight item which index in textbox.
Try this :

Private Sub Command1_Click()
List1.Selected(Text1.Text) = True
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

See if this helps :

Private Sub ListFiles(strPath As String, Optional Extention As String)
'Leave Extention blank for all files
    Dim File As String
       
    If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
       
    If Trim$(Extention) = "" Then
        Extention = "*.*"
    ElseIf Left$(Extention, 2) <> "*." Then
        Extention = "*." & Extention
    End If
       
    File = Dir$(strPath & Extention)
    Do While Len(File)
        List1.AddItem File
        File = Dir$
    Loop
End Sub

To get all files :

Private Sub Command1_Click()
ListFiles "D:\musicfolder", "*" ' Or ListFiles "D:\musicfolder", "" leave it blank to get all files
End Sub

Just get mpg files :

Private Sub Command1_Click()
ListFiles "D:\musicfolder", "mpg" 'mpg files
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Like i said before to manipulate your SQL Statment :

openrstJCcaseInfo "select * from JCcaseInfo like " & "'%" & txtsearch.Text & "%'"
Estella commented: Good Point :D +4
Vega_Knight commented: :D +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

I don't understand what you want exactly.
You want to swap items index?

Jx_Man 987 Nearly a Senior Poster Featured Poster

Manipulate your sql query to receive input from textbox and put the code in textbox_change() event..

Private Sub Text1_Change()
' your code here
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :

Private Sub Command1_Click()
    MsgBox Printer.DeviceName
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

As ChrisPadgham said..that is a simplest way.
This following is other way (But Still needed to use Looping):

For Each controlx In Form1.Controls
    If TypeOf controlx Is TextBox Then controlx.BackColor = vbRed
Next controlx
Jx_Man 987 Nearly a Senior Poster Featured Poster
Jx_Man 987 Nearly a Senior Poster Featured Poster

See if this help :

Shell("shutdown -s") 'Shutdown
Jx_Man 987 Nearly a Senior Poster Featured Poster

See if this helps :

Public Function ChangeFileExt(ByVal aFilename As String, ByVal NewExt As String) As Boolean
Dim p As Long
Dim bp As Long
Dim nFileName As String

On Error Resume Next
ChangeFileExt = False
If aFilename = "" Then Exit Function
p = 0
Do
    bp = p
    p = InStr(p + 1, aFilename, ".", vbBinaryCompare)
Loop Until p = 0

If bp > 0 Then
    nFileName = Left(aFilename, bp - 1)
Else
    nFileName = aFilename
End If

nFileName = nFileName & "." & NewExt

Err.Clear

Name aFilename As nFileName

If Err.Number = 0 Then ChangeFileExt = True

End Function

' Change file type
Private Sub Command1_Click()
Call ChangeFileExt("D:\test.txt", "jx") ' from .txt become .jx
End Sub

Your case :

Text1.Text = "D:\test.txt"
Text2.Text = "jx"
Private Sub Command1_Click()
Call ChangeFileExt(Text1.Text, Text2.Text) 
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Thanks Brother I am very Thanks full to you
Its work
Good bless you
Raza Mughal

You're Welcome.
Please Mark this thread as Solved :D

Jx_Man 987 Nearly a Senior Poster Featured Poster

This how far i'm doing. But i don't know how to check if last 3 character is number?

Use IsNumeric() function :

Private Sub Command1_Click()
Dim First4Char, Last3Char As String
First4Char = Mid(Text1.Text, 1, 4)
Last3Char = Mid(Text1.Text, 5, 7)
If Len(Text1.Text) <= 7 Then
    If First4Char <> "ABCD" Then
        MsgBox "Wrong"
    Else
        If Not IsNumeric(Last3Char) Then
            MsgBox "Wrong Input"
        Else
            ' Action if text is accepted
        End If
    End If
End If
End Sub
Sturdy commented: It worked very nice. :D +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

You can use Mid() , Left() or Right() function to get The first four characters and the last 3 characters and Use Len() for the length of text.

Jx_Man 987 Nearly a Senior Poster Featured Poster

I mean, when i put cursor (click) in some text i will know where the cursor is.

Okay. See if this helps :

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Text1.SelLength = 0 Then
    lCurPos = Text1.SelStart
Else
    lCurPos = Text1.SelStart + Text1.SelLength
End If
Label1.Caption = "Cursor Position " & lCurPos
End Sub
Sturdy commented: It worked sir. :D +1
Sawamura commented: Good +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

what you mean about position in text at textbox?
please give more information.

Jx_Man 987 Nearly a Senior Poster Featured Poster

See if this helps :
Need 1 Module and 1 Button.

In Module :

'Author : Gernan Mejia Aka DJ Unreal 303
'Language : VB5, VB6
'Operating Systems  : Windows 9x, NT, 2000, Me, XP

'-------------------------------------------------------
Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * 260
End Type
'-------------------------------------------------------
Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, _
ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long

Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long

Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" ( _
ByVal lFlags As Long, lProcessID As Long) As Long

Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, _
ByVal uExitCode As Long) As Long

Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

In Form :

'-------------------------------------------------------
Public Sub KillProcess(NameProcess As String)
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const TH32CS_SNAPPROCESS As Long = 2&
Dim uProcess  As PROCESSENTRY32
Dim RProcessFound As Long
Dim hSnapshot As Long
Dim SzExename As String
Dim ExitCode As Long
Dim MyProcess As Long
Dim AppKill As Boolean
Dim AppCount As Integer
Dim i As Integer
Dim WinDirEnv As String
       
       If NameProcess <> "" Then
          AppCount = 0

          uProcess.dwSize = Len(uProcess)
          hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&) …
Jx_Man 987 Nearly a Senior Poster Featured Poster

>>what connection will i use and how and sample codes.
You want to connect with access 2007 or you want to make report of your db?
Anyway how far you doing this?

Jx_Man 987 Nearly a Senior Poster Featured Poster

Also CheckOnClick was not necessary because I already have that as “True” from the properties in designer.

Okay. I don't know it if you already set it.

So this is only working for items 1 to 5 and not for my own 68 items.

Yes, This only working for items with value 1 to 5. I just give the example. You modified it as you wish.

Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this

Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    For i As Integer = 1 To 5
        CheckedListBox1.Items.Add(i)
    Next

    CheckedListBox1.CheckOnClick = True 'Checked item when you select it
End Sub

Private Sub CheckedListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckedListBox1.SelectedIndexChanged
    If CheckedListBox1.SelectedItem.ToString = "1" Then
        Button1.Enabled = True
    End If   
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

See if this helps :

Set rsTest = New ADODB.Recordset

With
.Append "Field1", adBSTR
.Append "Field2", adBSTR
.Append "Field3", adBSTR
End With

rsTest.Open

With rsTest
.AddNew
.Fields("Field1") = "Test1"
.Fields("Field2") = "Test2"
.Fields("Field3") = "Test3"
.Update
End With
Set DataReport1.DataSource = rsTest
With DataReport1.Sections("Section1")
.Controls("Text1").DataField = "Field1"
.Controls("Text2").DataField = "Field2"
.Controls("Text3").DataField = "Field3"
End With
DataReport1.Refresh
DataReport1.Show 1
End Sub
Naruse commented: This snippet realy help me. Thank you :) +3
Jx_Man 987 Nearly a Senior Poster Featured Poster

Create a recordset to Accomodate related item then set datareport recordset to it.

Jx_Man 987 Nearly a Senior Poster Featured Poster

Make sure that your table (login) is exists in your database and table name spell correctly.

Jx_Man 987 Nearly a Senior Poster Featured Poster

You can check file name length..

Dim streamer As IO.StreamReader
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
    OpenFileDialog1.ShowDialog()
    If OpenFileDialog1.FileName.Length > 0 Then
        TextBox1.Text = OpenFileDialog1.FileName
        streamer = IO.File.OpenText(TextBox1.Text)
        Dim mystring() As String = streamer.ReadToEnd.Split(vbNewLine)
        ListBox1.Items.AddRange(mystring)
    End If
End Sub
Aleksej commented: Thx Jx +1
Neji commented: As always +2
Jx_Man 987 Nearly a Senior Poster Featured Poster
Option Explicit
Dim X As Integer, Y As Integer 'Declare variable X and Y as Integer 

Private Sub Form_Load()
    ' This following code to assing variable X and Y with Width and Height of Form
    X = Me.Width 'assign variable X with form Width 
    Y = Me.Height 'assign variable Y with form Height
	
    'This following code to set Width and height of Form To 0
    Me.Width = 0 ' Set form Width to 0
    Me.Height = 0 ' Set form Height to 0
	
    ' This following to centered form
    Me.Left = (Screen.Width - Me.Width) / 2 ' Set Left with (Width of your computer screen -  Width of form) then Divide it by 2
    Me.Top = (Screen.Height - Me.Height) / 2 ' Set Top with (Height of your computer screen -  Height of form) then Divide it by 2
End Sub

'THis for Opened Form Animation
Private Sub Timer1_Timer()
 'Timer for the opening event
' This following code will  bringin back Form Size.. 
' form will increase width by 400 and Height by 350. So it will seems like animation..

' This following code will bring the Form Width Size
If Me.Width < X Then ' If Width of Form < X  (X is Form Width. Look at asiggnment in form load)
	Me.Left = (Screen.Width - Me.Width) / 2 'Set Left with (Width of your computer screen -  Width of form) then Divide it by 2. This for centered form
	Me.Width = Me.Width + 400 ' Form Width will …
Vega_Knight commented: Very good explanation +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :

Private Sub cmdAddItem_Click()
Static count As Integer
Static name As String
count = lstPoints.ListCount
count = count + 1
name = "Point " & count
lstPoints.AddItem name

If count = 8 Then
    cmdAddItem.Enabled = False
    cmdRemoveItem.Enabled = True
End If
End Sub

Private Sub cmdRemoveItem_Click()
Size = lstPoints.ListCount - 1
lstPoints.RemoveItem Size

If lstPoints.ListCount = 0 Then
    cmdRemoveItem.Enabled = False
    cmdAddItem.Enabled = True
End If
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

Thank you for your response.
I went through all the suggestions but in the last part, I'm still having problems in 'clearing' the array and start new order.
Yes the command that you provided clears all the strings but when I start new order (ButtonNewOrder) the previous output (TotalItems) is saved and added to the 'New' (TotalItems). I will keep looking for a solution and I will post it with the corrected code if I'm done.

ChrisPadgham already answered it. just put that the code in button new order event.

Jx_Man 987 Nearly a Senior Poster Featured Poster

1. Total
You can get total from TotalCost variabel since you already count it TotalCost += OrderMenu(1).ItemCost But you put the declaration in every buttons so you can't use it properly.
You need to put TotalCost in Global Declaration and remove all TotalCost declaration in every buttons.

Private OrderMenu(6) As MenuItems
Dim Dim TotalCost As Decimal
...

You can access it in ButtonDone event : MsgBox(TotalCost) 2. Clear TextBoxBill

Private Sub ButtonNewOrder_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonNewOrder.Click
    'Clears the TexBoxBill and start new order
    TextBoxBill.Text = String.Empty
End Sub

3. Hamburger Problem
Your code not complete like others. You missing '+' sign.
Just change this line :

...
TextBoxBill.Text += OrderMenu(1).ItemName.ToString & vbTab & OrderMenu(1).ItemCost.ToString & vbCrLf
Jx_Man 987 Nearly a Senior Poster Featured Poster

Thanks everyone, for all your help, I've managed to sort the problem out. :D

Great Job collin_ola. So, Would you like to share the answer..?
It will help another member who has the same problem like you. :D

Thank you :)

Jx_Man 987 Nearly a Senior Poster Featured Poster

i want to remove single items from list and want to keep duplicate items in listbox

You mean just remove selected item?

Jx_Man 987 Nearly a Senior Poster Featured Poster

Remove selected items :

Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
        For i As Integer = 0 To ListBox1.SelectedIndices.Count - 1
            ListBox1.Items.RemoveAt(ListBox1.SelectedIndex)
        Next
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster

See this link.
counter usually used in loop.
For me all those variables can be a counter depend on the case, but if i have to choose one then i would choose the last one.

Jx_Man 987 Nearly a Senior Poster Featured Poster

You're welcome.
If solved then mark it as solved :)

Jx_Man 987 Nearly a Senior Poster Featured Poster

Yes. You need to add one column again as Key to identifier them.
Named it as you want (e.g ID or dbId or dbNum).
With this column every record will get one unique key to be identified.

Jx_Man 987 Nearly a Senior Poster Featured Poster

Its not an error.
When you edit data your program will edit all record with name 'jones'.
Since you didn't have an key/Id to know which 'jones' to edit.
I suggest you to add Id Column as Key. So you can identifier which record to edit even they have the same name.
e.g :

Id  Surename  Forename Phone
1   jones     ward     12345
2   jones     ward     54321

Even they have same name but you can edit current jones with using their 'Id'.

ITKnight commented: Good point. +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

All can be counter variable.

Jx_Man 987 Nearly a Senior Poster Featured Poster

I don't really know why it doesn't work for you.
This a simple test of passing text.

Jx_Man 987 Nearly a Senior Poster Featured Poster

Well..its strange. it always works for me.
did you have made the object of form customer?

Dim frmCustomers as New formCustomers

frmCustomers.txtFirstName.Text = dSet.Tables("Customers").Rows(incr + 1).Item(2)
frmCustomers.txtLastName.Text = dSet.Tables("Customers").Rows(incr + 1).Item(3)
Me.Hide()
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try to hide the form. don't close it. Me.Hide()

Jx_Man 987 Nearly a Senior Poster Featured Poster

You can use SQL aliases on your sql query.
e.g :

select Name as '1', City as '2' from Address
Jx_Man 987 Nearly a Senior Poster Featured Poster
formCustomers.txtFirstName.Text = dSet.Tables("Customers").Rows(incr + 1).Item(2)
formCustomers.txtLastName.Text = dSet.Tables("Customers").Rows(incr + 1).Item(3)
Me.Close()

Actually you can pass value if form search still active.

Jx_Man 987 Nearly a Senior Poster Featured Poster

Try to Pass value before Close the form Search.

Jx_Man 987 Nearly a Senior Poster Featured Poster

1 Module, 1 textbox

In Module :

Option Explicit

Public OldWindowProc As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
' Pass along all messages except the one that
' makes the context menu appear.
Public Function NoPopupWindowProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_CONTEXTMENU = &H7B

    If msg <> WM_CONTEXTMENU Then _
        NoPopupWindowProc = CallWindowProc( _
            OldWindowProc, hWnd, msg, wParam, _
            lParam)
End Function

In Form :

Option Explicit
Private Sub Form_Load()
    ' Set the control's new WindowProc.
    OldWindowProc = SetWindowLong( _
        txtMenuDisabled.hWnd, GWL_WNDPROC, _
        AddressOf NoPopupWindowProc)
End Sub
' Restore the original WindowProc.
Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong _
        txtMenuDisabled.hWnd, GWL_WNDPROC, _
        OldWindowProc
End Sub
Neji commented: Thank you. It worked very nice. +2
Jx_Man 987 Nearly a Senior Poster Featured Poster

Use API calls.

Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :

dtpEqualTo.Value.ToString("yyyy-MM-dd")
Jx_Man 987 Nearly a Senior Poster Featured Poster
Jx_Man 987 Nearly a Senior Poster Featured Poster

Try this :

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim Info As New FileInfo("D:\000.jpg")
    MsgBox("Name : " & Info.Name & vbCrLf & _
        "Length : " & Info.Length & " bytes" & vbCrLf & _
        "Type : " & Info.Extension & vbCrLf & _
        "Date Created : " & Info.CreationTime & vbCrLf & _
        "Path : " & Info.DirectoryName & vbCrLf & _
        "Full Path : " & Info.FullName)
End Sub
Jx_Man 987 Nearly a Senior Poster Featured Poster
Label1Display.Text = Stacks(0).ToString
Label2Display.Text = Stacks(1).ToString
Label3Display.Text = Stacks(2).ToString
Label4Display.Text = Stacks(3).ToString
Label5Display.Text = Stacks(4).ToString