Save in excel from visual basic studio - vba

I need to save from Visual Studio 2015 in Excel, the routine I have currently works for me but does not save the information as required, ie every time I press the save button you must add the information one underneath the other, which makes the code Is simply replacing the cell that was previously saved. Copy the code I use to save. I hope you can help me.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.add
oSheet = oBook.WorkSheets(1)
oSheet.Range("A9").Value = "Supply Ducts"
oSheet. Range("C5:E5"). Merge(True)
oSheet. Range("A5:B5"). Merge(True)
oSheet.Range("A5").Value = "Project Name:"
oSheet. Range("C6:E6"). Merge(True)
oSheet. Range("A6:B6"). Merge(True)
oSheet.Range("A6").Value = "Engineering Name:"
oSheet. Range("C7:E7"). Merge(True)
oSheet. Range("A7:B7"). Merge(True)
oSheet.Range("A7").Value = "Company Name:"
oSheet.Range("A10").Value = "tramo"
oSheet.Range("B10").Value = "Caudal de Diseño PCM"
oSheet.Range("C10").Value = "Velocidad de Diseño pie/min"
oSheet.Range("D10").Value = "Factor de Fricción"
oSheet.Range("E10").Value = "Diámetro Equivalente in"
oSheet.Range("F10").Value = "Alto del Ducto in"
oSheet.Range("G10").Value = "Ancho del Ducto in"
oSheet.Range("H10").Value = "Longitud del Ducto mts"
oSheet.Range("I10").Value = "Longitud del Ducto Equivalente ft"
oSheet.Range("J10").Value = "Espesor"
oSheet.Range("K10").Value = "Calibre"
oSheet.Range("L10").Value = "Kg Ductos"
oSheet.Range("M10").Value = "M2 Aislante"
oSheet.Range("N10").Value = "Delpa P in.c.a."
oSheet.Range("A09").End(XlDirection.xlDown).Offset(1, 0) = Tramo
oSheet.Range("B09").End(XlDirection.xlDown).Offset(1, 0) = Qdiseño
oSheet.Range("C09").End(XlDirection.xlDown).Offset(1, 0) = Velocidad2
oSheet.Range("D09").End(XlDirection.xlDown).Offset(1, 0) = FactorFriccion
oSheet.Range("E09").End(XlDirection.xlDown).Offset(1, 0) = Diameduct
oSheet.Range("F09").End(XlDirection.xlDown).Offset(1, 0) = Larcduct
oSheet.Range("G09").End(XlDirection.xlDown).Offset(1, 0) = Anchduct
oSheet.Range("H09").End(XlDirection.xlDown).Offset(1, 0) = Longducto
oSheet.Range("I90").End(XlDirection.xlDown).Offset(1, 0) = (Longducto * 3.28084)
oSheet.Range("J90").End(XlDirection.xlDown).Offset(1, 0) = espesor
oSheet.Range("K09").End(XlDirection.xlDown).Offset(1, 0) = calibre
oSheet.Range("L09").End(XlDirection.xlDown).Offset(1, 0) = (Anchduct + Larcduct) * espesor * Longducto * 11.64
oSheet.Range("M09").End(XlDirection.xlDown).Offset(1, 0) = (Anchduct + Larcduct + 4) * Longducto * 0.1016
oSheet.Range("N09").End(XlDirection.xlDown).Offset(1, 0) = ((Longducto * 3.28084 * FactorFriccion) / 100) * 1.05
oExcel.Visible = True
oExcel.UserControl = True
oBook.SaveAs(Environ("UserProfile") & "\desktop\Ductos1.xls")
End Sub

Related

Exception Thrown - Receive data from Arduino to Visual Basic

I'm trying to send serial data from Arduino and read it on Visual Basic. When I execute the code sometimes works and sometimes doesn't: throwing exception, System.ArgumentOutOfRangeException: 'Index and length must refer to a location within the string. Can you help me?
I'm new to Visual Basic, thanks.
Imports System.IO
Imports System.IO.Ports
Imports System.Threading
Public Class Form1
Dim TWSL, TWAL, THL, AoAL, WAL, PeL, RoilL, RyL, RydL As Integer
Dim TWS, TWA, TH, AoA, WA, Pe, Roil, Ry, Ryd, TWSResult, TWAResult, THResult, AoAResult, WAResult, PeResult, RoilResult, RyResult, RydResult As String
Dim StrSerialIn, StrSerialInRam As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.CenterToParent()
SerialPort1.PortName = "COM4"
SerialPort1.BaudRate = 9600
SerialPort1.Open()
Timer1.Start()
SerialPort1.Write(TrackBarAWA.Value & Chr(10))
End Sub
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Try
StrSerialIn = SerialPort1.ReadExisting
Dim TB As New TextBox
TB.Multiline = True
TB.Text = StrSerialIn
If TB.Lines.Count > 0 Then
If TB.Lines(0) = "Failed to read" Then
Timer1.Stop()
SerialPort1.Close()
Return
End If
StrSerialInRam = TB.Lines(0).Substring(0, 2)
If StrSerialInRam = "A" Then
TWS = TB.Lines(0)
TWSL = TWS.Length
Else
TWS = TWS
End If
StrSerialInRam = TB.Lines(1).Substring(0, 3)
If StrSerialInRam = "B" Then
TWA = TB.Lines(1)
TWAL = TWA.Length
Else
TWA = TWA
End If
StrSerialInRam = TB.Lines(2).Substring(0, 3)
If StrSerialInRam = "C" Then
TH = TB.Lines(2)
THL = TH.Length
Else
TH = TH
End If
StrSerialInRam = TB.Lines(3).Substring(0, 2)
If StrSerialInRam = "D" Then
AoA = TB.Lines(3)
AoAL = AoA.Length
Else
AoA = AoA
End If
StrSerialInRam = TB.Lines(4).Substring(0, 1)
If StrSerialInRam = "E" Then
WA = TB.Lines(4)
WAL = WA.Length
Else
WA = WA
End If
StrSerialInRam = TB.Lines(5).Substring(0, 3)
If StrSerialInRam = "F" Then
Pe = TB.Lines(5)
PeL = Pe.Length
Else
Pe = Pe
End If
StrSerialInRam = TB.Lines(6).Substring(0, 3)
If StrSerialInRam = "G" Then
Roil = TB.Lines(6)
RoilL = Roil.Length
Else
Roil = Roil
End If
StrSerialInRam = TB.Lines(7).Substring(0, 3)
If StrSerialInRam = "H" Then
Ry = TB.Lines(7)
RyL = Ry.Length
Else
Ry = Ry
End If
StrSerialInRam = TB.Lines(8).Substring(0, 3)
If StrSerialInRam = "I" Then
Ryd = TB.Lines(8)
RydL = Ryd.Length
Else
Ryd = Ryd
End If
TWSResult = Mid(TWS, 2, TWSL)
TWAResult = Mid(TWA, 2, TWAL)
THResult = Mid(TH, 2, THL)
AoAResult = Mid(AoA, 2, AoAL)
WAResult = Mid(WA, 2, WAL)
PeResult = Mid(Pe, 2, PeL)
RoilResult = Mid(Roil, 2, RoilL)
RyResult = Mid(Ry, 2, RyL)
RydResult = Mid(Ryd, 2, RydL)
TWSvalue.Text = TWSResult
TWAvalue.Text = TWAResult
THvalue.Text = THResult
AoAvalue.Text = AoAResult
WAvalue.Text = WAResult
PeValue.Text = PeResult
RoilValue.Text = RoilResult
RyValue.Text = RyResult
RydValue.Text = RydResult
From what I gather, you are trying to get characters from specific places in specific lines on a text box. Based on the error message you included in your question, I assume the error occurs on a line of code containing the "String. Substring" method. If the string where you are getting the substring from is too short to cover the range you have specified in the substring method, you will get this error. For instance, if you are getting a substring that's 3 characters long from line 2 starting at character 0 and it has less than 3 characters, you will get this error.
See the documentation on the String.Substring method here

'System.ArgumentOutOfRangeException'"Tried the other solution but never gotten to the point of resolving" [duplicate]

This question already has answers here:
What is an IndexOutOfRangeException / ArgumentOutOfRangeException and how do I fix it?
(5 answers)
Closed 2 years ago.
i've tried the other solution(like changing item that should be shown on data) but i think i've never gotten the point to resolving. Thank you in advance whoever can answer my problem...
Private Sub dgEmp_Click(sender As Object, e As EventArgs) Handles dgEmp.Click
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End Sub
Private Sub LoadEmployee(Optional q As String = "")
list.Query = "Select id,lastname,firstname,middlename,sss,philh,pag,rate,cola,mStatus,free_insurance,mp,mpvalue from tblemployee where (lastname like'%" & q & "%' or firstname like'%" & q & "%' or middlename like'%" & q & "%') and deactive='No' order by lastname,firstname,middlename"
list.datagrid = dgEmp
list.LoadRecords()
If list.RecordCount = Nothing Then Exit Sub
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End Sub
Public Sub LoadEmployeeInfo(index As Integer)
With dgEmp.Rows(index)
id = .Cells(0).Value
lblName.Text = .Cells(1).Value & ", " & .Cells(2).Value & " " & .Cells(3).Value
rpd = .Cells(7).Value
lblRate.Text = Format(rpd, "#,##0.000000000")
cola = .Cells(8).Value
lblAllo.Text = Format(cola, "#,##0.000000000")
otrate = (rpd / 8) * 1.25
lblOTRate.Text = Format(otrate, "#,##0.000000000")
IsSSS = ConvertToBoolean(.Cells(4).Value)
IsPH = ConvertToBoolean(.Cells(5).Value) 'add
IsPAG = ConvertToBoolean(.Cells(6).Value) 'pos
IsMP = ConvertToBoolean(.Cells(11).Value)
IsFI = ConvertToBoolean(.Cells(10).Value)
CStatus = .Cells(9).Value
MPV = .Cells(12).Value
End With
ThisPayroll.Query = "Select * from tblpayroll where payrollperiod=? and empid=?"
ThisPayroll.AddParam("#payrollperiod", GetPeriod)
ThisPayroll.AddParam("#empid", id)
ThisPayroll.ExecQuery()
If ThisPayroll.RecordCount = Nothing Then
isUpdate = False
txtReg_Days.Text = 0
txtReg_OT.Text = 0
txtSP_Days.Text = 0
txtSP_OT.Text = 0
txtHoliday.Text = 0
txtHolidayOT.Text = 0
txtLate.Text = 0
txtAdjustment.Text = 0
txtSSSL.Text = 0
txtHDMFL.Text = 0
txtCA.Text = 0
txtDMA.Text = 0
txtRice.Text = 0
txtCloth.Text = 0
txtEmpMed.Text = 0
txtLaundry.Text = 0
txtMeal.Text = 0
Else
With ThisPayroll.DataSource
isUpdate = True
txtReg_Days.Text = .Rows(0)("regday")
txtReg_OT.Text = .Rows(0)("ot")
txtSP_Days.Text = .Rows(0)("spday")
txtSP_OT.Text = .Rows(0)("spdayot")
txtHoliday.Text = .Rows(0)("lholiday")
txtHolidayOT.Text = .Rows(0)("lhot")
txtLate.Text = .Rows(0)("hlate")
txtAdjustment.Text = .Rows(0)("salary_adj")
txtSSSL.Text = .Rows(0)("sss_loan")
txtHDMFL.Text = .Rows(0)("pag_loan")
txtCA.Text = .Rows(0)("cash_advance")
txtDMA.Text = .Rows(0)("depmed")
txtRice.Text = .Rows(0)("ricesub")
txtCloth.Text = .Rows(0)("clothing")
txtEmpMed.Text = .Rows(0)("empmed")
txtLaundry.Text = .Rows(0)("laundry")
txtMeal.Text = .Rows(0)("meal")
End With
End If
Compute()
End Sub
If you cannot make sure that something is selected elsewhere, you can last-minute check it like this:
Private Sub DataGridView1_SelectionChanged(sender As Object, e As EventArgs) Handles DataGridView1.SelectionChanged
If dgEmp.SelectedRows.Count > 0 Then
LoadEmployeeInfo(dgEmp.SelectedRows.Item(0).Index)
End If
End Sub
It works only because you're using index zero, or else you would have to be careful for your index, too. Of course, this is assuming that dgEmp is not Nothing...
Also, notice that I attached this to the SelectionChanged event, as I don't think that the Click event will give you what you want, but I'll let that part for you to deal with. Have fun!

Strange issue with Datagridview-Rows not displayed

I have a Datagridview connected to a dataset.The problem is that occasionally,when the data is refreshed,it is not displayed in the DGV.The code is:
Private Sub DisplayInDGV()
Dim SQLSet As String
Dim DASet As New OleDb.OleDbDataAdapter
Dim DSSet As New DataSet
SQLSet = "Select * From SetDisplayTable"
DASet = New OleDb.OleDbDataAdapter(SQLSet, Con)
DSSet.Clear()
DASet.Fill(DSSet, "DSSetHere")
With DGVSetView
.Refresh()
.AutoGenerateColumns = False
.DataSource = Nothing
.DataSource = DSSet.Tables(0)
.Update()
DGVSetView.Columns(i).DataPropertyName = DSSet.Tables(0).Columns(i).ToString
.Columns(0).DataPropertyName = DSSet.Tables(0).Columns(0).ToString
.Columns(2).DataPropertyName = DSSet.Tables(0).Columns(1).ToString
.Columns(3).DataPropertyName = DSSet.Tables(0).Columns(2).ToString
.Columns(4).DataPropertyName = DSSet.Tables(0).Columns(3).ToString
.Columns(5).DataPropertyName = DSSet.Tables(0).Columns(4).ToString
.Columns(6).DataPropertyName = DSSet.Tables(0).Columns(5).ToString
.Columns(7).DataPropertyName = DSSet.Tables(0).Columns(6).ToString
.Columns(8).DataPropertyName = DSSet.Tables(0).Columns(7).ToString
.Columns(9).DataPropertyName = DSSet.Tables(0).Columns(8).ToString
.Columns(10).DataPropertyName = DSSet.Tables(0).Columns(9).ToString
.Columns(11).DataPropertyName = DSSet.Tables(0).Columns(10).ToString 'Item Unique Code for Hot Edit
.Columns(14).DataPropertyName = DSSet.Tables(0).Columns(12).ToString
End With
'Updating Totals/::
For ItemRow As Integer = 0 To DGVSetView.Rows.Count - 1
If DGVSetView.Rows(ItemRow).Cells(14).Value = True Then
DGVSetView.Rows(ItemRow).Cells(12).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
ElseIf DGVSetView.Rows(ItemRow).Cells(14).Value = False Then
DGVSetView.Rows(ItemRow).Cells(13).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
End If
Next
'Updating School and general totals in DGV//:
Dim SchoolTotal, GeneralTotal As Decimal
For ColumnTotal As Integer = 0 To DGVSetView.Rows.Count - 1
SchoolTotal += DGVSetView.Rows(ColumnTotal).Cells(12).Value
GeneralTotal += DGVSetView.Rows(ColumnTotal).Cells(13).Value
Next
txtSchoolAmtFinal.Text = SchoolTotal
txtGeneralAmtFinal.Text = GeneralTotal
DGVSetView.Update()
'Get gross total of the DGV amount column//:
If DGVSetView.RowCount <> 0 Then
Dim GrossAmt As Decimal = 0
For Index As Integer = 0 To DGVSetView.RowCount - 1
' GrossAmt += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(11).Value)
If Str(DGVSetView.Rows(Index).Cells(10).Value) = "Null" Or (DGVSetView.Rows(Index).Cells(10).Value) <= 0 Then
MsgBox("Item Number " & (DGVSetView.Rows(Index).Cells(10).Value) & " is either blank or 0", MsgBoxStyle.Exclamation, "Item Error")
Else
GrossAmt += Convert.ToDecimal(DGVSetView.Rows(Index).Cells(10).Value)
End If
Next
txtInsertGrossAmt.Text = GrossAmt ' - Val(DGVSetView.Text)
Call SetNetAmount()
End If
'Generate Serial//:
Dim X As Integer
Do While X < DGVSetView.Rows.Count
DGVSetView.Item(0, X).Value = X + 1
X = X + 1
Loop
'Disbaling editing in all columns except pending//:
With DGVSetView
.Columns(0).ReadOnly = True
.Columns(2).ReadOnly = True
.Columns(3).ReadOnly = True
.Columns(4).ReadOnly = True
.Columns(5).ReadOnly = True
.Columns(6).ReadOnly = True
.Columns(7).ReadOnly = True
.Columns(8).ReadOnly = True
.Columns(9).ReadOnly = True
.Columns(10).ReadOnly = True
End With
txtTotalItems.Text = DGVSetView.Rows.Count
For Each r As DataGridViewRow In DGVSetView.Rows
r.Cells(1).Value = True
Next r
End Sub
The problem is that occasionally,the DGV will not show any rows and displays a blank frame.At such instances.if I check in DGV.Rows.count
the result is 0 despite there being underlying data in the table.
Note that this happens randomly.At other times the DGV refreshed properly and also displays data correctly.
Also note that this DGV resides within a TabControl.
Further,when the DGV fails to display the data,the totals which I have calculated in the above sub procedure return zero value.As such the problem appears to lie somewhere in the rows not being inserted in the DGV.
Thank you.
Khalid.
//Edit;Code Updated:
#jmcilhinney I have updated my code as follows.However,the earlier problem of the DGV going blank occasionally persists.Also the update process has slowed down slightly.It seems I may be making a mistake in the location of placing the Suspend and ResumeBinding statements:
Private Sub SetPreview()
Dim SQLSet As String
Dim DASet As New OleDb.OleDbDataAdapter
Dim DSSet As New DataSet
SQLSet = "Select * From SetDisplayTable"
Dim DTDGV As New DataTable
Dim DGVBindingSource As New BindingSource
DASet = New OleDb.OleDbDataAdapter(SQLSet, Con)
DASet.Fill(DTDGV)
DGVBindingSource.DataSource = DTDGV
DGVBindingSource.ResumeBinding()
With DGVSetView
.AutoGenerateColumns = False
.DataSource = DGVBindingSource
.Columns(0).DataPropertyName = DTDGV.Columns(0).ToString
.Columns(2).DataPropertyName = DTDGV.Columns(1).ToString
.Columns(3).DataPropertyName = DTDGV.Columns(2).ToString
.Columns(4).DataPropertyName = DTDGV.Columns(3).ToString
.Columns(5).DataPropertyName = DTDGV.Columns(4).ToString
.Columns(6).DataPropertyName = DTDGV.Columns(5).ToString
.Columns(7).DataPropertyName = DTDGV.Columns(6).ToString
.Columns(8).DataPropertyName = DTDGV.Columns(7).ToString
.Columns(9).DataPropertyName = DTDGV.Columns(8).ToString
.Columns(10).DataPropertyName = DTDGV.Columns(9).ToString
.Columns(11).DataPropertyName = DTDGV.Columns(10).ToString 'Item Unique Code for Hot Edit
.Columns(14).DataPropertyName = DTDGV.Columns(12).ToString
End With
DGVBindingSource.SuspendBinding()
'Updating Totals/::
For ItemRow As Integer = 0 To DGVSetView.Rows.Count - 1
If DGVSetView.Rows(ItemRow).Cells(14).Value = True Then
DGVSetView.Rows(ItemRow).Cells(12).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
ElseIf DGVSetView.Rows(ItemRow).Cells(14).Value = False Then
DGVSetView.Rows(ItemRow).Cells(13).Value = DGVSetView.Rows(ItemRow).Cells(10).Value
End If
Next
'Updating School and general totals in DGV//:
Dim SchoolTotal, GeneralTotal As Decimal
For ColumnTotal As Integer = 0 To DGVSetView.Rows.Count - 1
SchoolTotal += DGVSetView.Rows(ColumnTotal).Cells(12).Value
GeneralTotal += DGVSetView.Rows(ColumnTotal).Cells(13).Value
Next
txtSchoolAmtFinal.Text = SchoolTotal
txtGeneralAmtFinal.Text = GeneralTotal
DGVSetView.Update()
'Get gross total of the DGV amount column//:
If DGVSetView.RowCount <> 0 Then
Dim GrossAmt As Decimal = 0
For Index As Integer = 0 To DGVSetView.RowCount - 1
' GrossAmt += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(11).Value)
If Str(DGVSetView.Rows(Index).Cells(10).Value) = "Null" Or (DGVSetView.Rows(Index).Cells(10).Value) <= 0 Then
MsgBox("Item Number " & (DGVSetView.Rows(Index).Cells(10).Value) & " is either blank or 0", MsgBoxStyle.Exclamation, "Item Error")
Else
GrossAmt += Convert.ToDecimal(DGVSetView.Rows(Index).Cells(10).Value)
End If
Next
txtInsertGrossAmt.Text = GrossAmt ' - Val(DGVSetView.Text)
Call SetNetAmount()
End If
'Disabling editing in all columns except pending//:
With DGVSetView
.Columns(0).ReadOnly = True
.Columns(2).ReadOnly = True
.Columns(3).ReadOnly = True
.Columns(4).ReadOnly = True
.Columns(5).ReadOnly = True
.Columns(6).ReadOnly = True
.Columns(7).ReadOnly = True
.Columns(8).ReadOnly = True
.Columns(9).ReadOnly = True
.Columns(10).ReadOnly = True
End With
txtTotalItems.Text = DGVSetView.Rows.Count
For Each r As DataGridViewRow In DGVSetView.Rows
r.Cells(1).Value = True
Next r
End Sub

how to get picture from database to picture box by using textbox lost focus

Private Sub tunjukrekod()
Dim cn As MySqlConnection = New MySqlConnection()
cn.ConnectionString = ("server=localhost; userid=root; password=; database=payrollsystemdb;")
cn.Open()
cmd.Connection = cn
Try
If TextBoxEmployeeID.Text <> "" Then
dt.Clear()
cmd = New MySqlCommand("select * from employeedetail where EmployeeID='" & TextBoxEmployeeID.Text & "'", cn)
da = New MySqlDataAdapter(cmd)
da.Fill(dt)
TextBoxEmployeeID.Text = dt.Rows(0).Item(0)
TextBoxEmployeeName.Text = dt.Rows(0).Item(1)
TextBoxChineseName.Text = dt.Rows(0).Item(2)
If dt.Rows(0).Item(3) = "Active" Then
RadioButtonActiveStatus.Checked = True
ElseIf dt.Rows(0).Item(3) = "Inactive" Then
RadioButtonInactiveStatus.Checked = True
End If
TextBoxbranchID.Text = dt.Rows(0).Item(4)
TextBoxAccessLevel.Text = dt.Rows(0).Item(5)
RichTextBoxAddress.Text = dt.Rows(0).Item(6)
TextBoxTel1.Text = dt.Rows(0).Item(7)
TextBoxTel2.Text = dt.Rows(0).Item(8)
TextBoxMobile.Text = dt.Rows(0).Item(9)
TextBoxEmail.Text = dt.Rows(0).Item(10)
TextBoxICNew.Text = dt.Rows(0).Item(11)
TextBoxICOld.Text = dt.Rows(0).Item(12)
TextBoxPassport.Text = dt.Rows(0).Item(13)
DateTimePickerpassportexpire.Value = dt.Rows(0).Item(14)
TextBoxPermit.Text = dt.Rows(0).Item(15)
DateTimePickerpermitexpire.Value = dt.Rows(0).Item(16)
DateTimePickerBirthDate.Value = dt.Rows(0).Item(17)
TextBoxreligionPD.Text = dt.Rows(0).Item(18)
TextBoxAge.Text = dt.Rows(0).Item(19)
TextBoxracePD.Text = dt.Rows(0).Item(20)
TextBoxcitizenshipPD.Text = dt.Rows(0).Item(21)
TextBoxsexPD.Text = dt.Rows(0).Item(22)
TextBoxmaritalPD.Text = dt.Rows(0).Item(23)
If dt.Rows(0).Item(24) = "yes" Then
RadioButtonyesC.Checked = True
ElseIf dt.Rows(0).Item(24) = "No" Then
RadioButtonnoC.Checked = True
End If
If dt.Rows(0).Item(25) = "yes" Then
RadioButtonYesEOT.Checked = True
ElseIf dt.Rows(0).Item(25) = "No" Then
RadioButtonnoEOT.Checked = True
End If
TextBoxNameSpouse.Text = dt.Rows(0).Item(26)
TextBoxICNewSpouse.Text = dt.Rows(0).Item(27)
TextBoxICOldSpouse.Text = dt.Rows(0).Item(28)
RichTextBoxAddressSpouse.Text = dt.Rows(0).Item(29)
TextBoxIncomeSpouse.Text = dt.Rows(0).Item(30)
TextBoxBranchSpouse.Text = dt.Rows(0).Item(31)
If dt.Rows(0).Item(32) = "yes" Then
RadioButtonyesworking.Checked = True
ElseIf dt.Rows(0).Item(32) = "No" Then
RadioButtonNoworking.Checked = True
End If
TextBoxChildrenSpouse.Text = dt.Rows(0).Item(33)
If dt.Rows(0).Item(34) = "Auto" Then
RadioButtonAutoAuMaSpouse.Checked = True
ElseIf dt.Rows(0).Item(34) = "Manual" Then
RadioButtonManualAuMaSpouse.Checked = True
End If
TextBoxpositionED.Text = dt.Rows(0).Item(35)
TextBoxdepartmentED.Text = dt.Rows(0).Item(36)
TextBoxdivisionED.Text = dt.Rows(0).Item(37)
TextBoxsectionED.Text = dt.Rows(0).Item(38)
TextBoxlocationED.Text = dt.Rows(0).Item(39)
TextBoxgradeED.Text = dt.Rows(0).Item(40)
TextBoxcategoryED.Text = dt.Rows(0).Item(41)
TextBoxworkgroupED.Text = dt.Rows(0).Item(42)
TextBoxformularateED.Text = dt.Rows(0).Item(43)
DateTimePickerjoindateED.Value = dt.Rows(0).Item(44)
DateTimePickerconfirmdateED.Value = dt.Rows(0).Item(45)
DateTimePickerresigneddateED.Value = dt.Rows(0).Item(46)
TextBoxacbankED.Text = dt.Rows(0).Item(47)
If dt.Rows(0).Item(48) = "IC New" Then
RadioButtonICNewACBank.Checked = True
ElseIf dt.Rows(0).Item(48) = "IC Old" Then
RadioButtonICOldACBank.Checked = True
ElseIf dt.Rows(0).Item(48) = "Passport No" Then
RadioButtonPassportNoACBank.Checked = True
ElseIf dt.Rows(0).Item(48) = "Permit No" Then
RadioButtonPermitNoACBank.Checked = True
End If
TextBoxACNoED.Text = dt.Rows(0).Item(49)
TextBoxHRDFundED.Text = dt.Rows(0).Item(50)
If dt.Rows(0).Item(51) = "IC New" Then
RadioButtonICNewHRDFund.Checked = True
ElseIf dt.Rows(0).Item(51) = "IC Old" Then
RadioButtonICOldHRDFund.Checked = True
ElseIf dt.Rows(0).Item(51) = "Passport No" Then
RadioButtonPassportNoHRDFund.Checked = True
ElseIf dt.Rows(0).Item(51) = "Permit No" Then
RadioButtonPermitNoHRDFund.Checked = True
End If
TextBoxProbationED.Text = dt.Rows(0).Item(52)
TextBoxSalaryED.Text = dt.Rows(0).Item(53)
TextBoxNoticeResignED.Text = dt.Rows(0).Item(54)
TextBoxEmployerNamePE.Text = dt.Rows(0).Item(55)
RichTextBoxAddressPE.Text = dt.Rows(0).Item(56)
TextBoxTelNo1PE.Text = dt.Rows(0).Item(57)
TextBoxTelNo2PE.Text = dt.Rows(0).Item(58)
TextBoxFaxPE.Text = dt.Rows(0).Item(59)
TextBoxPICPE.Text = dt.Rows(0).Item(60)
TextBoxPositionPE.Text = dt.Rows(0).Item(61)
DateTimePickerdatejoinPE.Value = dt.Rows(0).Item(62)
TextBoxSalaryPE.Text = dt.Rows(0).Item(63)
DateTimePickerdateresignPE.Value = dt.Rows(0).Item(64)
TextBoxReasonPE.Text = dt.Rows(0).Item(65)
TextBoxEPFNoGD.Text = dt.Rows(0).Item(66)
If dt.Rows(0).Item(67) = "IC New" Then
RadioButtonICNewICTypeEPFGD.Checked = True
ElseIf dt.Rows(0).Item(67) = "IC Old" Then
RadioButtonICOldICTypeEPFGD.Checked = True
ElseIf dt.Rows(0).Item(67) = "Passport No" Then
RadioButtonPassportNoICTypeEPFGD.Checked = True
ElseIf dt.Rows(0).Item(67) = "Permit No" Then
RadioButtonPermitNoICTypeEPFGD.Checked = True
End If
TextBoxInitialGD.Text = dt.Rows(0).Item(68)
TextBoxNKGD.Text = dt.Rows(0).Item(69)
TextBoxepftableGD.Text = dt.Rows(0).Item(70)
TextBoxkwspGD.Text = dt.Rows(0).Item(71)
TextBoxIncomeTaxGD.Text = dt.Rows(0).Item(72)
If dt.Rows(0).Item(73) = "IC New" Then
RadioButtonICNewICTypeIncomeGD.Checked = True
ElseIf dt.Rows(0).Item(73) = "IC Old" Then
RadioButtonICOldICTypeIncomeGD.Checked = True
ElseIf dt.Rows(0).Item(73) = "Passport No" Then
RadioButtonPassportNoICTypeIncomeGD.Checked = True
ElseIf dt.Rows(0).Item(73) = "Permit No" Then
RadioButtonPermitNoICTypeIncomeGD.Checked = True
End If
TextBoxbranchincomeGD.Text = dt.Rows(0).Item(74)
TextBoxpcbcodeGD.Text = dt.Rows(0).Item(75)
TextBoxincometaxdeptGD.Text = dt.Rows(0).Item(76)
TextBoxSocsoNoGD.Text = dt.Rows(0).Item(77)
If dt.Rows(0).Item(78) = "IC New" Then
RadioButtonICNewICTypeSocsoGD.Checked = True
ElseIf dt.Rows(0).Item(78) = "IC Old" Then
RadioButtonICOldICTypeSocsoGD.Checked = True
ElseIf dt.Rows(0).Item(78) = "Passport No" Then
RadioButtonPassportNoICTypeSocsoGD.Checked = True
ElseIf dt.Rows(0).Item(78) = "Permit No" Then
RadioButtonPermitNoICTypeSocsoGD.Checked = True
End If
TextBoxBranchSocsoGD.Text = dt.Rows(0).Item(79)
TextBoxSocsoOfficeGD.Text = dt.Rows(0).Item(80)
TextBoxsocsotypeGD.Text = dt.Rows(0).Item(81)
TextBoxboardofsocsoGD.Text = dt.Rows(0).Item(82)
TextBoxTHAccGD.Text = dt.Rows(0).Item(83)
If dt.Rows(0).Item(84) = "IC New" Then
RadioButtonICNewICTypeTHGD.Checked = True
ElseIf dt.Rows(0).Item(84) = "IC Old" Then
RadioButtonICOldICTypeTHGD.Checked = True
ElseIf dt.Rows(0).Item(84) = "Passport No" Then
RadioButtonPassportNoICTypeTHGD.Checked = True
ElseIf dt.Rows(0).Item(84) = "Permit No" Then
RadioButtonPermitNoICTypeTHGD.Checked = True
End If
TextBoxthcGD.Text = dt.Rows(0).Item(85)
'Dim ms As New MemoryStream(changephoto(CInt(khaiEDForm2.DataGridViewfind.SelectedCells(0).Value)))
'PictureBox1.Image = Image.FromStream(ms)
cmd = New MySqlCommand("select * from salarydetail", cn)
da.SelectCommand = cmd
da.Fill(dtsalary)
End If
Catch ex As Exception
'TextBoxEmployeeName.Focus()
End Try
End Sub
'Function changephoto(ByVal photo As Integer) As Byte()
' Dim cn As MySqlConnection = New MySqlConnection()
' cn.ConnectionString = ("server=localhost; userid=root; password=; database=payrollsystemdb;")
' cn.Open()
' '.CommandText = System.Data.CommandType.Text
' With cmd
' .Connection = cn
' .CommandText = "SELECT Imageblob FROM employeedetail WHERE EmployeeID=" & khaiEDForm2.DataGridViewfind.SelectedRows(0).Cells(0).Value
' End With
' Dim myphoto() As Byte = CType(cmd.ExecuteScalar(), Byte())
' cn.Close()
' Return myphoto
'End Function
Private Sub TextBoxEmployeeID_LostFocus(sender As Object, e As EventArgs) Handles TextBoxEmployeeID.LostFocus
If TextBoxEmployeeID.Text = "" Then
TextBoxEmployeeID.Select()
Else
tunjukrekod()
tunjukdgv()
End If
addrow()
End Sub
How I Can Rewrite the code? because the code cam retrive picture only when from form2 to form1.
I used visual studio express 2014, MySQL Database using PHPMYADMIN, MySQLConnection.
ok . i got the solution ! finally !
dr = cmd.ExecuteReader()
If (dr.HasRows) Then
While (dr.Read())
With Me
'fetch image from database
Dim imgBytes() As Byte = dr("Imageblob") 'image field
Dim image As Bitmap = New Bitmap(New System.IO.MemoryStream(imgBytes)) 'convert binary to image
.PictureBox1.Image = image 'show picture to picture box
End With
End While
Else
MsgBox("No records Found!")
End If

Problems adding DataTable as datasource in C1Report (VB) ComponentOne

I'm having troubles to assign a datasource to a code-generated c1report.
This is the datatable data.
This is the output result pdf view.
I'm using Visual Studio 2008 with ComponentOne 2009.
The result pdf file as not the correct data, only the titles repeated to bottom.
Then, this is the vb code:
Public Function DataTableToC1Report(ByVal dtDatos As DataTable, ByVal strTitulo As String) As C1.C1Report.C1Report
Dim c1r As New C1.C1Report.C1Report
'Inicia control
With c1r
'limpia fields existentes
.Clear()
'configura fuente para todos los controles
.Font.Name = "Tahoma"
.Font.Size = 8
End With
'Inicializar diseño
With c1r.Layout
.Orientation = C1.C1Report.OrientationEnum.Portrait
.Width = 6.5 * 1440 ' 8.5 - margen, en twips (aprox. son 567 twips por centímetro)
End With
'Crear encabezado y agregar field para titulo
Dim f As C1.C1Report.Field
With c1r.Sections(C1.C1Report.SectionTypeEnum.Header)
.Height = 1440
.Visible = True
.BackColor = Color.FromArgb(200, 200, 200)
f = .Fields.Add("FldTitle", strTitulo, 0, 0, 8000, 1440)
f.Font.Size = 24
f.Font.Bold = True
f.ForeColor = Color.FromArgb(0, 0, 100)
End With
'Crea footer de página
With c1r.Sections(C1.C1Report.SectionTypeEnum.PageFooter)
.Height = 500
.Visible = True
f = .Fields.Add("FldFtrLeft", """Generado el "" & Now", 0, 0, 4000, 300)
f.Calculated = True
f = .Fields.Add("FldFtrRight", """Página "" & Page & "" de "" & Pages", 4000, 0, 4000, 300)
f.Calculated = True
f.Align = C1.C1Report.FieldAlignEnum.RightTop
f.Width = c1r.Layout.Width - f.Left
f = .Fields.Add("FldLine", "", 0, 0, c1r.Layout.Width, 20)
f.LineSlant = C1.C1Report.LineSlantEnum.NoSlant
f.BorderStyle = C1.C1Report.BorderStyleEnum.Solid
f.BorderColor = Color.FromArgb(0, 0, 100)
End With
'Genera títulos con fields
With c1r.Sections(C1.C1Report.SectionTypeEnum.PageHeader)
.Height = 500
.Visible = True
Dim i As Integer = 0
Dim pIzq As Double = 0
Dim pArriba As Double = 50
Dim pAncho As Double = 800
Dim pAltura As Double = 300
For Each dc As DataColumn In dtDatos.Columns
c1r.Font.Bold = True
f = .Fields.Add("lblCol" & i.ToString, dc.ColumnName, pIzq, pArriba, pAncho, pAltura)
c1r.Font.Bold = False
f.Align = C1.C1Report.FieldAlignEnum.CenterMiddle
i += 1
pIzq += (pAncho + 100)
Next
f = .Fields.Add("FldLine", "", 0, 400, c1r.Layout.Width, 20)
f.LineSlant = C1.C1Report.LineSlantEnum.NoSlant
f.LineWidth = 50
f.BorderColor = Color.FromArgb(100, 100, 100)
End With
'Crea sección de detalle
With c1r.Sections(C1.C1Report.SectionTypeEnum.Detail)
Dim i As Integer = 0
Dim pIzq As Double = 0
Dim pArriba As Double = 0
Dim pAncho As Double = 800
Dim pAltura As Double = 300
.Height = 330
.Visible = True
For Each dc As DataColumn In dtDatos.Columns
c1r.Font.Bold = True
f = .Fields.Add("fldCol" & i.ToString, dc.ColumnName, pIzq, pArriba, pAncho, pAltura)
c1r.Font.Bold = False
f.Calculated = False 'agregar que permita verificar si la columna debe ser calculada y poner en True
f.CanGrow = False 'agregar que permita verificar si la columna puede crecer de tamaño
f.Align = C1.C1Report.FieldAlignEnum.CenterMiddle
'f.Width = c1r.Layout.Width - f.Left
f.Font.Size = 6
i += 1
pIzq += (pAncho + 100)
Next
f = .Fields.Add("FldLine", "", 0, 310, c1r.Layout.Width, 20)
f.LineSlant = C1.C1Report.LineSlantEnum.NoSlant
f.BorderStyle = C1.C1Report.BorderStyleEnum.Solid
f.BorderColor = Color.FromArgb(100, 100, 100)
End With
'Inicializar(DataSource)
With c1r.DataSource
'.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source=C:\...\ComponentOne Samples\Common\C1NWind.mdb;" & _
' "Persist Security Info=False"
'.RecordSource = "Employees"
.Recordset = dtDatos
End With
Return c1r
End Function
I think the issue is because you've set the Calculated property of the fields added in the Detail section to False. You need to set it to True in order to bind data to the fields.