How to fit all columns of data grid view in print preview in vb - mysql

I have been trying to expand the print preview paper size to landscape to show the printed data grid view. I have more than 7 columns and the last 2 columns did not fit in the whole paper. The code for printing data grid view values is working well. But not the way I want it to appear on the print preview. This is how it looks like: screenshot: https://snipboard.io/AeVfPN.jpg
This is how I want it to look to fit the entire paper: https://i.stack.imgur.com/yPOEm.png
This is my 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
Dim mRow As Integer = 0
Dim newpage As Boolean = True
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 btnPrint_Click(sender As Object, e As EventArgs) Handles btnPrint.Click
PrintPreviewDialog1.Document = PrintDocument1
PrintPreviewDialog1.ShowDialog()
End Sub
Private Sub PrintDocument1_BeginPrint(sender As Object,
e As PrintEventArgs) Handles PrintDocument1.BeginPrint
mRow = 0
newpage = True
PrintPreviewDialog1.PrintPreviewControl.StartPage = 0
PrintPreviewDialog1.PrintPreviewControl.Zoom = 1.0
End Sub

Related

Print data grid view skips the first row

I have created a print preview for the data grid view that I want to print. The code works fine but there is slight problem
Problem Screenshot:
In the data grid view row, the ID 1 is missing, it always starts from 2. How can I solve this problem? Please help.
My code:
Private Sub PrintDocument1_PrintPage(sender As System.Object, e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim mRow As Integer = 0
Dim newpage As Boolean = True
PrintDocument1.DefaultPageSettings.Landscape = True
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
rows(0) is the first data row, not header row, while cell.RowIndex is 1, so change rows(cell.RowIndex) as rows(cell.RowIndex-1) :
e.Graphics.DrawString(DataGridView1.Rows(cell.RowIndex - 1).Cells(cell.ColumnIndex).FormattedValue.ToString(), .Font, Brushes.Black, rc, fmt)
The If (newpage) causes it to draw the headers instead of the first row.
You could change the section
newpage = False
y += h
mRow += 1
to
If not newpage Then
mRow += 1
End If
newpage = False
y += h
Print each part separately to avoid this kind of problems. The headers part belongs to the Columns collection then print it first before you handle the Rows and Cells parts.
You have another problem in your code to fix. The mRow is a local variable that does not preserve the last printed row to skip or the new row to continue with when you request a new page. It must be a class field.
Private mRow As Integer
Private Sub PrintPreviewButton(sender As Object, e As EventArgs) _
Handles Button1.Click
PrintDocument1.DefaultPageSettings.Landscape = True
mRow = 0
Using d = New PrintPreviewDialog With {
.Document = PrintDocument1
}
d.ShowDialog(Me)
End Using
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As PrintPageEventArgs) _
Handles PrintDocument1.PrintPage
Dim g = e.Graphics
Dim x As Integer = e.MarginBounds.X
Dim y As Integer = e.MarginBounds.Y
With DataGridView1
Using sf = New StringFormat(StringFormat.GenericTypographic) With {
.LineAlignment = StringAlignment.Center,
.Trimming = StringTrimming.EllipsisCharacter
}
For Each col As DataGridViewColumn In .Columns
Dim rect = New Rectangle(
x, y,
col.Width, col.DataGridView.ColumnHeadersHeight)
g.DrawRectangle(Pens.Black, rect)
rect.Inflate(-3, 0)
g.DrawString(col.HeaderText, .Font, Brushes.Black, rect, sf)
x += col.Width
Next
y += .ColumnHeadersHeight
For i = mRow To .RowCount - 1
Dim row = .Rows(i)
If row.IsNewRow Then Exit Sub
x = e.MarginBounds.X
For Each cell As DataGridViewCell In row.Cells
Dim rect = New Rectangle(New Point(x, y), cell.Size)
g.DrawRectangle(Pens.Black, rect)
rect.Inflate(-3, 0)
g.DrawString(cell.FormattedValue?.ToString(),
.Font, Brushes.Black, rect, sf)
x += cell.Size.Width
Next cell
y += row.Height
If y + row.Height > e.MarginBounds.Bottom Then
mRow = i + 1
e.HasMorePages = True
Exit For
End If
Next i
End Using
End With
End Sub

how the system recognize if the question is already answered

I want to know how the system recognize if the question is already answered or not if the user want to go back in previous question. if its already answered the answer will update either the score is increase or not or if the answer is not edited it will be the same.
BUTTON1 is to go back to previous quesion
Button2 is for checking if true or false the answwer
BUTTON 3 is for Keep going the exam
Here are my code snippets:
Imports MySql.Data.MySqlClient
Imports System.Drawing
Imports System.IO
Public Class Exam
'declaring variables for connection'
Dim score As Integer
Dim rightans As String
Dim correct As Integer = 0
Dim choice As String
Dim choice1 As String
Dim choice2 As String
Dim choice3 As String
Dim con As MySqlConnection
Dim con1 As MySqlConnection
Dim COMMAND As MySqlCommand
Dim read As MySqlDataReader
Dim da As MySqlDataAdapter
Dim sql As String
Private Sub Exam_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'setting the radiobutton to false, so that when the form load there is no shaded button'
Label2.Text = 1
A.Checked = False
B.Checked = False
C.Checked = False
D.Checked = False
con = New MySqlConnection
Button1.Enabled = False
con.ConnectionString = "server=localhost;userid=root;password=;database=user;"
'calling sub
qno()
End Sub
Sub clear()
'to set the radiobutton false/no shaded.
A.Checked = False
B.Checked = False
C.Checked = False
D.Checked = False
End Sub
Sub qno()
'calling connection'
Try
con = New MySqlConnection
con.ConnectionString = "server=localhost; user id=root; password=; database=user;"
con.Open()
sql = "SELECT * FROM user.math WHERE question_id = #ID;"
COMMAND = New MySqlCommand
With COMMAND
.Connection = con
.CommandText = sql
.Parameters.Clear()
.Parameters.AddWithValue("#ID", Label2.Text)
.ExecuteNonQuery()
End With
Dim arrImage() As Byte
Dim dt As New DataTable
da = New MySqlDataAdapter
da.SelectCommand = COMMAND
da.Fill(dt)
If dt.Rows.Count > 0 Then
arrImage = dt.Rows(0).Item(7)
Dim mstream As New System.IO.MemoryStream(arrImage)
Pic1.Image = Image.FromStream(mstream)
question.Text = dt.Rows(0).Item(1)
A.Text = dt.Rows(0).Item(2)
B.Text = dt.Rows(0).Item(3)
C.Text = dt.Rows(0).Item(4)
D.Text = dt.Rows(0).Item(5)
Else
MsgBox("No results!")
End If
Catch ex As MySqlException
MsgBox(ex.Message)
Finally
con.Close()
da.Dispose()
End Try
End Sub
Sub increment()
'incrementing the score f the answer is correct'
Dim i As Integer = 0
i = Label2.Text
i = i + 1
Label2.Text = i
If Label2.Text > 1 Then
Button1.Enabled = True
End If
End Sub
Sub decrement()
'incrementing the score f the answer is correct'
Dim i As Integer = 1
i = Label2.Text
i = i - 1
Label2.Text = i
If Label2.Text = 1 Then
Button1.Enabled = False
End If
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'checking of the user answer the questions'
If ((A.Checked = False) And (B.Checked = False) And (C.Checked = False) And (D.Checked = False)) Then
MsgBox("Please answer the question")
Else
'if the examinee answers all the examination it will call another questions from database'
If A.Checked = True Then
con.Open()
' Dim ans As String
Dim arren As String = "A"
Dim sql As String = ("select answer from user.math where question_id = '" & Label2.Text & "' ")
COMMAND = New MySqlCommand(sql, con)
Dim it As String
read = COMMAND.ExecuteReader
If read.HasRows Then
If read.Read Then
it = read.Item("answer")
If it = choice Then
correct = correct + 1
Label4.Text = correct
ElseIf it <> choice And Label2.Text <= 1 Then
correct = correct - 1
Label4.Text = correct
End If
End If
clear()
End If
If Label2.Text = 10 Then
MessageBox.Show("proceed to other subject test")
End If
con.Close()
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
decrement()
qno()
End Sub
End Class
Untested since I don't have your database. Comments above and inline.
Public Class Form3
Dim correct As Integer = 0
Private Sub Exam_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'setting the radiobutton to false, so that when the form load there is no shaded button'
Label2.Text = "1"
A.Checked = False
B.Checked = False
C.Checked = False
D.Checked = False
Button1.Enabled = False
qno()
End Sub
Private Sub clear()
'to set the radiobutton false/no shaded.
A.Checked = False
B.Checked = False
C.Checked = False
D.Checked = False
End Sub
Private Sub qno()
Try
'Using...End Using blocks will close and dispose of your objects
Using con = New MySqlConnection("server=localhost;userid=root;password=;database=user;")
Using Cmd = New MySqlCommand("SELECT * FROM user.math WHERE question_id = #ID;", con)
Cmd.Parameters.AddWithValue("#ID", Label2.Text)
Dim arrImage() As Byte
Dim dt As New DataTable
Using da = New MySqlDataAdapter
da.SelectCommand = Cmd
da.Fill(dt)
If dt.Rows.Count > 0 Then
'Not at all sure about this picture code
arrImage = CType(dt.Rows(0).Item(7), Byte())
Dim mstream As New System.IO.MemoryStream(arrImage)
Pic1.Image = Image.FromStream(mstream)
question.Text = dt.Rows(0).Item(1).ToString
A.Text = dt.Rows(0).Item(2).ToString
B.Text = dt.Rows(0).Item(3).ToString
C.Text = dt.Rows(0).Item(4).ToString
D.Text = dt.Rows(0).Item(5).ToString
'guessing that answer it item 6
HiddenLabel.Text = dt.Rows(0).Item(6).ToString
Else
MsgBox("No results!")
End If
End Using
End Using
End Using
Catch ex As MySqlException
MsgBox(ex.Message)
End Try
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'checking of the user answer the questions'
If ((A.Checked = False) And (B.Checked = False) And (C.Checked = False) And (D.Checked = False)) Then
MsgBox("Please answer the question")
Exit Sub
End If
'The correct answer was put in the HiddenLabel.Text (Visible set to False)
'in the qno Sub
Dim CorrectAnswer As String = HiddenLabel.Text
Dim UserChoice As String = ""
If A.Checked Then
UserChoice = "A"
ElseIf B.Checked Then
UserChoice = "B"
ElseIf C.Checked Then
UserChoice = "C"
Else
UserChoice = "D"
End If
If UserChoice = CorrectAnswer Then
correct += 1
Else
'It is very hard to get a good score if it is decremented with every wrong answer
'Why not skip this and just give a zero for a wrong answer
correct -= 1
End If
Label4.Text = correct.ToString
clear()
If Label2.Text = "10" Then
MessageBox.Show("proceed to other subject test")
Me.Hide()
exam2.Show()
Else
'Add code to keep track of question number in
'Add code to show the next question
End If
End Sub

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.

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

Does access VBA has Listbox.List method as excel VBA has

I'm writing code in access vba for the list box items to move up and down. Needs to use .List Property in access . But it throws an error says no method or member found. Any replace method with .List ? Researching on this more than 4 days.
Private Sub cmdUP_Click()
Dim i As Long
Dim leaveAlone As Boolean
Dim pos As Long
Dim Temp As String
pos = 0
With Me.lbfNames
For i = 0 To .ListCount - 1
leaveAlone = False
If .Selected(i) Then
If i = pos Then
leaveAlone = True
End If
pos = pos + 1
If leaveAlone = False Then
Temp = .RowSource(i - 1)
.RowSource(i - 1) = .RowSource(i) ' before i used .List instead of rowsource
.RowSource(i) = Temp
.ListIndex = i - 1
.Selected(i) = False
.Selected(i - 1) = True
End If
End If
Next
End With
I've figured that out, how to do it in access. But set list box Multiselect property to 'None'.
Moving Down
Private Sub cmdDown_Click()
Dim sText As String
Dim iIndex As Integer
Dim bottomLimit As Integer
iIndex = lbfNames.ListIndex
bottomLimit = lbfNames.ListCount - 1
'check: only proceed if there is a selected item
If lbfNames.ListCount > 1 Then
If iIndex >= bottomLimit Then
MsgBox ("Can not move the item down any further.")
Exit Sub
End If
'save items text and items indexvalue
sText = lbfNames.Column(0, iIndex)
If iIndex < bottomLimit Then
lbfNames.RemoveItem iIndex
'place item back in new position
lbfNames.AddItem sText, iIndex + 1
End If
'if you keep that item selected
'you can keep moving it by pressing btnMoveDown
lbfNames.Selected(iIndex + 1) = True
iIndex = iIndex + 1
End If
End Sub
Moving up
Private Sub cmdUP_Click()
Dim sText As String
Dim iIndex As Integer
iIndex = lbfNames.ListIndex
' ReDim iIndex(0 To 10)
'check: only proceed if there is a selected item
If lbfNames.ListCount > 1 Then
'index 0 is top item which can't be moved up!
If iIndex <= 0 Then
MsgBox ("Can not move the item up any higher.")
Exit Sub
End If
' If iIndex = -1 Or lbfNames.ListCount > 1 Then
'save items text and items indexvalue
sText = lbfNames.Column(0, iIndex)
lbfNames.RemoveItem iIndex
'place item back on new position
lbfNames.AddItem sText, iIndex - 1
'if you keep that item selected
'you can keep moving it by pressing cmdUp
lbfNames.Selected(iIndex - 1) = True
iIndex = iIndex - 1
End If
End Sub
Short Answer: No, MS Access VBA doesn't have ListBox.List(row, column) but instead it has ListBox.AddItem(Item, Index) and ListBox.RemoveItem(Index)
For Multi-Column ListBoxes semi-colon character ';' could be used to separate column items i.e. myMultiColListBox.AddItem("Col_1_item;Col_2_item;Col_3_item")