I made a sub to refresh multiple Forms using another thread, I know I've to Invoke to solve this problem, but I don't know how to invoke in that case... Because I've 3 different forms and multiples controls. How do I solve that?
Error in compiler:
System.InvalidOperationException: 'Operação entre threads inválida:
controle '_procVlrCond' acessado de um thread que não é aquele no qual
foi criado.'
Code:
Public Shared Sub VerificaAlterações(ByVal MOV_Bancos As List(Of Integer), ByVal MOV_Lançamentos As List(Of Integer), ByVal MOV_Datas As List(Of Date), ByVal DOC_Lojas As List(Of Integer), ByVal DOC_Clientes As List(Of Integer), ByVal DOC_BACs As List(Of String), ByVal DOC_Condições As List(Of Integer), ByVal DOC_Datas As List(Of Date), ByVal DOC_Sacados As List(Of String), ByVal DOCS_Documentos As List(Of String), ByVal DOC_Valores As List(Of Decimal))
Dim n As Integer = 0
For Each FormRefresh As Form In Application.OpenForms()
Select Case FormRefresh.Name
Case Form1.Name
n = 0
For Each BAC In DOC_BACs
With DirectCast(FormRefresh, Form1)
.Btn1.PerformClick()
End With
n += 1
Next
Case Form2.Name
n = 0
For Each BAC In DOC_BACs
With DirectCast(FormRefresh, Form2)
If (.tbLoja.Text = DOC_Lojas(n).ToString OrElse .tbLoja.Text = vbNullString OrElse CInt(.tbLoja.Text) = 0) AndAlso ' Loja
(.tbCliente.Text = DOC_Clientes(n).ToString OrElse .tbCliente.Text = vbNullString OrElse CInt(.tbCliente.Text) = 0) AndAlso ' Cliente
(._procNome.Text = vbNullString OrElse ._procNome.Text.Contains(DOC_Sacados(n))) AndAlso ' Nome
(._procDcto.Text = vbNullString OrElse ._procNome.Text.Contains(DOCS_Documentos(n))) AndAlso ' Documento
(._procVlrCond.SelectedIndex = 0) AndAlso ' Intervalor de valor (qualquer apenas)
(._pVenc1.Checked = False OrElse ._pVenc1.Value <= DOC_Datas(n)) AndAlso ' Vencimento Inicial
(._pVenc2.Checked = False OrElse ._pVenc2.Value >= DOC_Datas(n)) AndAlso ' Vencimento Final
.BTN_Pesquisar.PerformClick() Then
Exit For
End If
End With
n += 1
Next
Case Form3.Name
n = 0
For Each BAC In DOC_BACs
With DirectCast(FormRefresh, Form3)
For Each Linha As DataGridViewRow In .tabDocumentos.Rows
' Pintar células
With Linha.DefaultCellStyle
.ForeColor = Color.Black
.SelectionBackColor = Color.Black
End With
Next
End With
Next
End Select
Next
End Sub
Related
I found an error at the time of double click in cell gridview because there is a blank or empty record in the DTE column and qty column.
Is there the best solution or recommendation?
note : I use visual studio 2010
Private Sub DataGridView1_CellDoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellDoubleClick
x = DataGridView1.Rows.IndexOf(DataGridView1.CurrentRow)
txtCODE.Text = DataGridView1.Rows(x).Cells(0).Value.ToString()
Dim cellValue = DataGridView1.Rows(x).Cells(1).Value
DateTimePicker1.Value = CDate(If(cellValue Is Nothing OrElse cellValue Is DBNull.Value, String.Empty, cellValue.ToString()))
Dim cellValue1 = DataGridView1.Rows(x).Cells(2).Value
NumericUpDown1.Value = CDec(If(cellValue1 Is Nothing OrElse cellValue1 Is DBNull.Value, String.Empty, cellValue1.ToString()))
End Sub
Note: This is an untested code. You need to check first if the columns DTE and QTY are not blank before assigning values to the controls.
Private Sub DataGridView1_CellDoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellDoubleClick
x = e.RowIndex
txtCODE.Text = DataGridView1.Rows(x).Cells(0).Value.ToString()
Dim dt = DataGridView1.Rows(x).Cells(1).Value.ToString()
Dim qty = DataGridView1.Rows(x).Cells(2).Value.ToString()
' Check if DTE column is not empty
If dt <> nothing Then
DateTimePicker1.Value = Cdate(dt).Date
Else
' you can do something here
End If
' Check if QTY column is a number
If IsNumeric(qty) Then
NumericUpDown1.Value = qty
Else
NumericUpDown1.Value = 0
End If
End Sub
I am starting to program in vb.net and I am making a program that takes values from excel columns of 2 files and shows results in a generated excel.
so the first excel has this columns: delivery number, contentID, packages, volume. the second excel has this columns:SPS Number, folder number, contentID, packages, volume.
the excel that i have to generato has this columns:SPS number,folder number, delivery number, contentID,packages, volume. The excel that i have to generate with the program uses contentID as the main identificator, and it has ti compare the packages and volume if the ContentID is the same.
so far i have this in a funtions file:
Module Funciones
'VARIABLES REMATE'
Public ENTREGA As New List(Of String)
Public PAQUETE As New List(Of String)
Public CONTENEDOR As New List(Of String)
Public VOLUMEN As New List(Of String)
'VARIABLES PLANILLA'
Public NSPS As New List(Of String)
Public NPLANILLA As New List(Of String)
Public PAQUETE2 As New List(Of String)
Public IDCONTENEDOR As New List(Of String)
Public VOLUMEN2 As New List(Of String)
Public Sub INICIALIZAR_PLANILLA(ByRef HOJAUSUARIOS As OfficeOpenXml.ExcelWorksheet)
Try
HOJAUSUARIOS.Cells("A1").Value = "N° SPS"
HOJAUSUARIOS.Cells("B1").Value = "N° PLANILLA"
HOJAUSUARIOS.Cells("C1").Value = "ENTREGA"
HOJAUSUARIOS.Cells("D1").Value = "CONTENEDOR"
HOJAUSUARIOS.Cells("E1").Value = "PAQUETES"
HOJAUSUARIOS.Cells("F1").Value = "VOLUMEN"
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Public Function seleccionardirectorio(ByVal filtro As String) As String
Dim saveFileDialog1 As New SaveFileDialog()
saveFileDialog1.Filter = filtro
saveFileDialog1.Title = "Seleccione Directorio"
saveFileDialog1.ShowDialog()
Return saveFileDialog1.FileName
End Function
Function extraer_valores_remate(ByRef ruta As String) As Boolean
ExcelPackage.LicenseContext = LicenseContext.NonCommercial
Try
Dim stream = System.IO.File.OpenRead(ruta)
Dim package = New OfficeOpenXml.ExcelPackage(stream)
'// Libro
Dim Workbook = package.Workbook
'// Hojas
Dim hojas = Workbook.Worksheets
' Dim aux As Integer = 1
'While (Workbook.Worksheets.Count >= aux)
Dim hojaUsuarios = Workbook.Worksheets(Workbook.Worksheets.Item(0).ToString)
Dim indice As Integer = 2
While (indice < 2000)
'Numero entrega'
If (IsNothing(hojaUsuarios.Cells("A" & indice).Value) = False) Then
ENTREGA.Add(hojaUsuarios.Cells("A" & indice).Value)
End If
'Numero Contenedor'
If (IsNothing(hojaUsuarios.Cells("B" & indice).Value) = False) Then
CONTENEDOR.Add(hojaUsuarios.Cells("B" & indice).Value)
End If
'Paquete'
If (IsNothing(hojaUsuarios.Cells("C" & indice).Value) = False) Then
PAQUETE.Add(hojaUsuarios.Cells("C" & indice).Value)
End If
'Volumen'
If (IsNothing(hojaUsuarios.Cells("D" & indice).Value) = False) Then
VOLUMEN.Add(hojaUsuarios.Cells("D" & indice).Value)
End If
indice += 1
End While
indice += 1
Catch EX As Exception
MsgBox(EX.ToString)
Return False
End Try
Return True
End Function
Function extraer_valores_planilla(ByRef ruta As String) As Boolean
ExcelPackage.LicenseContext = LicenseContext.NonCommercial
Try
Dim stream = System.IO.File.OpenRead(ruta)
Dim package = New OfficeOpenXml.ExcelPackage(stream)
'// Libro
Dim Workbook = package.Workbook
'// Hojas
Dim hojas = Workbook.Worksheets
' While (Workbook.Worksheets.Count >= aux)
Dim hojaUsuarios = Workbook.Worksheets(Workbook.Worksheets.Item(0).ToString)
Dim indice As Integer = 2
While (indice < 5000)
'Numero entrega'
If (IsNothing(hojaUsuarios.Cells("A" & indice).Value) = False) Then
NSPS.Add(hojaUsuarios.Cells("A" & indice).Value)
End If
'Numero Contenedor'
If (IsNothing(hojaUsuarios.Cells("B" & indice).Value) = False) Then
NPLANILLA.Add(hojaUsuarios.Cells("B" & indice).Value)
End If
'Paquete'
If (IsNothing(hojaUsuarios.Cells("C" & indice).Value) = False) Then
IDCONTENEDOR.Add(hojaUsuarios.Cells("C" & indice).Value)
End If
'Volumen'
If (IsNothing(hojaUsuarios.Cells("D" & indice).Value) = False) Then
PAQUETE2.Add(hojaUsuarios.Cells("D" & indice).Value)
End If
If (IsNothing(hojaUsuarios.Cells("E" & indice).Value) = False) Then
VOLUMEN2.Add(hojaUsuarios.Cells("E" & indice).Value)
End If
indice += 1
End While
indice += 1
Catch EX As Exception
MsgBox(EX.ToString)
Return False
End Try
Return True
End Function
Public Sub LIMPIAR_VARIABLES_REMATE()
ENTREGA.Clear()
CONTENEDOR.Clear()
PAQUETE.Clear()
VOLUMEN.Clear()
End Sub
Public Sub LIMPIAR_VARIABLES_PLANILLA()
ENTREGA.Clear()
CONTENEDOR.Clear()
PAQUETE.Clear()
VOLUMEN.Clear()
End Sub
and on the main file i have this
Imports System.IO
Imports System.Text.RegularExpressions Imports OfficeOpenXml Imports OfficeOpenXml.Style
Public Class Form1 Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim OFD As New OpenFileDialog
OFD.Title = "Selecciona un archivo"
OFD.Filter = "XLSX|*.xlsx"
If OFD.ShowDialog() = DialogResult.OK Then
Dim extension As String = System.IO.Path.GetExtension(OFD.FileName)
Dim nombreOriginal As String = System.IO.Path.GetFullPath(OFD.FileName)
TextBox1.Text = nombreOriginal
extraer_valores_remate(nombreOriginal)
Button4.Enabled = True
Button3.Enabled = True
Else
MsgBox("Campo Requerido", MsgBoxStyle.Exclamation, Title:="Faltan Datos")
TextBox1.Focus()
End If
End Sub
Public nombre_archivo As String = ""
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim OFD As New OpenFileDialog
OFD.Title = "Selecciona un archivo"
OFD.Filter = "XLSX|*.xlsx"
If OFD.ShowDialog() = DialogResult.OK Then
Dim extension As String = System.IO.Path.GetExtension(OFD.FileName)
nombre_archivo2 = System.IO.Path.GetFileName(OFD.FileName)
Dim nombreOriginal As String = System.IO.Path.GetFullPath(OFD.FileName)
TextBox2.Text = nombreOriginal
extraer_valores_planilla(nombreOriginal)
Else
MsgBox("Campo Requerido", MsgBoxStyle.Exclamation, Title:="Faltan Datos")
TextBox2.Focus()
End If
End Sub
Public nombre_archivo2 As String = ""
'********VARIABLES EXCEL DE CARGA**********'
'Public ENTREGA As New List(Of String)
'Public IDCONTENEDOR As New List(Of String)
''Public PAQUETES As New List(Of String)
'Public VOLUMEN As New List(Of String)
'Public NSPS As New List(Of String)
'Public NPLANILLA As New List(Of String)
'Public IDCONTENERDOR2 As New List(Of String)
'' Public PAQUETES2 As New List(Of String)
'Public VOLUMEN2 As New List(Of String)
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
LIMPIAR_VARIABLES_REMATE()
TextBox1.Text = ""
MsgBox("Las variables del remate se han limpiado correctamente", MsgBoxStyle.Information, Title:="LIMPIAR")
End Sub
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
ExcelPackage.LicenseContext = LicenseContext.NonCommercial
Dim path As String = seleccionardirectorio("Excel|.xlsx")
If (String.IsNullOrWhiteSpace(path) = False) Then
Dim excel = New ExcelPackage(New FileInfo(path))
excel.Workbook.Worksheets.Add("Hoja1")
Dim aux As Integer = 1
Dim Workbook = excel.Workbook
Dim hojas = Workbook.Worksheets
Dim hoja1 = Workbook.Worksheets("Hoja1")
'DAMOS NOMBRE A LAS COLUMNAS
INICIALIZAR_PLANILLA(hoja1)
While (aux <= CONTENEDOR.Count)
hoja1.Cells("C" & aux + 1).Value = ENTREGA.Item(aux - 1)
aux += 1
End While
aux = 1
While (aux <= IDCONTENEDOR.Count)
hoja1.Cells("A" & aux + 1).Value = NSPS.Item(aux - 1)
aux += 1
End While
aux = 1
While (aux <= IDCONTENEDOR.Count)
hoja1.Cells("B" & aux + 1).Value = NPLANILLA.Item(aux - 1)
aux += 1
End While
aux = 1
While (aux <= IDCONTENEDOR.Count)
hoja1.Cells("D" & aux + 1).Value = IDCONTENEDOR.Item(aux - 1)
aux += 1
End While
aux = 1
While (aux <= IDCONTENEDOR.Count)
hoja1.Cells("E" & aux + 1).Value = PAQUETE2.Item(aux - 1)
aux += 1
End While
aux = 1
While (aux <= IDCONTENEDOR.Count)
hoja1.Cells("F" & aux + 1).Value = VOLUMEN2.Item(aux - 1)
'Cambiar color de la celda ocupar este codigo'
'hoja1.Cells("A" & aux + 1).Style.Fill.PatternType = ExcelFillStyle.Solid
'hoja1.Cells("A" & aux + 1).Style.Fill.BackgroundColor.SetColor(Color.Red)
aux += 1
End While
aux = 1
excel.Save()
MsgBox("Documento Creado Correctamente", MsgBoxStyle.Information, Title:="Operacion Correcta")
Process.Start(path)
End If
End Sub
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
LIMPIAR_VARIABLES_PLANILLA()
TextBox2.Text = ""
MsgBox("Las variables de la planilla se han limpiado correctamente", MsgBoxStyle.Information, Title:="LIMPIAR")
End Sub
Private Sub TextBox2_TextChanged(sender As Object, e As EventArgs) Handles TextBox2.TextChanged
End Sub
End Class
so as you can this does not compare the two excel and it just shows me information
Any ideas on how to do this?
Thanks in advance
you need to match the rows by combining 2 loops.
For each itemfromfile1 in file1
for each itemfromfile2 in file2
' Match 2 rows with each other
if itemfromfile1.SomeField = itemfromfile2.SomeField then
' These are the linked rows between the 2 documents
end if
next
next
Simple fill in the pseudo variables with the code that your office implementation uses.
I have a tab control with 5 tabs on it. Each tab has a large number of individual controls on it. (Ranging from 3 to 70 controls, all standard checkboxes, textboxes, comboboxes and radiobuttons.)
When running, the drawing seems to freeze mid-way through changing tabs. So you end up with part of the old tab's controls along with part of the new tab's controls drawn together.
I'd like to be able to stop drawing until all the controls are fully loaded and the code has finished running the "scoring" code.
I have tried using Suspend/Resume Layout on both the tab control and individual pages, but it does not seem to have any affect on drawing.
I have also tried using a custom class I found while searching for an answer, but it either doesn't pause the drawing or it causes the form to become unstable visually.
Imports System.Runtime.InteropServices
Friend Class DrawingControl
<DllImport("user32.dll")>
Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As Boolean, ByVal lParam As Int32) As Integer
End Function
Private Const WM_SETREDRAW As Integer = 11
Public Shared Sub SuspendDrawing(ByVal parent As Control)
SendMessage(parent.Handle, WM_SETREDRAW, False, 0)
End Sub
Public Shared Sub ResumeDrawing(ByVal parent As Control)
SendMessage(parent.Handle, WM_SETREDRAW, True, 0)
parent.Refresh()
End Sub
End Class
*** EDIT 11/22/2019: Adding the "Scoring" code that runs when changing tabs
Here is the sequence of events that run when changing tabs:
1) TabControl Deselecting
Private Sub tabDetails_Deselecting(sender As Object, e As TabControlCancelEventArgs) Handles tabDetails.Deselecting
tabDetails.SuspendLayout()
pgAcademic.SuspendLayout()
pgBusiness.SuspendLayout()
pgLIS.SuspendLayout()
pgPatient.SuspendLayout()
pgRegulatory.SuspendLayout()
End Sub
2) TabControl Selected - No code here - However, it's after THIS that the tabs become "combined" with the outlines of controls from each tab.
3) TabControl Index Change
Private Sub tabDetails_SelectedIndexChanged(sender As Object, e As EventArgs) Handles tabDetails.SelectedIndexChanged
Dim pg As Integer = Me.tabDetails.SelectedIndex
Select Case pg
Case 0
Me.txtPageScore.Text = score_pgPatientCare
Case 1
Me.txtPageScore.Text = score_pgBusiness
Case 2
Me.txtPageScore.Text = score_pgLIS
Case 3
Me.txtPageScore.Text = score_pgAcademic
Case 4
Me.txtPageScore.Text = score_pgRegulatory
End Select
End Sub
4) Step 3 fires this code:
Private Sub UpdateScore()
Dim intTotalScore As Integer = Vars.intNewScore 'Max Score = 708
Dim intScore As Integer = 0
If Vars.DisableEvents Then Exit Sub
Vars.DisableEvents = True
score_pgPatientCare = Scoring.UpdateScore(Me.pgPatient)
score_pgBusiness = Scoring.UpdateScore(Me.pgBusiness)
score_pgLIS = Scoring.UpdateScore(Me.pgLIS)
score_pgAcademic = Scoring.UpdateScore(Me.pgAcademic)
score_pgRegulatory = Scoring.UpdateScore(Me.pgRegulatory)
intTotalScore += (score_pgPatientCare + score_pgBusiness + score_pgLIS + score_pgAcademic + score_pgRegulatory)
Using dbTPT As New BGL_ApplicationsEntities
'** Use this area if needing to calculate more than YES/NO
'**********************
'*** Patient Care ***
'**********************
If chkPatientCare_IRB.Checked Then
If Not txtPatientCare_IRB.Text.Trim = "" Then
Dim propertyName = "PatientCare_IRB_Approved"
intScore = CType(weightSettings.Items.Item(propertyName), Integer)
score_pgPatientCare += intScore
intTotalScore += intScore
End If
End If
'**********************
'*** Business ***
'**********************
If chkBusiness_Replace.Checked Then
If chkBusiness_Outdated.Checked Or
chkBusiness_Inferior.Checked Or
chkBusiness_Savings.Checked Then
intScore = 0
Dim propertyName = "Business_Replace_Just"
intScore = CType(weightSettings.Items.Item(propertyName), Integer)
score_pgBusiness += intScore
intTotalScore += intScore
End If
End If
End Using
ssLabel.Text = "Total Score: " + intTotalScore.ToString
custProgBar.Value = intTotalScore
Dim pg As Integer = Me.tabDetails.SelectedIndex
Select Case pg
Case 0
Me.txtPageScore.Text = score_pgPatientCare
Case 1
Me.txtPageScore.Text = score_pgBusiness
Case 2
Me.txtPageScore.Text = score_pgLIS
Case 3
Me.txtPageScore.Text = score_pgAcademic
Case 4
Me.txtPageScore.Text = score_pgRegulatory
End Select
Vars.DisableEvents = False
End Sub
5) The above code fires this code for each tab:
Module Scoring
Public Function UpdateScore(ByVal tab As TabPage) As Integer
Dim intPgScore As Integer = 0
Dim intScore As Integer = 0
Dim intMult As Integer = 0
Dim arrPropName() As String
Dim strPropName As String
Dim strYesNo As String = Nothing
'If Vars.DisableEvents Then Return 0
'Vars.DisableEvents = True
Using dbTPT As New BGL_ApplicationsEntities
If tab.Name = "pgPatient" Then
For Each pan In tab.ChildControls(Of Panel)
If pan.Name.ToString.Substring(0, 6) = "chkgrp" Then
Dim cuScores() As Integer = {0, 0, 0, 0, 0}
Dim i As Integer = 0
For Each chk As CheckBox In pan.ChildControls(Of CheckBox)
If chk.Checked Then
arrPropName = Split(chk.Name.Replace("chk", "").Replace("CU", "PatientCare"), "_")
strPropName = arrPropName(0) + "_" + arrPropName(1)
Dim w = dbTPT.tbl_Weights.FirstOrDefault(Function(n) n.Weight_Name = strPropName)
If w IsNot Nothing Then
intScore = CType(frmNewProject.weightSettings.Items.Item(arrPropName(0) + "_" + arrPropName(1)), Integer)
intMult = CType(frmNewProject.weightSettings.Items.Item(arrPropName(0) + "_" + arrPropName(2)), Integer)
cuScores(i) = intScore * intMult
End If
Else
cuScores(i) = 0
End If
i += 1
Next
For Each txt In pan.ChildControls(Of TextBox)
txt.Text = cuScores.Max.ToString
Next
intPgScore += cuScores.Max
End If
Next
End If
For Each chk As CheckBox In tab.ChildControls(Of CheckBox)
intScore = 0
arrPropName = Split(chk.Name.Replace("chk", ""), "_")
If Not arrPropName(0) = "CU" Then
If chk.Checked Then strYesNo = "_Yes" Else strYesNo = "_No"
strPropName = arrPropName(0) + "_" + arrPropName(1) + strYesNo
Dim w = dbTPT.tbl_Weights.FirstOrDefault(Function(n) n.Weight_Name = strPropName)
If w IsNot Nothing Then
intScore = CType(frmNewProject.weightSettings.Items.Item(strPropName), Integer)
End If
End If
intPgScore += intScore
Next
For Each rad As RadioButton In tab.ChildControls(Of RadioButton)
intScore = 0
arrPropName = Split(rad.Name.Replace("rad", ""), "_", 2)
strPropName = arrPropName(0) + "_" + arrPropName(1)
If rad.Checked Then
Dim w = dbTPT.tbl_Weights.FirstOrDefault(Function(n) n.Weight_Name = strPropName)
If w IsNot Nothing Then
intScore = CType(frmNewProject.weightSettings.Items.Item(arrPropName(0) + "_" + arrPropName(1)), Integer)
End If
End If
intPgScore += intScore
Next
For Each cbox As ComboBox In tab.ChildControls(Of ComboBox)
intScore = 0
If cbox.SelectedIndex > -1 Then
If cbox.SelectedIndex = 0 Then
intScore = 0
Else
strPropName = cbox.Name.Replace("cbox", "") + cbox.SelectedValue
Dim w = dbTPT.tbl_Weights.FirstOrDefault(Function(n) n.Weight_Name = strPropName)
If w IsNot Nothing Then
intScore = CType(frmNewProject.weightSettings.Items.Item(strPropName), Integer)
End If
End If
intPgScore += intScore
End If
Next
End Using
Return intPgScore
End Function
End Module
6) Selected tab is painted
Private Sub Paint_Tab(sender As Object, e As PaintEventArgs) Handles _
pgAcademic.Paint, pgBusiness.Paint, pgLIS.Paint, pgPatient.Paint, pgRegulatory.Paint
tabDetails.ResumeLayout()
pgAcademic.ResumeLayout()
pgBusiness.ResumeLayout()
pgLIS.ResumeLayout()
pgPatient.ResumeLayout()
pgRegulatory.ResumeLayout()
End Sub
I want to paste data from the clipboard to selected cells in a DGV. I found the following link: https://www.codeproject.com/Articles/208281/Copy-Paste-in-Datagridview-Control but I have no clue about C# so I converted the code to VB.net using an online tool. The Copy and cut part is working, but I am not able to paste to the DGV. The code looks like this:
'paste data
Private Sub PasteToolStripMenuItem1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles PasteToolStripMenuItem1.Click
PasteClipboardToDGV()
End Sub
Private Sub PasteClipboardToDGV()
If DgvLeidingen.SelectedCells.Count = 0 Then
MessageBox.Show("Please select a cell", "Paste", MessageBoxButtons.OK, MessageBoxIcon.Warning)
Return
End If
Dim startCell As DataGridViewCell = GetStartCell(DgvLeidingen)
Dim cbValue As Dictionary(Of Integer, Dictionary(Of Integer, String)) = ClipBoardValues(Clipboard.GetText())
Dim iRowIndex As Integer = startCell.RowIndex
For Each rowKey As Integer In cbValue.Keys
Dim iColIndex As Integer = startCell.ColumnIndex
For Each cellKey As Integer In cbValue(rowKey).Keys
If iColIndex <= DgvLeidingen.Columns.Count - 1 AndAlso iRowIndex <= DgvLeidingen.Rows.Count - 1 Then
Dim cell As DataGridViewCell = DgvLeidingen(iColIndex, iRowIndex)
End If
iColIndex = iColIndex + 1
Next
iRowIndex = iRowIndex + 1
Next
End Sub
Private Function GetStartCell(ByVal DGV As DataGridView) As DataGridViewCell
If DGV.SelectedCells.Count = 0 Then Return Nothing
Dim rowIndex As Integer = DGV.Rows.Count - 1
Dim colIndex As Integer = DGV.ColumnCount -1
For Each dgvCell As DataGridViewCell In DGV.SelectedCells
If dgvCell.RowIndex < rowIndex Then rowIndex = dgvCell.RowIndex
If dgvCell.ColumnIndex < colIndex Then colIndex = dgvCell.ColumnIndex
Next
Return DGV(colIndex, rowIndex)
End Function
Private Function ClipBoardValues(ByVal clipboardValue As String) As Dictionary(Of Integer, Dictionary(Of Integer, String))
Dim copyValues As Dictionary(Of Integer, Dictionary(Of Integer, String)) = New Dictionary(Of Integer, Dictionary(Of Integer, String))()
Dim lines As String() = clipboardValue.Split(vbLf)
For i As Integer = 0 To lines.Length - 1
copyValues(i) = New Dictionary(Of Integer, String)()
Dim lineContent As String() = lines(i).Split(vbTab)
If lineContent.Length = 0 Then
copyValues(i)(0) = String.Empty
Else
For j As Integer = 0 To lineContent.Length - 1
copyValues(i)(j) = lineContent(j)
Next
End If
Next
Return copyValues
End Function
In vb code, it needs to put "If cell.Selected Then cell.Value = cbValue(rowKey)(cellKey)", after "Dim cell As DataGridViewCell = DgvLeidingen(iColIndex, iRowIndex)"
I am working with Vb.NET and the requirement was to find the string n RTF control and make it , bold,italic or whatever color,I have done my efforts to find the string but yesterday I found it not working as per my requirement.
At bottom I will write the full code with test data.
I have a simple form and two control on it, One is CombBox to Select Different Test Cases and One RichTextBox for Displaying the Text.
'Class Declarations
Private FormattingApplied As Boolean = False
Private SelectedBold As Boolean = False
Private SearchText As String = String.Empty
Private SelectedItalic As Boolean = False
Private SelectedUnderLine As Boolean = False
' On Form Load
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
cmbList.Items.Add("Apple Pina Apple")
cmbList.Items.Add("Apple Delicious Pineapple")
cmbList.Items.Add("Apple Milk Shake Apa")
cmbList.Items.Add("Apple Strawberry ")
FormattingApplied = True
SelectedBold = True
cmbList.SelectedIndex = 0
End Sub
Function UppercaseFirstLetter(ByVal val As String) As String
' Test for nothing or empty.
If String.IsNullOrEmpty(val) Then
Return val
End If
Dim array() As Char = val.ToCharArray
array(0) = Char.ToUpper(array(0))
Return New String(array)
End Function
Private Sub ApplyFormatting(ByVal SearchText As String)
Dim TrimmedString As String = String.Empty
Dim ISTrimmed As Boolean = False
If FormattingApplied Then
Dim count As New List(Of Integer)()
If rtfText.Text.Length >= 53 Then
rtfText.Text = rtfText.Text.Substring(0, 50) + "..."
End If
For i As Integer = 0 To rtfText.Text.Length - 1
If rtfText.Text.IndexOf(SearchText, i) <> -1 Then
count.Add(rtfText.Text.IndexOf(SearchText, i))
ElseIf rtfText.Text.IndexOf(UppercaseFirstLetter(SearchText), i) <> -1 Then
count.Add(rtfText.Text.IndexOf(UppercaseFirstLetter(SearchText), i))
End If
Next
Try
For i As Integer = 0 To count.Count - 1
rtfText.[Select](count(i), SearchText.Length)
If SelectedBold Then
rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Bold)
ElseIf SelectedItalic Then
rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Italic)
ElseIf SelectedUnderLine Then
rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Underline)
'ElseIf SelectedBold AndAlso SelectedItalic AndAlso SelectedUnderLine Then
' rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Underline)
End If
count.RemoveAt(i)
Next
'For i As Integer = 0 To count.Count - 1
' rtfText.[Select](count(i), SearchText.Length)
' If SelectedBold Then
' rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Bold)
' ElseIf SelectedItalic Then
' rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Italic)
' ElseIf SelectedUnderLine Then
' rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Underline)
' End If
' count.RemoveAt(i)
'Next
Catch
count.Reverse()
End Try
rtfText.[Select](rtfText.Text.Length, 0)
rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Regular)
End If
End Sub
Private Sub cmbList_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbList.SelectedIndexChanged
rtfText.Text = cmbList.SelectedItem.ToString()
rtfText.[Select](0, rtfText.Text.Length)
rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Regular)
If cmbList.SelectedIndex > -1 Then
ApplyFormatting("apple")
End If
End Sub
Here is the output:
Use this method
Private Sub formatString(ByVal SearchText As String)
Dim position As Integer = 0
Dim rtfString As String = LCase(rtfText.Text)
Dim cnt As Integer = 0
Dim isStop As Boolean = False
While Not isStop
Dim i As Integer = rtfString.IndexOf(SearchText, cnt)
If i < 0 Then
isStop = True
Else
rtfText.Select(i, SearchText.Length)
rtfText.SelectionFont = New Font(rtfText.Font, FontStyle.Bold)
cnt = i + 1
End If
End While
rtfText.Select(position, 0)
End Sub
in the cmbList_SelectedIndexChanged
If cmbList.SelectedIndex > -1 Then
'ApplyFormatting("apple")
formatString("apple")
End If