Tim
1) You are correct. What ever order you AddItem them, they will stay.
2) See the code for CmdUp and CmdDown below.
3) See the code for CmdDiagram below.
I have a userform with a listbox and three command buttons. CmdUp and
CmdDown reorder the listbox and CmdDiagram creates a flow chart with
connectors on Sheet1. Here's the contents of the code module behind the
userform. I've put comments in the code to help you follow it, but be sure
to post back if you have questions.
Option Explicit
Private Sub cmdDiagram_Click()
Dim i As Long
Dim aShp() As Shape
Dim Conn As Shape
Dim DelShp As Shape
'clear the shapes on the sheet for new entry
For Each DelShp In Sheet1.Shapes
DelShp.Delete
Next DelShp
'create an array to held the shapes for later
'connecting
ReDim aShp(0 To Me.ListBox1.ListCount - 1)
'Loop through the listbox and add shapes to Sheet1
For i = 0 To Me.ListBox1.ListCount - 1
Set aShp(i) = Sheet1.Shapes.AddShape(msoShapeRectangle, 189.75, (i + 1)
* 64.5, 72#, 45#)
'Insert the listbox entry as text into the shape
aShp(i).TextFrame.Characters.Text = Me.ListBox1.List(i)
Next i
'Loop through the shapes and connect them
For i = LBound(aShp) To UBound(aShp)
If i < UBound(aShp) Then
'it doesn't matter where you create the connector because the
'BeginConnect and EndConnect properties are set later
Set Conn = Sheet1.Shapes.AddConnector(msoConnectorStraight, 1, 1, 1,
1)
'The connecter is set to arbitrary connections (1) and the
'RerouteConnections method is used to adjust to the
'shortest path
Conn.ConnectorFormat.BeginConnect aShp(i), 1
Conn.ConnectorFormat.EndConnect aShp(i + 1), 1
Conn.RerouteConnections
End If
Next i
End Sub
Private Sub CmdDown_Click()
Dim LbEnt() As String
Dim CurrEnt As Long
Dim i As Long
Dim Temp As String
'Make sure an item that can be moved is selected
If Me.ListBox1.ListIndex = -1 Then
MsgBox "you must select an item"
ElseIf Me.ListBox1.ListIndex >= Me.ListBox1.ListCount - 1 Then
MsgBox "you can't move the last item down"
Else
'create an array to hold the contents of the listbox
ReDim LbEnt(0 To Me.ListBox1.ListCount - 1)
'Remember what's selected
CurrEnt = Me.ListBox1.ListIndex
'Fill the array
For i = LBound(LbEnt) To UBound(LbEnt)
LbEnt(i) = Me.ListBox1.List(i)
Next i
'reorder the items in the array
Temp = LbEnt(CurrEnt + 1)
LbEnt(CurrEnt + 1) = LbEnt(CurrEnt)
LbEnt(CurrEnt) = Temp
Me.ListBox1.Clear
'Put the array back in the listbox
For i = LBound(LbEnt) To UBound(LbEnt)
Me.ListBox1.AddItem LbEnt(i)
Next i
'Reselect the item
Me.ListBox1.ListIndex = CurrEnt + 1
End If
End Sub
Private Sub CmdUp_Click()
Dim LbEnt() As String
Dim CurrEnt As Long
Dim i As Long
Dim Temp As String
'Basically the same comments as CmdDown
If Me.ListBox1.ListIndex = -1 Then
MsgBox "you must select an item"
ElseIf Me.ListBox1.ListIndex = 0 Then
MsgBox "you can't move the first item up"
Else
ReDim LbEnt(0 To Me.ListBox1.ListCount - 1)
CurrEnt = Me.ListBox1.ListIndex
For i = LBound(LbEnt) To UBound(LbEnt)
LbEnt(i) = Me.ListBox1.List(i)
Next i
Temp = LbEnt(CurrEnt - 1)
LbEnt(CurrEnt - 1) = LbEnt(CurrEnt)
LbEnt(CurrEnt) = Temp
Me.ListBox1.Clear
For i = LBound(LbEnt) To UBound(LbEnt)
Me.ListBox1.AddItem LbEnt(i)
Next i
Me.ListBox1.ListIndex = CurrEnt - 1
End If
End Sub
Private Sub UserForm_Initialize()
Me.ListBox1.AddItem "3 My first entry"
Me.ListBox1.AddItem "1 My second entry"
Me.ListBox1.AddItem "2 My last entry"
End Sub
