Balloon et label variable

Bonjour =E0 tous,

petit soucis de code avec l'assistant Office, je veux=20
cr=E9er une bulle dont le nombre de label est variable.=20
Voil=E0 o=F9 j'en suis mais =E7a bloque "=E9l=E9ment ne fait pas=20
parti de la collection"

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSql As String, strChoice As String
Dim intRetVal As Integer, i As Integer
Public BalBalloon As Office.Balloon

strSql =3D "select * from T_contact inner join T_societe on=20
T_contact.ref_soci=E9t=E9 =3D T_societe.num_soc" & vbCrLf
strSql =3D strSql & "where T_contact.ref_soci=E9t=E9 =3D " &=20
Me.Num_soc
Set rs =3D db.OpenRecordset(strSql)

rs.MoveLast
If rs.RecordCount > 1 Then
Set BalBalloon =3D Application.Assistant.NewBalloon
With BalBalloon
.Button =3D msoButtonSetNone
.Heading =3D "Choisissez le contact"
.Text =3D "Quel est votre contact qui peut engager=20
la soci=E9t=E9 ?"
If rs.RecordCount < 5 Then
rs.MoveFirst
For i =3D 1 To rs.RecordCount
' c'est ici que =E7a bloque
.Labels(i).Text =3D rs.Fields("Contact")
On Error Resume Next
rs.MoveNext
Next i
On Error GoTo 0
End If
End With
End If
intRetVal =3D BalBalloon.Show

If intRetVal > 0 Then
strChoice =3D BalBalloon.Labels(intRetVal).Text
Call RemplirSignet("Sigcontact", strChoice, , True)
End If
------------------

Si quelqu'un voit une solution ...

Merci.
Damien.