vb 6.0 delete row from listview1 - vb6

I just joined the site, I apologize in advance for the wrong English, I used google translate,
I used listview1 in vb 6, there is no problem with adding and deleting by clicking
What I want to do is to remove the number I wrote in the txtsearch.Text box on the form from the list, not index, it will only remove what I wrote in the txtsearch.Text box.
it should be like in the picture
i tried this but it only deletes as index it doesn't delete the line i wrote
Private Sub Command2_Click()
If ListView1.ListItems.Count <= 0 Then MsgBox "Nothing to remove", vbInformation, "": Exit Sub
ListView1.SelectedItem = ListView1.ListItems(Val(txtsearch.Text))
If vbYes = MsgBox("Are you sure you want to delete the selected item?", vbQuestion + vbYesNo, "") Then
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End Sub
thank you for your help

To select a desired row via the SelectedItem property, the Set keyword must be used.
Alternatively, the Selected property for the desired row can be set to True in order to select that row.
Try this:
Private Sub Command2_Click()
If ListView1.ListItems.Count <= 0 Then
MsgBox "Nothing to remove", vbInformation, ""
Exit Sub
End If
Set ListView1.SelectedItem = ListView1.ListItems(Val(txtsearch.Text))
' Or the following will also work
'ListView1.ListItems(Val(txtsearch.Text)).Selected = True
If vbYes = MsgBox("Are you sure you want to delete the selected item?", vbQuestion + vbYesNo, "") Then
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
End Sub

Related

Linking a report to a subform

I have a main report (Projects Overview) which I am trying to create an OnClick event which will take me from the report to the field where that piece of information is entered on a form (LiveJobs).
My problem is that there is a subform (Estimate Items Subform) where the order items are entered. Then there is a subform on that (Production Subform) which is where the components that make up the 'Item' are entered. So a 'Desk' is ordered under 'Items' and then the components of the desk - drawer boxes, top, privacy panel are all entered on the Production Subform so they can all be tracked and monitored for production. As they are being produced there is time scheduled for each of these items in a time slot corresponding to a particular week.
In the report I want to be able to click on the time scheduled for any component and link back to the form and the corresponding week where it is scheduled and move hours around within the order form. My code will currently take me to the correct job but it wont get me to the correct 'layer' of the first subform and then to the correct layer of the component. Lets say for example the 3rd item in an order and then the 2 component of that Item.
Below is my code as it sits currently which only goes as far as trying to get to the correct item on the first subform. I figured if I could figure that out I could use the same logic to get to the correct component. This code results in a "Runtime Error '13' Type Mismatch"...I have been going round and round with this for days... Thanks in advance for any and all help.
Private Sub Estimated_hours_for_current_week_Click()
Dim strWhere As String
Dim DocName As String
DocName = "LiveJobs"
strWhere = "[Job Number]=" & "'" & Me![Job Number] & "'"
DoCmd.OpenForm DocName, acNormal, , strWhere
Forms![LiveJobs].[Estimate Items Subform].SetFocus
'find the Item in the item subform
Dim dbs As DAO.Database
Dim RstItem As DAO.Recordset
Dim strItemCriteria As Integer
Set dbs = CurrentDb
Set RstItem = dbs.OpenRecordset("Estimate Items Subform table", dbOpenDynaset)
strItemCriteria = "[Estimate Item subform table ID] = '" & Me.Estimate_Item_subform_table_ID & "'"
With RstItem
RstItem.MoveLast
DoEvents
RstItem.FindFirst strItemCriteria
Debug.Print (strItemCriteria)
If .NoMatch Then
MsgBox "No Match Found"
End If
End With
Set rs = Nothing
End Sub
I figured out the code. Here it is for reference.
Private Sub Estimated_hours_for_current_week_Click()
Dim frm1 As Form
Dim frm2 As Form
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
DoCmd.OpenForm "LiveJobs", _
WhereCondition:="[Job Number]=" & "'" & Me![Job Number] & "'"
Set frm1 = Forms!LiveJobs.Estimate_Items_Subform.Form
Set frm2 = Forms!LiveJobs.Estimate_Items_Subform!ProductionComponentSubform.Form
Set rst1 = frm1.Recordset.Clone
Set rst2 = frm2.Recordset.Clone
With rst1
.FindFirst "[Estimate Item subform table ID] =" & Me.Estimate_Item_subform_table_ID
If .NoMatch Then
MsgBox "Item not found"
Else
frm1.Bookmark = rst1.Bookmark
End If
End With
With rst2
.FindFirst "[Estimate details ID]=" & Me.Estimate_details_ID
If .NoMatch Then
MsgBox "project not found"
Else
frm2.Bookmark = rst2.Bookmark
Forms![LiveJobs].SetFocus
Forms![LiveJobs]![Estimate Items Subform].SetFocus
Forms![LiveJobs]![Estimate Items Subform]![ProductionComponentSubform].Form![Estimated
hours for current week].SetFocus
End If
End With
End Sub

Recordset not getting updated

I have created a form to allow a user to change their password.
I created a recordset and used edit/update to save it in a query, but the new password is not being saved in the query.
My code is as follows:
Private Sub txtNewPass2_AfterUpdate()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("qryUsers", dbOpenDynaset)
If Me.txtNewPass1 = Me.txtNewPass2 Then
rst.MoveFirst
Do Until rst.EOF
If rst!NName = CboUserName.Column(0) Then
rst.Edit
rst!Password = txtNewPass2.Value
rst.Update
End If
rst.MoveNext
Loop
DoCmd.Openform("frmLogin")
Else: MsgBox "Passwords not Matching"
End If
End Sub
The expression:
DoCmd.Openform("frmLogin")
Will result in a syntax error, as the parentheses surrounding the arguments are not required when the value returned by the function is not used.
However, you may find it cleaner to simply execute a SQL statement to perform the update, rather than iterating over the recordset, i.e.:
Private Sub txtNewPass2_AfterUpdate()
If txtNewPass1 = txtNewPass2 Then
With CurrentDb.CreateQueryDef("", "UPDATE qryUsers SET qryUsers.Password = ?pwd WHERE qryUsers.NName = ?usr")
.Parameters(0) = txtNewPass2
.Parameters(1) = CboUserName.Column(0)
.Execute
End With
DoCmd.Openform "frmLogin"
Else
MsgBox "Passwords not Matching"
End If
End Sub
Using parameters of course to account for users better known as Bobby Tables.

VB6 module to pass recordset to form

lets call it modUser.
In this modUser I have a ADODB record set
Now from this modUser, I would like to open a form. Lets call it frmUser2.
when this frmUser2 initialize. I would like to use the recordset that I already have from modUser. How do I pass this recordset from modUser to frmUser2?
I tried creating a public sub under frmUser2. But I get an error that says "Run time error 13 type mismatch"
here is a snippet
sSQL = "select name from employee"
rs.Open sSQL, ADOCon, adOpenKeyset
If rs.RecordCount > 1 Then
frmUser2.PopulateList(rs)
End if
in frmUser2 I have the public function ( i tried sub too)
Public Function PopulateList(rs As ADODB.Recordset)
For Count = 0 To rs.RecordCount - 1
LstModels.AddItem rs(0)
rs.MoveNext
Next
rs.close
End Function
I tried show , and I can get the form to appear, but I have no way to pass the record set.
frmUser2.Show
Please help. Thank you
I'm not a fan of how you're trying to do this, but working with what you want to do, first create a public Recordset property in your form and assign the recordset to it from your module before showing the form.
Module code:
Dim objForm As frmUser2
sSQL = "select name from employee"
rs.Open sSQL, ADOCon, adOpenKeyset
If rs.RecordCount.EOF = False Then
Set objForm = New frmUser2
frmUser2.Recordset = rs
frmUser2.Show
End if
Form Code:
Private Sub Form_Load()
If Not Recordset Is Nothing Then
PopulateList
End If
End Sub
Public Function PopulateList()
Recordset.MoveFirst 'defensive, make sure we're on the first record
LstModels.Clear
Do While Recordset.EOF = False
LstModels.AddItem Recordset(0)
Recordset.MoveNext
Next
Recordset.Close
End Function
I think it would be preferable for the module to have a public method that returns an employee recordset. Your form would call that method when it needs the data. Set rsEmployees = modUser.GetEmployees()

How to deal with textbox validation?

Private Sub txtUserCode_Validate(Cancel As Boolean)
If RS!ID = txtUserCode.Text Then
SQL = "SELECT NAME,PRIVILEDGE FROM ADMIN WHERE CODE=" & txtUserCode.Text
Set RS = CN.Execute(SQL)
txtUserName.Text = RS!NAME
Else
MsgBox "ENTER VALID NO"
txtUserCode.Text = ""
Cancel = True
End If
End Sub
In this code I want to execute like:
If I enter the ID present in table then it'll show info but it's considering 1st record (RS!ID(0)) only not the next one
If I enter the ID which is not present in table then it should not throw error
3021- Requested operation requires current record but goto else part.
Please Help
I am assuming RS is a recordset.
Depending on the RS type, you can try and Find a record like this:
RS.MoveFirst
RS.Find("[CODE]=" & txtUserCode.Text)
If Not RS.EOF Then
' found!
End If
Link to the ADO Find function.

How to copy rows of from one sheet to another sheet using vbscript

Suppose I have Sheet(1) in an excel. Now i do also have 2500 rows which has data for the columns from A to BO.Now I want the data to copy from these sheet to another sheet of the same Excel file for 2500 rows but not the whole the columns,rather i need only columns from A to AA data to copy to the new sheet.
So how to frame it using VBscript?
Please help me.
How to copy rows of from one sheet to another sheet using vbscript
To copy data from one sheet to another you can use the Copy en PasteSpecial commands. To do this with a .vbs script do the following:
' Create Excel object
Set objExcel = CreateObject("Excel.Application")
' Open the workbook
Set objWorkbook = objExcel.Workbooks.Open _
("C:\myworkbook.xlsx")
' Set to True or False, whatever you like
objExcel.Visible = True
' Select the range on Sheet1 you want to copy
objWorkbook.Worksheets("Sheet1").Range("A1:AA25").Copy
' Paste it on Sheet2, starting at A1
objWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial
' Activate Sheet2 so you can see it actually pasted the data
objWorkbook.Worksheets("Sheet2").Activate
If you want to do this in Excel with a VBS macro you can also call the copy and paste methods. Only your workbook object will be something like ActiveWorkbook
This code is Working fine. Just Copy and paste it.
Dim CopyFrom As Object
Dim CopyTo As Object
Dim CopyThis As Object
Dim xl As Object
xl = CreateObject("Excel.Application")
xl.Visible = False
CopyFrom = xl.Workbooks.Open("E:\EXCEL\From.xls")
CopyTo = xl.Workbooks.Open("E:\EXCEL\To.xls")
For i = 0 To 1
''To use a password: Workbooks.Open Filename:="Filename", Password:="Password"
If i = 0 Then
CopyThis = CopyFrom.Sheets(1)
CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count))
CopyTo.Sheets(3).Name = "Sheet3"
Else
CopyThis = CopyFrom.Sheets(2)
CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count))
CopyTo.Sheets(4).Name = "Sheet4"
End If
Next
CopyTo.Sheets(1).Activate()
CopyTo.Save()
'CopyTo.SaveAs("E:\EXCEL\Check.xls")
xl.Quit()
Sub buildMissingSheet(strMissingSheet) 'Just passing the missing sheet name in
' Master Sheet code
' Working on creating the "Master Sheet" at this time...May need to seperate the the code a little.
Dim GetRows1 As Worksheet
Dim GetRows2 As Worksheet
Dim PutRows As Worksheet
Dim sglRowNum As Single, i%
If strMissingSheet = strMASTERSHEET Then ' Create the strMASTERSHEET
Set GetRows1 = Sheets(strRAWDATA) ' These two sheets could be missing but will code around that later.
Set GetRows2 = Sheets(strDATAWITH) ' The two sheets I am getting rows from
' Just creating a new worksheet here assuming it is missing
Worksheets.Add(After:=Worksheets(5)).Name = strMissingSheet
Set PutRows = Sheets(strMissingSheet) ' Missing sheet must be created before declaring.
PutRows.Select 'Select the sheet being built.
With Cells(1, 1)
.Value = strRAWDATA 'Not copying rows here but left it in this example anyway
.AddComment
.Comment.Visible = False
.Select
.Comment.Text Text:= _
Chr(10) & "Name of sheet including header and the last 32 entries at the time this sheet was updated."
End With
'Here is where we copy the whole row from one sheet to the other.
GetRows1.Rows(1).Copy PutRows.Rows(2) 'Copy header row from existing sheet to "Master Sheet" for instance.
GetRows1.Select
sglRowNum = ReturnLastRow(ActiveSheet.Cells) 'return last row with data on active sheet
' I wanted the last few rows of data "32 rows" so found the end of the sheet this code can be found on the internet in several places including this site.
'Now the code you may have been looking for move 32 row of data from one sheet to another.
For i = 1 To 32 'Start at row 3 on the Put sheet after sheet name and header.
GetRows1.Rows(sglRowNum - (32 - i)).Copy PutRows.Rows(i + 2)
Next i
end sub

Resources