Invalid cast from Datetime to Decimal - mysql

I am trying to sum a column of Times for total hours as shown below:
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If DataGridView1.RowCount > 1 Then
Dim IntTotalHours As Decimal = 0
Dim IntPricePerhour As Integer = 0
For Index As Integer = 0 To DataGridView1.RowCount - 1
IntTotalHours += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(2).Value)
Next
TextBox1.Text = IntTotalHours
TextBox3.Text = FormatCurrency(IntTotalHours * 15)
End If
End Sub
But I get an error on the line:
IntTotalHours += Convert.ToDecimal(DataGridView1.Rows(Index).Cells(2).Value)
How do I convert Time to decimal using datagridview?

Related

Finding unique partitions for a number

I am using below code for finding partitions for a given number (N). How can I ensure only unique partitions? For instance partitions (1, 1, 1, 7), (1, 1, 7, 1), (1, 7, 1, 1) and (7, 1, 1, 1) would be considered the same and only one of these should be output.
Thanks
Regards
Dim N = 10
For i As Integer = 0 To N
For j As Integer = 0 To N
For k As Integer = 0 To N
For l As Integer = 0 To N
If i + j + k + l = N Then
Dim St As String = String.Format("({0:d}, {1:d}, {2:d}, {3:d})", i, j, k, l)
Console.WriteLine(St)
End If
Next
Next
Next
Next
Console.Read()
EDIT: Below seems to be working from someone's suggestion;
Module Module1
Sub Main()
Console.WriteLine("Please enter an integer.")
Dim sReadLine As String = Console.ReadLine()
Dim iValue As Integer
If IsNumeric(sReadLine) Then
iValue = CInt(sReadLine)
Else
Console.WriteLine("'" & sReadLine & "' is not a numeric value. Press any key to exit.")
'Application.Exit()
Console.Read()
Exit Sub
End
End If
Console.Clear()
Console.WriteLine("Number is {0}", iValue)
Console.WriteLine("")
Partitions1(iValue)
Exit Sub
End Sub
Dim partitions As New List(Of Part)
Private Sub Partitions1(N As Integer)
For i As Integer = 0 To N
For j As Integer = 0 To N
For k As Integer = 0 To N
For l As Integer = 0 To N
If i + j + k + l = N Then
Dim thisPartition As New Part()
thisPartition.Parts = New Integer() {i, j, k, l}
If Not partitions.Contains(thisPartition) Then
partitions.Add(thisPartition)
End If
End If
Next
Next
Next
Next
For Each x In partitions
Dim St = "("
For Each y In x.Parts
St = St & y & ", "
Next
St = Left(St, Len(St) - 2)
St = St & ")"
Console.WriteLine(St)
Next
Console.WriteLine("")
Console.WriteLine("{0} unique partititons found.", partitions.Count)
Console.Read()
End Sub
Public Class Part 'Sorted array of integer with comparer
Implements IEquatable(Of Part)
Public Property Parts As Integer()
Get
Return m_Parts
End Get
Set(value As Integer())
m_Parts = value
Array.Sort(m_Parts)
End Set
End Property
Private m_Parts As Integer()
Public Overloads Function Equals(other As Part) As Boolean _
Implements IEquatable(Of Part).Equals
If other Is Nothing Then
Return False
End If
If other.Parts.GetLength(0) <> m_Parts.GetLength(0) Then Return False
Dim result As Boolean = True
Array.Sort(other.Parts)
For I As Integer = 0 To other.Parts.GetLength(0) - 1
If other.Parts(I) <> m_Parts(I) Then
result = False
Exit For
End If
Next
Return result
End Function
' Should also override == and != operators.
End Class
End Module
Collect the found solutions in a list, then writen an algo which eliminates the duplicates from the list and then print the list.

Loop in VBA Skipping Values

I have the following code in Access VBA.
Public Sub CalculateVol()
Dim vol As Double
Dim rs As Recordset
Dim rs2 As Recordset
Dim iRow As Long, iField As Long
Dim strSQL As String
Dim CurveID As Long
Dim MarkRunID As Long
Dim MaxOfMarkAsofDate As Date
Dim userdate As String
DoCmd.RunSQL "DELETE * FROM HolderTable"
'Clears out the old array from the holder table.
Dim I As Integer
Dim x As Date
userdate = InputBox("Please Enter the Date (mm/dd/yyyy)")
x = userdate
Dim BucketTermAmt As Long
BucketTermAmt = InputBox("Please Enter the Term Amount")
For I = 0 To 76
MaxOfMarkAsofDate = x - I
strSQL = "SELECT * FROM VolatilityOutput WHERE CurveID=" & Forms!Volatility.cboCurve.Value & " AND MaxOfMarkAsofDate=#" & MaxOfMarkAsofDate & "# ORDER BY MaxOfMarkasOfDate, MaturityDate"
Set rs = CurrentDb.OpenRecordset(strSQL, Type:=dbOpenDynaset, Options:=dbSeeChanges)
Set rs2 = CurrentDb.OpenRecordset("HolderTable")
If rs.RecordCount <> 0 Then
rs.MoveFirst
rs.MoveLast
Dim BucketTermUnit As String
Dim BucketDate As Date
Dim MarkAsOfDate As Date
Dim InterpRate As Double
Dim b As String
b = BucketTermAmt
BucketTermUnit = Forms!Volatility.cboDate.Value
BucketDate = DateAdd(BucketTermUnit, b, MaxOfMarkAsofDate)
InterpRate = CurveInterpolateRecordset(rs, BucketDate)
rs2.AddNew
rs2("BucketDate") = BucketDate
rs2("InterpRate") = InterpRate
rs2.Update
End If
Next I
vol = EWMA(0.94)
Forms!Volatility!txtVol = vol
Debug.Print vol
End Sub
The basic idea is that the user inputs a date for MaxofMarkAsofDate. The code then finds that instance of MarkAsofDate in the table VolatilityOutput, and uses it as a reference point to calculate InterpRate. It stores this number in the HolderTable. Then it loops the same procedure, except using one day previous to the user-inputted MarkAsofDate, and then one day previous to that, and so on for a total of 76 times.
The first part works fine but the loop is giving me trouble. If it doesn't find the user-inputted date in the table, it'll just skip it, but still count it as a loop. So while I want 76 data points, I might only end up with 56, for example, if it skips 20 dates. So I want to either stop it from skipping, or just keep looping until HolderTable has a total of 76 numbers in it. How do I do this?
Sounds like you want a while loop since the for loop as written will always go the same number of times. Looks like you might need a second counter to increment your date.
while count < 76
'get rs here
if rs.RecordCount <> 0 Then
'do everything else
count = count + 1
end if
dateCounter = dateCounter + 1
loop

access vba array - subscript out of range error #9

say I have a table with column A, B & C and I have the following codes to find the column names and I want to join these names as array like "A B C". However, it returns with subscript out of range run time error9. What I should do to get rid of this error? Thanks in advance!
Option Compare Database
Private Sub check_tbl2_Click()
Dim ind() As String
Dim joinInd As String
Dim l As Integer
For l = 0 To CurrentDb.TableDefs("tbl2").Fields.Count - 1
MsgBox (CurrentDb.TableDefs("tbl2").Fields(l).Name)
ind(l) = CurrentDb.TableDefs("tbl2").Fields(l).Name
Next l
joinInd = Join(ind)
MsgBox (joinInd)
End Sub
You never set the dimensions for ind(). Here's one way to do it. Look at the redim statement.
Sub check_tbl2_Click()
Dim ind() As String
Dim joinInd As String
Dim l As Integer
ReDim ind(CurrentDb.TableDefs("tbl2").Fields.Count - 1)
For l = 0 To CurrentDb.TableDefs("tbl2").Fields.Count - 1
MsgBox (CurrentDb.TableDefs("tbl2").Fields(l).Name)
ind(l) = CurrentDb.TableDefs("tbl2").Fields(l).Name
Next l
joinInd = Join(ind)
MsgBox (joinInd)
End Sub
This should work for you:
EDIT: Actually, Tom Collins' answer is much better if you decide to keep with the array method, so don't use this. I wasn't thinking most efficiently.
Private Sub check_tbl2_Click()
Dim ind() As String
Dim joinInd As String
Dim l As Integer
ReDim ind(1)
For l = 0 To CurrentDb.TableDefs("tbl2").Fields.Count - 1
'MsgBox (CurrentDb.TableDefs("tbl2").Fields(l).Name)
ReDim Preserve ind(UBound(ind) + 1)
ind(l) = CurrentDb.TableDefs("tbl2").Fields(l).Name
Next l
joinInd = Join(ind)
MsgBox (joinInd)
End Sub
but why not just:
Private Sub check_tbl2_Click()
Dim joinInd As String
Dim db As DAO.Database
Dim fld As DAO.Field
Set db = CurrentDb()
For Each fld In db.TableDefs("tbl2").Fields
joinInd = joinInd & fld.Name
Next
MsgBox (joinInd)
Set db = Nothing
End Sub

How to print Datagridview has a table in VB

I have a Datagrid with information retrieved from a database and i would like the print output to be in table format with lines and columns. My actual methode is simple but the output is very confusing. Any thoughts?
Private Sub Imprimir_Click(sender As Object, e As EventArgs) Handles Imprimir.Click
PrintPreviewDialog1.PrintPreviewControl.Zoom = 1.0
PrintPreviewDialog1.FindForm.WindowState = FormWindowState.Maximized
PrintPreviewDialog1.ShowDialog()
End Sub
Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As
System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim y As Integer = 70
PrintDocument1.DefaultPageSettings.Landscape = True
e.Graphics.DrawString("TransporGest - Registo de Operações",
New Font("Verdana", 10, FontStyle.Bold), Brushes.Black, 30, 30)
For Each dr As DataGridViewRow In dg.Rows
e.Graphics.DrawString(dr.Cells(0).Value & " | " & dr.Cells(2).Value &
" | " & dr.Cells(3).Value & " | " & dr.Cells(4).Value & " | " &
dr.Cells(6).Value & " | " & dr.Cells(7).Value & " | " &
dr.Cells(9).Value & " | " & dr.Cells(11).Value & " | " &
dr.Cells(12).Value, New Font("Verdana", 10), Brushes.Black, 30, y)
y += 20
Next
End Sub
End Class
Add to Form(Design) Button1, PrintDocument1 ,PrintPreviewDialog1 , your -> DataGridView1
and paste the code:
Dim mRow As Integer = 0
Dim newpage As Boolean = True
Private Sub PrintDocument1_PrintPage(sender As System.Object, e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
With DataGridView1
Dim fmt As StringFormat = New StringFormat(StringFormatFlags.LineLimit)
fmt.LineAlignment = StringAlignment.Center
fmt.Trimming = StringTrimming.EllipsisCharacter
Dim y As Single = e.MarginBounds.Top
Do While mRow < .RowCount
Dim row As DataGridViewRow = .Rows(mRow)
Dim x As Single = e.MarginBounds.Left
Dim h As Single = 0
For Each cell As DataGridViewCell In row.Cells
Dim rc As RectangleF = New RectangleF(x, y, cell.Size.Width, cell.Size.Height)
e.Graphics.DrawRectangle(Pens.Black, rc.Left, rc.Top, rc.Width, rc.Height)
If (newpage) Then
e.Graphics.DrawString(DataGridView1.Columns(cell.ColumnIndex).HeaderText, .Font, Brushes.Black, rc, fmt)
Else
e.Graphics.DrawString(DataGridView1.Rows(cell.RowIndex).Cells(cell.ColumnIndex).FormattedValue.ToString(), .Font, Brushes.Black, rc, fmt)
End If
x += rc.Width
h = Math.Max(h, rc.Height)
Next
newpage = False
y += h
mRow += 1
If y + h > e.MarginBounds.Bottom Then
e.HasMorePages = True
mRow -= 1
newpage = True
Exit Sub
End If
Loop
mRow = 0
End With
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
PrintPreviewDialog1.Document = PrintDocument1
PrintPreviewDialog1.ShowDialog()
End Sub
For pecific Columns (example column 1,3,4)
Private Sub PrintDocument1_PrintPage(sender As System.Object, e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim custCells As Integer() = {1, 3, 4}
With DataGridView1
Dim fmt As StringFormat = New StringFormat(StringFormatFlags.LineLimit)
fmt.LineAlignment = StringAlignment.Center
fmt.Trimming = StringTrimming.EllipsisCharacter
Dim y As Single = e.MarginBounds.Top
Do While mRow < .RowCount
Dim row As DataGridViewRow = .Rows(mRow)
Dim x As Single = e.MarginBounds.Left
Dim h As Single = 0
For Each cell As Integer In custCells
Dim rc As RectangleF = New RectangleF(x, y, row.Cells(cell).Size.Width, row.Cells(cell).Size.Height)
e.Graphics.DrawRectangle(Pens.Black, rc.Left, rc.Top, rc.Width, rc.Height)
If (newpage) Then
e.Graphics.DrawString(DataGridView1.Columns(cell).HeaderText, .Font, Brushes.Black, rc, fmt)
Else
e.Graphics.DrawString(DataGridView1.Rows(row.Cells(cell).RowIndex).Cells(cell).FormattedValue.ToString(), .Font, Brushes.Black, rc, fmt)
End If
x += rc.Width
h = Math.Max(h, rc.Height)
Next
newpage = False
y += h
mRow += 1
If y + h > e.MarginBounds.Bottom Then
e.HasMorePages = True
mRow -= 1
newpage = True
Exit Sub
End If
Loop
mRow = 0
End With
End Sub
You may find that moving the data to Excel/Word would be as useful:
Private Sub tsbtnCopy_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tsbtnCopy.Click
dgv01.SuspendLayout()
dgv01.RowHeadersVisible = False
If dgv01.SelectedRows.Count = 0 Then dgv01.SelectAll()
Clipboard.SetDataObject(dgv01.GetClipboardContent())
dgv01.ClearSelection()
dgv01.RowHeadersVisible = True
dgv01.ResumeLayout()
End Sub
Or have the user select all (click upper left cell) to copy/Paste.
I found a solution to fix the disappearing header problem. The thing is that the PrintDocument is called 2 times, once for preview, the second time just before printing. Exactly before printing it is necessary to reset the variables mRow = 0 and newpage = True again.
I used hijacking the print button, which I replaced with my. I added this code to the PRINT button on my form.
b.Image = CType(PrintDialog.Controls(1), ToolStrip).ImageList.Images(0)
b.ToolTipText = "Print"
b.DisplayStyle = ToolStripItemDisplayStyle.Image
AddHandler b.Click, AddressOf PrintPreview_PrintClick
CType(PrintDialog.Controls(1), ToolStrip).Items.RemoveAt(0)
CType(PrintDialog.Controls(1), ToolStrip).Items.Insert(0, b)
As a result, the following code is placed in the newly added button
Private Sub PrintPreview_PrintClick(sender As Object, e As EventArgs)
Try
mRow = 0
newpage = True
PrintDocument.Print()
Catch ex As Exception
End Try
End Sub

Pass by reference in VBA does not work

i wanna test pass by reference and pass by value in access, but it doesn't work.
Sub passByRef(ByRef a As Integer)
a = a + 1
End Sub
Sub passByVal(ByVal a As Integer)
a = a + 1
End Sub
Private Sub cmdByRef()
Dim i as Integer
i = 10
passByRef i
MsgBox i
End Sub
Private Sub cmdByVal()
Dim i as Integer
i = 10
passByVal i
MsgBox i
End Sub
in the pass by ref it does not state that it is the pass by reference function. Any idea?
maybe you should do this.
Private Sub cmdByRef()
Dim i as Integer
i = 10
passByRef i
MsgBox "Result of passByRef " + i
End Sub
Private Sub cmdByVal()
Dim i as Integer
i = 10
passByVal i
MsgBox "Result of passByVal " + i
End Sub