vb.net and crystal report responding so slow - vb.net

Hi good day can anyone help me for my project i have created a vb.net application that produced a 473052 record in the report and i take 3-5 minutes before the report loaded here's my code:
---my function
Public Function staffbyyear(ByVal dates As String) As DataTable
Dim db = New database
Dim dt As New DataTable
With db
.sqlStr = "SELECT date, attendant, subtotal FROM transactions where year(date)= '" & dates & "' and finish = 1" 'query string
.sqlDa.SelectCommand = .sqlcm(.sqlStr, .connect) 'execute command
.sqlDa.Fill(.sqlDt) 'get results and store in sqldt
.close()
End With
dt = db.sqlDt
Return dt
End Function
--to fill my report
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared
Private rptstr as string
Private Sub fillreportstaffbyyear(ByVal d As String)
Dim cryRpt As New ReportDocument
Dim rptPath = Application.StartupPath.Remove(Application.StartupPath.IndexOf("bin"), Len(Application.StartupPath) - Application.StartupPath.IndexOf("bin"))
cryRpt.Load(rptPath & "reportstaffbyyear.rpt") '
cryRpt.SetDataSource(staffbyyear(cmbyear.Text))
'---modified here
crviewer.crv1.ReportSource = cryRpt
rptstr = vbNullString
End Sub
--to show the report
Private Sub ButtonX5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonX5.Click
Dim strname As String = cmbyear.Text.Trim
fillreportstaffbyyear(strname)
crviewer.Show()
End sub

Related

Update Button for Access Database via DataGridView Using OLEDB in VB.NET (Visual Studio 2013)

I have linked an Access database to my program. It populates the DataGridView as it is intended to so that part of the program works. However the new data that i add to my DataGridView wont show up and I don't know what is wrong with my code.
Can anyone see anything wrong or something I've missed out that would cause the code not to function as desired? Thank you in advance :)
Imports System.Data.OleDb
Public Class Form1
Dim j As OleDbConnection
Dim a As OleDbDataAdapter
Dim s As DataSet
Dim lokasidb As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Call jaringan()
a = New OleDbDataAdapter("Select * From datadairy", j)
s = New DataSet
s.Clear()
a.Fill(s, "datadairy")
DataGridDairy.DataSource = (s.Tables("datadairy"))
End Sub
Private Sub eksekusiSql(ByVal Sql As String)
Dim objcmd As New System.Data.OleDb.OleDbCommand
Call jaringan()
Try
objcmd.Connection = j
objcmd.CommandType = CommandType.Text
objcmd.CommandText = Sql
objcmd.ExecuteNonQuery()
objcmd.Dispose()
MsgBox("The new data successfully saved", vbInformation)
Catch ex As Exception
MsgBox("The new data is failed to save", vbInformation)
End Try
End Sub
Sub jaringan()
lokasidb = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=|DataDirectory|\19106060045_Tugas Modul 5.accdb"
j = New OleDbConnection(lokasidb)
If j.State = ConnectionState.Closed Then j.Open()
End Sub
Private Sub ButtonAdd_Click(sender As Object, e As EventArgs) Handles ButtonAdd.Click
Dim No As String = TextNo.Text
Dim Jenis_Susu_Sapi As String = TextSusu.Text
Dim Jenis_Olahan As String = TextOlahan.Text
Dim Harga_per_kg As String = TextHarga.Text
Dim Tempat_Penjualan As String = TextPasar.Text
Dim Sql_Simpan_Dairy As String = "Insert into datadairy (No, Jenis_Susu_Sapi, Jenis_Olahan, Harga_per_kg, Tempat_Penjualan) values (" + No + ",'" + Jenis_Susu_Sapi + "','" + Jenis_Olahan + "','" + Harga_per_kg + "','" + Tempat_Penjualan + "')"
eksekusiSql(Sql_Simpan_Dairy)
ShowDairydata()
End Sub
Public Sub ShowDairydata()
Call jaringan()
a = New OleDbDataAdapter("Select * from datadairy", j)
s = New DataSet
s.Clear()
a.Fill(s, "datadairy")
DataGridDairy.DataSource = (s.Tables("datadairy"))
End Sub
After adding new data to your database, just use
'DataGridDairy.Databind()'
to refresh.

multiple fields in a combobox in vb.net

I have a form which contains a ComboBox linked to an access database. I am asking the combobox to display the Incident ID, Supplier and Supply date of all records in the database table
The code is as follows
Private Sub frm_5_UpdateIncidentSelect_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Links dropdown menu to incident table in database
Dim dt As New DataTable
Dim query As String = "select [incident ID],[stock supplier],[supply date] from incident"
Using connection As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Database.accdb")
Using command As New OleDbCommand(query, connection)
Using adapter As New OleDbDataAdapter(command)
connection.Open()
adapter.Fill(dt)
connection.Close()
End Using
End Using
End Using
Dim MyDataRow As DataRow = dt.Rows(0)
Dim x As Integer
x = dt.Rows.Count
For y = 0 To x
If y < x Then
MyDataRow = dt.Rows(y)
ComboBox1.Items.Add(CStr(MyDataRow("Incident ID")))
ComboBox1.Items.Add(CStr(MyDataRow("stock supplier")))
ComboBox1.Items.Add(CStr(MyDataRow("supply date")))
End If
Next
End Sub
The issue I am having is that the data is being returned over 3 lines as follows
12
Supplier1
01/01/2015
13
Supplier2
07/01/2015
Ideally I need this information returned on one as follows
12 Supplier 1 01/01/2015
13 Supplier 2 07/01/2015
I cannot for the life of me figure this out, I am not great with VB I am afraid. Can anyone tell me where I am going wrong?
Here's an example of what Plutonix was talking about:
Public Class frm_5_UpdateIncidentSelect
Private Class ComboBoxData
Public IncidentID As String
Public StockSupplier As String
Public SupplyDate As String
Public Sub New(ByVal data As DataRow)
Me.IncidentID = data("Incident ID").ToString
Me.StockSupplier = data("stock supplier").ToString
Me.SupplyDate = data("supply date").ToString
End Sub
Public Overrides Function ToString() As String
Return Me.IncidentID.PadRight(5, " ") & " Supplier " & Me.StockSupplier.PadRight(5, " ") & " " & Me.SupplyDate
End Function
End Class
Private Sub frm_5_UpdateIncidentSelect_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Links dropdown menu to incident table in database
Dim dt As New DataTable
Dim query As String = "select [incident ID],[stock supplier],[supply date] from incident"
Using connection As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Database.accdb")
Using command As New OleDbCommand(query, connection)
Using adapter As New OleDbDataAdapter(command)
connection.Open()
adapter.Fill(dt)
connection.Close()
End Using
End Using
End Using
For Each Data As DataRow In dt.Rows
ComboBox1.Items.Add(New ComboBoxData(Data))
Next
End Sub
Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged
If ComboBox1.SelectedIndex <> -1 Then
Dim data As ComboBoxData = DirectCast(ComboBox1.SelectedItem, ComboBoxData)
Debug.Print(data.IncidentID)
Debug.Print(data.StockSupplier)
Debug.Print(data.SupplyDate)
End If
End Sub
End Class
It's been over 5 years, but I hope it can help someone.
The solution is actually way, way easier.
I had the same problem while coding a simple Programm for internal use.
Try this:
For i As Integer = 0 To dataSet.Tables(0).Rows.Count - 1
ComboBox1.Items.Add(dataSet.Tables(0).Rows(i)(0) + " | " +
dataSet.Tables(0).Rows(i)(1) + " | " + dataSet.Tables(0).Rows(i)(2))
Next

My Crystal Report is not showing the hole list

Please help with my crystal report, because it doesn't show the hole list when i use parameter fields for a list. here is my class below
`Imports System.Windows.Forms.Application
Imports System.Data
Imports System.Data.SqlClient
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared
Imports CrystalDecisions.Windows.Forms
Public Class CrystalReportHelperClass
Dim Sql As New SqlHelper
Dim CR_ParamDisVals As New ParameterDiscreteValue
Dim CR_ParamVals As New ParameterValues
Dim CR_ParamDef As ParameterFieldDefinition
Dim CR_ParamDefs As ParameterFieldDefinitions
Dim CRPTDoc As New ReportDocument
Dim CRPTViewer As New CrystalReportViewer
Public Sub New(ByRef CReport As CrystalDecisions.Windows.Forms.CrystalReportViewer)
CRPTViewer = CReport
CRPTDoc = CReport.ReportSource
End Sub
Public Sub CrystalObjectParam(ByVal CrystalReportObject As String, ByVal Message As String)
CR_ParamDisVals.Value = Message
CR_ParamDefs = CRPTDoc.DataDefinition.ParameterFields
CR_ParamDef = CR_ParamDefs.Item(CrystalReportObject)
CR_ParamVals = CR_ParamDef.CurrentValues
CR_ParamVals.Clear()
CR_ParamVals.Add(CR_ParamDisVals)
CR_ParamDef.ApplyCurrentValues(CR_ParamVals)
End Sub
Public Function GetCrystalReport() As ReportDocument
Return CRPTDoc
End Function
End Class
`
then here is the form load
Private Sub ReportEmployeeList_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim RepDoc As New ReportDocument
RepDoc = CRPT_Employee.ReportSource
If Sql.HasConnection() = True Then
Dim DT As DataTable = Sql.ExecuteDataTableSP("SelectWorking")
For Each Data As DataRow In DT.Rows
CRPT.CrystalObjectParam("ID", Data(1))
Next
Else
MsgBox("System Database Cannot be Connected", MsgBoxStyle.Information)
End If
CRPT_Employee.ReportSource = CRPT.GetCrystalReport
CRPT_Employee.Refresh()
End Sub
then i have 1 parameter field in my crystal report, id -> discrete value
what should i do?
i already used other methods like this one
Private Sub SetCurrentValuesForParameterField(ByVal myParameterFields As ParameterFields, ByVal myArrayList As ArrayList)
Dim currentParameterValues As ParameterValues = New ParameterValues()
For Each submittedValue As Object In myArrayList
Dim myParameterDiscreteValue As ParameterDiscreteValue = New ParameterDiscreteValue()
myParameterDiscreteValue.Value = submittedValue.ToString()
currentParameterValues.Add(myParameterDiscreteValue)
Next
Dim myParameterField As ParameterField = myParameterFields(PARAMETER_FIELD_NAME)
myParameterField.CurrentValues = currentParameterValues
End Sub
modify your method as below if i understood what do you want>>>
Dim DT As DataTable = Sql.ExecuteDataTableSP("SelectWorking")
For Each Data As DataRow In DT.Rows
CRPT.SetParameterValue("ID", Data(1))

Code behind for print?

I have a report that I need to print after a sale has completed.
I am having issues with the length and printing when using PrintForm and PrintDocument components however if I right click and select Print from the list the report prints perfectly.
Is there any way that I could write code in my form load event that would imitate the right click print?
Ive been struggling with this part of my project for ages now and the whole thing is now way behind schedule.
My Code for the whole Receipt form page is:
Imports System.Data.OleDb
Imports System.IO
Imports System.Drawing.Printing
Public Class Receipt
Public PicLocation As String
Dim Ctrl1, Ctrl2 As Control
Dim CN As New OleDb.OleDbConnection
Dim CMD As New OleDb.OleDbCommand
Dim DataR As OleDb.OleDbDataReader
'To display into datagrid purpose
Dim dataS As New DataSet
Dim dataAd As New OleDb.OleDbDataAdapter
Public SqlStr, SqlStr1, DBPath, DBStatus, SearchBox As String
Dim X, Y, SqlH, Onh As Integer
Dim SqlUser As String
Dim DataP As Decimal
Dim Balance As Integer
Private Sub Receipt_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'ProductListDataSet' table.
DBPath = (Application.StartupPath & "\ProductList.accdb")
If CN.State = ConnectionState.Open Then
CN.Close()
DBStatus = ("Not Connected")
End If
SqlStr = ("Provider = Microsoft.ACE.OLEDB.12.0;Data Source =" & DBPath)
CN.ConnectionString = SqlStr
CN.Open()
Onh = Nothing
lblTime.Text = DateAndTime.Now
lblUser.Text = Login.userTB.Text
Dim sql As String
sql = "SELECT * Receipt"
Me.ReceiptTableAdapter.ClearBeforeFill = True
Me.ReceiptTableAdapter.Connection = CN
Me.ReceiptTableAdapter.Connection.CreateCommand.CommandText = sql
Me.ReceiptTableAdapter.Fill(Me.ProductListDataSet.Receipt)
Me.ReportViewer1.RefreshReport()
Me.Refresh()
End Sub
Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click
With Me.PrintForm1
.PrintAction = Printing.PrintAction.PrintToPrinter
Dim MyMargins As New Margins
With MyMargins
.Left = 0
.Right = 0
.Top = 0
.Bottom = 0
End With
.PrinterSettings.DefaultPageSettings.Margins = MyMargins
.Print(Me, PowerPacks.Printing.PrintForm.PrintOption.CompatibleModeClientAreaOnly)
End With
End Sub
End Class

Reading from and manipulating a .csv file

I have multiple .csv files for each month which go like:
01/04/2012,00:00,7.521527,80.90972,4.541667,5.774305,7,281.368
02/04/2012,00:00,8.809029,84.59028,6.451389,5.797918,7,274.0764
03/04/2012,00:00,4.882638,77.86806,1.152778,15.13611,33,127.6389
04/04/2012,00:00,5.600694,50.35417,-3.826389,15.27222,33,40.05556
The format is : Date in the form dd/mm/yy,Current time,Current temperature,Current humidity,Current dewpoint,Current wind speed,Current wind gust,Current wind bearing
The program needs to calculate the average for
temperature
humidity
wind speed
wind direction
and display them on a text box.
any ideas?
Here is what I have done so far...
Option Strict On
Option Explicit On
Imports System.IO
Imports System
Public Class Form1
Private Sub cmb1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmb1.SelectedIndexChanged
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnexit.Click
Me.Close()
End Sub
Private Sub btn1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btndata.Click
'This is for August
If cmb1.SelectedIndex = 1 Then
TextBox1.Clear()
Using reader As New StreamReader("c://temp/DailyAug12log.csv")
Dim line As String = reader.ReadLine()
Dim avgTemp As Integer
Dim fields() As String = line.Split(",".ToCharArray())
Dim fileDate = CDate(fields(0))
Dim fileTime = fields(1)
Dim fileTemp = fields(2)
Dim fileHum = fields(3)
Dim fileWindSpeed = fields(4)
Dim fileWindGust = fields(5)
Dim fileWindBearing = fields(6)
While line IsNot Nothing
counter = counter + 1
line = reader.ReadLine()
End While
avgTemp = CInt(fields(2))
avgTemp = CInt(CDbl(avgTemp / counter))
TextBox1.Text = TextBox1.Text & "Month = August" & vbCrLf & "Temperature Average: " & avgTemp & vbCrLf
End Using
End If
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim files() As String
files = Directory.GetFiles("C:\Temp", "*.csv", SearchOption.AllDirectories)
For Each FileName As String In files
cmb1.Items.Add(FileName.Substring(FileName.LastIndexOf("\") + 1, FileName.Length - FileName.LastIndexOf("\") - 1))
Next
End Sub
End Class
Private Class Weather
Public SampleTimeStamp AS Date
Public Temperature AS Double
Public Humidity As Double
Public WindSpeed AS Double
Public WindBearing AS Double
End Class
Sub Main
Dim samples = ReadFile("c://temp/DailyAug12log.csv")
Dim avgTemperature = samples.Average(Function(s) s.Temperature)
...
End Sub
Private Function ReadFile(ByVal fileName as String) AS List(Of Weather)
Dim samples As New List(Of Weather)
Using tfp As new TextFieldParser(filename)
tfp.Delimiters = new String() { "," }
tfp.TextFieldType = FieldType.Delimited
While Not tfp.EndOfData
Dim fields = tfp.ReadFields()
Dim sample As New Weather()
sample.SampleTimeStamp = Date.ParseExact(fields(0) & fields(1), "dd\/MM\/yyyyHH\:mm", CultureInfo.InvariantCulture)
sample.Temperature = Double.Parse(fields(2), CultureInfo.InvariantCulture)
sample.Humidity = Double.Parse(fields(3), CultureInfo.InvariantCulture)
sample.WindSpeed = Double.Parse(fields(4), CultureInfo.InvariantCulture)
sample.WindBearing = Double.Parse(fields(5), CultureInfo.InvariantCulture)
samples.Add(sample)
End While
Return samples
End Using
End Function
I would not use a this aprroach - if the order of the columns changes, your program will show wrong results.
I would use a good csv reader like http://kbcsv.codeplex.com/ and read the Data to a datatable. then you can calculate your resulting columns quite easily and reliablly, because you can adress each column like MyDatatable.Cooumns["Headername"].