Récupérer message d'erreur

Le
Peponne31
Bonsoir à tous,

Dans ce code , je voudrai récupérer le message d'erreur
si on valide sans faire de sélection dans le ListBox, je ni parviens pas.

Private Sub UserForm_Initialize()
Dim Rg As Range
Dim Critere As Long
Me.Caption = ThisWorkbook.Name
With Worksheets("JournalDevis")
Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
End With
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & _
ThisWorkbook.FullName & ";" & "Extended Properties=""Excel
8.0;HDR=Yes;"""
requete = "SELECT N°devis, Nom FROM [" & Rg.Parent.Name & "$" &
Rg.Address(0, 0) _
& "]"
Rst.Open requete, Conn, adOpenStatic, adLockOptimistic
a = Rst.RecordCount
x = Rst.GetRows
With Me.ListBox1
'If .List >= 1 Then '<--ici pour l'erreur
.ColumnCount = 2
.ColumnWidths = "50;85"
.List = Application.Transpose(x)
'Else
' MsgBox "Aucune sélection de faite dans la liste !"
' End If
End With
End Sub

Merci à vous pour votre aide
Peponne31
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #20273221
Bonjour,

Cela devrait aller comme ça :

Je suppose qu'il y a une variable Rst de déclarer
comme étant le "RecordSet , sinon il faudra l'ajouter
Dim Rst As New ADODB.Recordset à la déclaration
des variables.

'---------------------------------------
Private Sub UserForm_Initialize()

Dim GestionErreur As String
Dim Rg As Range
Dim Critere As Long

On Error GoTo GestionErreur

Me.Caption = ThisWorkbook.Name
With Worksheets("JournalDevis")
Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
End With

Set Conn = New ADODB.Connection

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"""

requete = "SELECT [N°devis], Nom FROM [" & _
Rg.Parent.Name & "$" & Rg.Address(0, 0) & "]"

Rst.Open requete, Conn, adOpenStatic, adLockOptimistic

x = Rst.GetRows
With Me.ListBox1
.Clear
.ColumnCount = 2
.ColumnWidths = "50;85"
.List = Application.Transpose(x)
End With
Exit Sub

GestionErreur:
MsgBox "La procédure a rencontré un pépin " & _
"de ce type: " & vbCrLf & _
Err.Number & ", " & Err.Description

End Sub
'---------------------------------------



"Peponne31" discussion :
Bonsoir à tous,

Dans ce code , je voudrai récupérer le message d'erreur
si on valide sans faire de sélection dans le ListBox, je ni parviens pas.

Private Sub UserForm_Initialize()
Dim Rg As Range
Dim Critere As Long
Me.Caption = ThisWorkbook.Name
With Worksheets("JournalDevis")
Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
End With
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & _
ThisWorkbook.FullName & ";" & "Extended Properties=""Excel
8.0;HDR=Yes;"""
requete = "SELECT N°devis, Nom FROM [" & Rg.Parent.Name & "$" &
Rg.Address(0, 0) _
& "]"
Rst.Open requete, Conn, adOpenStatic, adLockOptimistic
a = Rst.RecordCount
x = Rst.GetRows
With Me.ListBox1
'If .List >= 1 Then '<--ici pour l'erreur
.ColumnCount = 2
.ColumnWidths = "50;85"
.List = Application.Transpose(x)
'Else
' MsgBox "Aucune sélection de faite dans la liste !"
' End If
End With
End Sub

Merci à vous pour votre aide
Peponne31
Peponne31
Le #20273341
Bonsoir Michdenis,

C'est pareil, à partir du moment ou il ni a aucune sélection de faite
il me dit:

Erreur d'exécution 381
Impossible de lire la propriété List. Index de table de propriété non valide

Merci encore
Peponne31

"michdenis" a écrit :

Bonjour,

Cela devrait aller comme ça :

Je suppose qu'il y a une variable Rst de déclarer
comme étant le "RecordSet , sinon il faudra l'ajouter
Dim Rst As New ADODB.Recordset à la déclaration
des variables.

'---------------------------------------
Private Sub UserForm_Initialize()

Dim GestionErreur As String
Dim Rg As Range
Dim Critere As Long

On Error GoTo GestionErreur

Me.Caption = ThisWorkbook.Name
With Worksheets("JournalDevis")
Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
End With

Set Conn = New ADODB.Connection

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"""

requete = "SELECT [N°devis], Nom FROM [" & _
Rg.Parent.Name & "$" & Rg.Address(0, 0) & "]"

Rst.Open requete, Conn, adOpenStatic, adLockOptimistic

x = Rst.GetRows
With Me.ListBox1
.Clear
.ColumnCount = 2
.ColumnWidths = "50;85"
.List = Application.Transpose(x)
End With
Exit Sub

GestionErreur:
MsgBox "La procédure a rencontré un pépin " & _
"de ce type: " & vbCrLf & _
Err.Number & ", " & Err.Description

End Sub
'---------------------------------------



"Peponne31" discussion :
Bonsoir à tous,

Dans ce code , je voudrai récupérer le message d'erreur
si on valide sans faire de sélection dans le ListBox, je ni parviens pas.

Private Sub UserForm_Initialize()
Dim Rg As Range
Dim Critere As Long
Me.Caption = ThisWorkbook.Name
With Worksheets("JournalDevis")
Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
End With
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & _
ThisWorkbook.FullName & ";" & "Extended Properties=""Excel
8.0;HDR=Yes;"""
requete = "SELECT N°devis, Nom FROM [" & Rg.Parent.Name & "$" &
Rg.Address(0, 0) _
& "]"
Rst.Open requete, Conn, adOpenStatic, adLockOptimistic
a = Rst.RecordCount
x = Rst.GetRows
With Me.ListBox1
'If .List >= 1 Then '<--ici pour l'erreur
.ColumnCount = 2
.ColumnWidths = "50;85"
.List = Application.Transpose(x)
'Else
' MsgBox "Aucune sélection de faite dans la liste !"
' End If
End With
End Sub

Merci à vous pour votre aide
Peponne31



michdenis
Le #20273451
à titre d'exemple ceci : http://cjoint.com/?kcaxXPD2wD

si tu veux tester si ton listbox n'a aucune sélection,

Sub test1()
If Me.ListBox1.ListIndex = -1 Then
MsgBox "No sélection"
Else
'Affiche la sélection (2 colonnes)
MsgBox Me.ListBox1.List(Me.ListBox1.ListIndex, 0) & _
vbTab & Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End If
End Sub



"Peponne31" discussion :
Bonsoir Michdenis,

C'est pareil, à partir du moment ou il ni a aucune sélection de faite
il me dit:

Erreur d'exécution 381
Impossible de lire la propriété List. Index de table de propriété non valide

Merci encore
Peponne31

"michdenis" a écrit :

Bonjour,

Cela devrait aller comme ça :

Je suppose qu'il y a une variable Rst de déclarer
comme étant le "RecordSet , sinon il faudra l'ajouter
Dim Rst As New ADODB.Recordset à la déclaration
des variables.

'---------------------------------------
Private Sub UserForm_Initialize()

Dim GestionErreur As String
Dim Rg As Range
Dim Critere As Long

On Error GoTo GestionErreur

Me.Caption = ThisWorkbook.Name
With Worksheets("JournalDevis")
Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
End With

Set Conn = New ADODB.Connection

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"""

requete = "SELECT [N°devis], Nom FROM [" & _
Rg.Parent.Name & "$" & Rg.Address(0, 0) & "]"

Rst.Open requete, Conn, adOpenStatic, adLockOptimistic

x = Rst.GetRows
With Me.ListBox1
.Clear
.ColumnCount = 2
.ColumnWidths = "50;85"
.List = Application.Transpose(x)
End With
Exit Sub

GestionErreur:
MsgBox "La procédure a rencontré un pépin " & _
"de ce type: " & vbCrLf & _
Err.Number & ", " & Err.Description

End Sub
'---------------------------------------



"Peponne31" discussion :
Bonsoir à tous,

Dans ce code , je voudrai récupérer le message d'erreur
si on valide sans faire de sélection dans le ListBox, je ni parviens pas.

Private Sub UserForm_Initialize()
Dim Rg As Range
Dim Critere As Long
Me.Caption = ThisWorkbook.Name
With Worksheets("JournalDevis")
Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
End With
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & _
ThisWorkbook.FullName & ";" & "Extended Properties=""Excel
8.0;HDR=Yes;"""
requete = "SELECT N°devis, Nom FROM [" & Rg.Parent.Name & "$" &
Rg.Address(0, 0) _
& "]"
Rst.Open requete, Conn, adOpenStatic, adLockOptimistic
a = Rst.RecordCount
x = Rst.GetRows
With Me.ListBox1
'If .List >= 1 Then '<--ici pour l'erreur
.ColumnCount = 2
.ColumnWidths = "50;85"
.List = Application.Transpose(x)
'Else
' MsgBox "Aucune sélection de faite dans la liste !"
' End If
End With
End Sub

Merci à vous pour votre aide
Peponne31



Peponne31
Le #20275121
Bonjour Michdenis,

Merci de m'avoir répondu,
Comme à mon habitude, j'ai du mal exprimer ma demande,
lorsque j'appui sur le bouton " Rappel devis "
le ListBox est bien présent à l' écran et rempli des Noms et N°
c'est juste dans L'UserForm, si je clique sur valider sans sélectionner
un Item dans la liste j'ai un message d'erreur et c'est la
que je voudrais récuperer cette erreur par un message:
"vous n'avez fait aucunne selection...
Merci encore de te pencher sur des cas comme moi.
Peponne31

"michdenis" a écrit :

à titre d'exemple ceci : http://cjoint.com/?kcaxXPD2wD

si tu veux tester si ton listbox n'a aucune sélection,

Sub test1()
If Me.ListBox1.ListIndex = -1 Then
MsgBox "No sélection"
Else
'Affiche la sélection (2 colonnes)
MsgBox Me.ListBox1.List(Me.ListBox1.ListIndex, 0) & _
vbTab & Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End If
End Sub



"Peponne31" discussion :
Bonsoir Michdenis,

C'est pareil, à partir du moment ou il ni a aucune sélection de faite
il me dit:

Erreur d'exécution 381
Impossible de lire la propriété List. Index de table de propriété non valide

Merci encore
Peponne31

"michdenis" a écrit :

> Bonjour,
>
> Cela devrait aller comme ça :
>
> Je suppose qu'il y a une variable Rst de déclarer
> comme étant le "RecordSet , sinon il faudra l'ajouter
> Dim Rst As New ADODB.Recordset à la déclaration
> des variables.
>
> '---------------------------------------
> Private Sub UserForm_Initialize()
>
> Dim GestionErreur As String
> Dim Rg As Range
> Dim Critere As Long
>
> On Error GoTo GestionErreur
>
> Me.Caption = ThisWorkbook.Name
> With Worksheets("JournalDevis")
> Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
> End With
>
> Set Conn = New ADODB.Connection
>
> Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=" & ThisWorkbook.FullName & ";" & _
> "Extended Properties=""Excel 8.0;HDR=Yes;"""
>
> requete = "SELECT [N°devis], Nom FROM [" & _
> Rg.Parent.Name & "$" & Rg.Address(0, 0) & "]"
>
> Rst.Open requete, Conn, adOpenStatic, adLockOptimistic
>
> x = Rst.GetRows
> With Me.ListBox1
> .Clear
> .ColumnCount = 2
> .ColumnWidths = "50;85"
> .List = Application.Transpose(x)
> End With
> Exit Sub
>
> GestionErreur:
> MsgBox "La procédure a rencontré un pépin " & _
> "de ce type: " & vbCrLf & _
> Err.Number & ", " & Err.Description
>
> End Sub
> '---------------------------------------
>
>
>
> "Peponne31" > discussion :
> Bonsoir à tous,
>
> Dans ce code , je voudrai récupérer le message d'erreur
> si on valide sans faire de sélection dans le ListBox, je ni parviens pas.
>
> Private Sub UserForm_Initialize()
> Dim Rg As Range
> Dim Critere As Long
> Me.Caption = ThisWorkbook.Name
> With Worksheets("JournalDevis")
> Set Rg = .Range("A7:C" & .Range("A65536").End(xlUp).Row)
> End With
> Set Conn = New ADODB.Connection
> Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & _
> ThisWorkbook.FullName & ";" & "Extended Properties=""Excel
> 8.0;HDR=Yes;"""
> requete = "SELECT N°devis, Nom FROM [" & Rg.Parent.Name & "$" &
> Rg.Address(0, 0) _
> & "]"
> Rst.Open requete, Conn, adOpenStatic, adLockOptimistic
> a = Rst.RecordCount
> x = Rst.GetRows
> With Me.ListBox1
> 'If .List >= 1 Then '<--ici pour l'erreur
> .ColumnCount = 2
> .ColumnWidths = "50;85"
> .List = Application.Transpose(x)
> 'Else
> ' MsgBox "Aucune sélection de faite dans la liste !"
> ' End If
> End With
> End Sub
>
> Merci à vous pour votre aide
> Peponne31
>


michdenis
Le #20275611
| si je clique sur valider sans sélectionner un Item

Et ceci ne fonctionne pas ?
cette ligne de code empêche le reste de la procédure
de s'exécuter si aucune sélection dans le listbox1 est
active au moment de lancer une procédure...
ça ne marche pas chez toi ?

If Me.ListBox1.ListIndex = -1 Then

'-----------------------------------------
Sub test1()
If Me.ListBox1.ListIndex = -1 Then
MsgBox "No sélection"
Else
'Affiche la sélection (2 colonnes)
MsgBox Me.ListBox1.List(Me.ListBox1.ListIndex, 0) & _
vbTab & Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End If
End Sub
'-----------------------------------------
Peponne31
Le #20275771
Re

Merci pour ton message, je viens de résoudre le problème,
suis pas bien révèillé.
Private Sub Valider_Click()
Dim LisBox1 As ListBox
Dim vIndex
vIndex = ListBox1.ListIndex
If Not IsNull(Me.ListBox1.Value) Then
Range("K3").ClearContents
Range("K3") = RappelDevis.ListBox1.List(vIndex)
End
Else
MsgBox "pas de numéro sélectionné!!!"
End If
End Sub
c'est ici, dans le bouton valider que je devais contrôler
si une sélection a été faite ou pas dans le ListBox.
Merci encore
Peponne31

"michdenis" a écrit :

| si je clique sur valider sans sélectionner un Item

Et ceci ne fonctionne pas ?
cette ligne de code empêche le reste de la procédure
de s'exécuter si aucune sélection dans le listbox1 est
active au moment de lancer une procédure...
ça ne marche pas chez toi ?

If Me.ListBox1.ListIndex = -1 Then

'-----------------------------------------
Sub test1()
If Me.ListBox1.ListIndex = -1 Then
MsgBox "No sélection"
Else
'Affiche la sélection (2 colonnes)
MsgBox Me.ListBox1.List(Me.ListBox1.ListIndex, 0) & _
vbTab & Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End If
End Sub
'-----------------------------------------




Publicité
Poster une réponse
Anonyme