I am developing a bar management software, i did the most of the job but now i don't know the code to remove the same lines from a textbox and getting the number of the removed lines after they are removed.
My code till now:
For Each saveitem As ListViewItem In Form1.ListView1.Items
RichTextBox1.AppendText(saveitem.Text & vbNewLine)
TextBox3.AppendText(saveitem.SubItems(1).Text & vbNewLine)
Next
RichTextBox1.AppendText(vbNewLine & vbNewLine & "TOTALI:" & " " & Form1.TextBoxX5.Text & vbNewLine & "TOTALI pa TVSH:" & " " & TextBox4.Text)
One possible way :
'get array of individual line of text'
Dim textLines = TextBox3.Text.Split(New String(){vbNewLine}, StringSplitOptions.RemoveEmptyEntries)
Dim totalCount = textLines.Length
Dim noDuplicateCount = textLines.Distinct().Count()
'store number of lines removed'
Dim removedLinesCount = totalCount - noDuplicateCount
'join distinct line of texts by new line into single string'
TextBox3.Text = String.Join(vbNewLine, textLines.Distinct())
Related
A report is called from VBA to receive returned records from an Access pass-through query. After the DoCmd completes the report's parameters are set in the report's appropriate label containers setting their .Caption property as required. Access fails intermittently during this process which leads me to believe that the report is not truly open to receive the parameters. Here's the VBA sub:
Private Sub Report_Open(Cancel As Integer)
Dim strFromDate As String
Dim strToDate As String
Dim strWC As String
Dim intShift As Integer
Dim strSQL As String
strFromDate = InputBox("Enter From Date and Time: ")
strToDate = InputBox("Enter To Date and Time: ")
strWC = InputBox("Enter Work Center: ")
intShift = InputBox("Enter Shift: ")
strSQL = "exec dbo.uspWorkCentreReport_TEST " & "'" & strFromDate & "', " & "'" & strToDate & "', " & "'" & strWC & "', " & intShift & ";"
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQL
DoCmd.OpenReport "rpt_qry_ptq_uspWorkCentreReport", acViewReport
Me.lblFromDate.Caption = strFromDate
Me.lblToDate.Caption = strToDate
Me.lblWC.Caption = strWC
Me.lblShift.Caption = intShift
End Sub
When the failure occurrs VBA highlights the Me.lblFromDate.Caption = strFromDate. If I press Reset in VBA or End on the Run-time error '2467': dialog, Access abends without any other outward signs. Access then re-opens to save the copied *_Backupx.accdb and opens with a fresh copy of the .accdb. The error seems to be a standars MS error:
As I said the report is intermittent and when it fails VB always highlights the same line in code. How do I capture what is happening or can I make VB wait a half of full second before it tries to write the parameters?
As I remember, captions can not be modified, when report open. Only in design mode. So this is not correct, because you have already opened report
Me.lblFromDate.Caption = strFromDate
You should use text boxes instead of captions. Also you can clear the borders, fillings and so on, that text box will appear like a caption.
Finally the correct set of code was produced. The button click creates strOpenArgs and passes it with .OpenReport. The report opens and splits the OpenArgs and populates the appropriate labels with updated Captions. Text boxes would not work! Here's the button click event:
Private Sub btnPreviewP1_Click()
If (Me.txtToDateP1 < Me.txtFromDateP1) Then
MsgBox ("The From Date must occurr before the To Date!")
End If
Dim strFromDateHMS As String
Dim strToDateHMS As String
Dim strSQLP1 As String
Dim strOpenArgs As String
strFromDateHMS = Format(Me.txtFromDateP1, "yyyy-mm-dd") & " " & Me.cboFromHourP1 & ":" & Me.cboFromMinuteP1 & ":" & Me.cboFromSecondP1
strToDateHMS = Format(Me.txtToDateP1, "yyyy-mm-dd") & " " & Me.cboToHourP1 & ":" & Me.cboToMinuteP1 & ":" & Me.cboToSecondP1
strSQLP1 = "exec dbo.uspWorkCentreReport '" & strFromDateHMS & "','" & strToDateHMS & "','" & strWCP1 & "'," & strShiftP1
strOpenArgs = Me.RecordSource & "|" & strFromDateHMS & "|" & strToDateHMS & "|" & strWCP1 & "|" & strShiftP1
' This line is all that's needed to modify the PT query
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQLP1
DoCmd.OpenReport "rpt_ptq_uspWorkCentreReport", acViewReport, , , , strOpenArgs
End Sub
And here's the reports _Open:
Private Sub Report_Open(Cancel As Integer)
Dim SplitOpenArgs() As String
SplitOpenArgs = Split(Me.OpenArgs, "|")
Me.lblFromDate.Caption = SplitOpenArgs(1)
Me.lblToDate.Caption = SplitOpenArgs(2)
Me.lblWC.Caption = SplitOpenArgs(3)
Me.lblShift.Caption = SplitOpenArgs(4)
End Sub
This opens the report every time with new appropriate data, so long as the report is closed before the form's button is pressed again for another refresh of the report. If the report is not closed the report stays up with the original data and does not refresh with new data... But that is another question I am about to ask. Thanks All.
I'm frustrated that I can't figure this out. Have tried few different types of loops to display a Multiplication table. All I get it one line in the label. What am I doing wrong?
Private Sub btnDisplay_Click(sender As Object, e As EventArgs) Handles btnDisplay.Click
Dim intNum As Integer
Dim intCount As Integer
Dim intAnswer As Integer
Dim myString As String
Integer.TryParse(txtNumber.Text, intCount)
intNum = 0
Do While intNum < 12
intNum = intNum + 1
intAnswer = intNum * intCount
lblTable.Text = " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString()
Loop
From the looks of it, every time the code loops it sets the label text to the current result, while overwriting the previous result.
If you want the label to display multiple lines of data, you can try something like this:
lblTable.Text &= " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString() & Environment.NewLine
The "Environment.NewLine" at the end will add the newline between each result.
The "&" before the "=" is used to append to the end of the existing text. This is simlar to doing:
lblTable.Text = lblTable.Text & "..." & Environment.NewLine
Also, just a side note. If you want multiple lines in a label, you may need to set the AutoSize property to false and configure the desired size of the label properly.
On this line:
lblTable.Text = " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString()
it is only storing the last result.
You will need to pre-pend the existing results to the new results.
Label1.Text &= " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString() & Environment.NewLine
I added a & before the = so that the new results will be appended to the end of the existing contents of Label1 and a NewLine on the end to make it a little neater
Firstly, you are assigning the result of your loop to the same label, so you will only have one label.
If you want to create multiple labels you should be creating them as you go:
Dim top_pos as integer = 30 ' first label's Top
Dim left_pos as integer = 30 ' first label's Left
For intNum = 1 to 12 ' Im assuming you want the table from 1 to 12
intAnswer = intNum * intCount
Dim lbl As New Label
With lbl
.text = Cstr(intNum) & " * " & Cstr(intCount) & " = " & Cstr(intAnswer)
.location = New Point(left_pos,top_pos) 'set its position
... 'and so on
Me.Controls.Add(lbl)
End With
top_pos = top_pos + 30 ' moves the position for the next label.
Next
How will I get all fields in the "Group By" on a particular group in MS Project, using VSTO vb.net.
I tried this one:
Dim tg As MsProj.Group
Dim strGrp As String = ""
For Each tg In project.TaskGroups
strGrp = strGrp & "/" & vbCrLf & tg.Name
Next
MsgBox(project.TaskGroups("Group 6").GroupCriteria.Count)
Dim qwe As MSProject.GroupCriteria
For Each qwe In project.TaskGroups("Group 6").GroupCriteria
MsgBox(qwe)
Next
but i got error on the 2nd For loop
Thanks,
Gilbert
It appears there is an example for doing just this in the online documentation for the GroupCriterion object. Added here in case that link changes:
Dim GC As GroupCriterion
Dim Fields As String
For Each GC In ActiveProject.TaskGroups("Priority Keeping Outline Structure").GroupCriteria
If GC.Ascending Then
Fields = Fields & GC.Index & ". " & GC.FieldName & " is sorted in ascending order." & vbCrLf
Else
Fields = Fields & GC.Index & ". " & GC.FieldName & " is sorted in descending order." & vbCrLf
End If
Next GC
MsgBox Fields
tl:dr
How can I programatically flag a quotation mark (") when it is not a quote-comma (",) or a comma-quote (,")?
I am running a program that opens csv files, reads each line, then splits the line based on the location of the commas. There are enough text strings that have quotes in them, so I am using
filereader1.HasFieldsEnclosedInQuotes = True
However, when the files were created, there was no regard for having even numbers of quotes in the lines. Most of the time, it's not a big deal. There are only a couple of instances per folder of files.
But, I'm running into a few where it's a huge number. Dozens of instances in a file of several thousand lines. There isn't a simple way to manually error-check these.
So, I'm trying to do a verify that a string has rogue quotes. A comma-quote (,") or quote-comma ("), would be okay, but a quote (") just floating around would pull up an input box displaying the text line for manual fixes.
I can't use an odd number of quotes, because I've found even numbers of error quotes.
Below is the code as it stands.
Using filereader1 As New Microsoft.VisualBasic.FileIO.TextFieldParser(files_(i))
filereader1.TextFieldType = FieldType.Delimited
filereader1.Delimiters = New String() {","}
filereader1.HasFieldsEnclosedInQuotes = True
While Not filereader1.EndOfData
'While (filereader1.EndOfData = False) ' looks for the end of the file and resets stuff
split_string = filereader1.ReadFields()
This is something of what I am thinking.
I would like to run a readline instead of a readfield, and I would assign that to a variable. If the readline had a quote, but that could not be a quote-comma OR a comma-quote, the variable would get displayed in an input box for manual updating. Then the fixed variable would get parsed into the split_string array.
If the quotes all fit the rule above, the string would get parsed normally.
Could you do a count of the different type of strings in the readLine, and if the count of all quotes versus the sum of all ", and ," don't match, then you have an issue?
Public Function CountChar(originalString As String, findString As String) as Long
Dim lLen As Long = 0
Dim lCharLen As Long = 0
Dim lAns As Long = 0
Dim sChar As String = ""
Dim lCtr As Long = 0
Dim lEndOfLoop As Long = 0
lLen = Len(originalString)
lCharLen = Len(findString)
lEndOfLoop = (lLen - lCharLen) + 1
For lCtr = 1 To lEndOfLoop
sChar = Mid(originalString, lCtr, lCharLen)
If StrComp(sChar, findString, vbTextCompare) = 0 Then lAns = lAns + 1
Next
return lAns
End Function
Usage
'if the count of all quotes does not equal count of ", + ,", then there is an issue.
if CountChar(thisLine, chr(34)) <> (countChar(thisLine, chr(34) & ",") + countChar(thisLine, & "," & chr(34)) then
'rogue quotes
end if
So, this is what I ended up doing.
I read each line from the csv file.
I check to see how many quotes are in the line.
If the number is zero, I parse based on commas alone.
If there are an odd number of quotes, I eliminate ALL the quotes in the line, and send it to the manual error-checking.
If there are an even number of quotes, I replace the character string ," and ", with ::
Then I parse the line on both commas and ::
This seems to be working.
Using filereader As New Microsoft.VisualBasic.FileIO.TextFieldParser(files_(i), System.Text.Encoding.Default) 'system text decoding adds odd characters
While Not filereader.EndOfData
filereader.TextFieldType = FieldType.Delimited
'filereader.Delimiters = New String() {","}
filereader.SetDelimiters(",") 'tried new from Don's program 6/12
filereader.HasFieldsEnclosedInQuotes = True
filereader.TextFieldType = FieldType.Delimited
Try
'split_string = filereader1.ReadFields()
whole_string = filereader.ReadLine()
Catch ex As Microsoft.VisualBasic.FileIO.MalformedLineException
MessageBox.Show(ex.Message & " : " & FileName & " ; " & filereader.ErrorLine)
error_throw = filereader.ErrorLine
error_throw = error_throw.Replace("""", " ")
split_string = Split(error_throw, ",")
'MsgBox("In catch routine, split string (0) " & split_string(0))
End Try
Dim cnt As Integer = 0
Dim MyRegex As New Regex("""[^""]*""|(,)")
For Each c As Char In whole_string
If c = """" Then cnt = cnt + 1
Next
'MsgBox("cnt = " & cnt)
If cnt = 0 Then 'no quotes
split_string = Split(whole_string, ",") 'split by commas
'MsgBox("no quotes")
ElseIf cnt Mod 2 = 0 Then 'even number of quotes
Dim pattern1 As String = "\.?(,"")+"
Dim pattern2 As String = "\.?("",)+"
Dim rgex1 As New Regex(pattern1)
Dim rgex2 As New Regex(pattern2)
Dim replace1 As String = "::"
Dim replace2 As String = "::"
Dim whole_string1 As String = rgex1.Replace(whole_string, replace1)
Dim whole_string2 As String = rgex2.Replace(whole_string1, replace2)
whole_string1 = rgex1.Replace(whole_string, replace1)
whole_string2 = rgex2.Replace(whole_string1, replace2)
'MsgBox(whole_string & " >> " & whole_string1 & " >> " & whole_string2)
'split_string = Split(whole_string2, ",") 'non-regex code that allows program to run
split_string = Regex.Split(whole_string2, ",|([<::>+].*[<::>+])")
'(",(?=(?:[^\""]*\""[^\""]*\"")*(?![^\""]*\""))")
'MsgBox("Before " & split_string(0) & " | " & split_string(1) & " | " & split_string(2) & " | " & split_string(3) & " | " & split_string(4) & " | " & split_string(5) & " | " & split_string(6) & " | " & split_string(7))
Dim arraycount_2 As Integer = split_string.getupperbound(0)
For p = 0 To arraycount_2
split_string(p) = split_string(p).replace("::", "")
Next
'MsgBox("After " & split_string(0) & " | " & split_string(1) & " | " & split_string(2) & " | " & split_string(3) & " | " & split_string(4) & " | " & split_string(5) & " | " & split_string(6) & " | " & split_string(7))
ElseIf cnt Mod 2 <> 0 Then 'odd number of quotes
'MsgBox("Odd quotes")
whole_string = whole_string.Replace("""", " ") 'delete all quotes
split_string = Split(whole_string, ",") 'split by commas
Else
' MsgBox("no answer to ENTRY splitting of Whole_string")
End If
I am trying to add the contents of my five text boxes in the form to a multi line text box named "TextBox1". However, everytime I change the content of my textboxes, instead of adding another line with the contents it replaces the pre-existing line. How do I make the next line print.
Dim Newline As String
Newline = System.Environment.NewLine
TextBox1.Text = "Plane Truss"
TextBox1.Text = TextBox1.Text & Newline & "JointCoordinates"
TextBox1.AppendText(Newline & Joint# & " " & coordinates1 & " " & bc1 & " " & jointloads1 & " " & settlements1 & " " & jointrotation1)
Is there a way I can convert the whole multiline text box into a .txt
file?
Sure...use the Lines() property of the TextBox and File.WriteAllLines():
System.IO.File.WriteAllLines("c:\some path\folder\file.txt", Result1.Lines)