Bonjour à tous,
J'ai un petit soucis avec une partie de ma macro, mais hélas, je en trouve pas de porte de sortie... pourrais-je avoir une lumière sur cette erreur 91 ?
Je vous transmets une partie du code... (l'erreur survient lorsqu'il n'y a pas d'entrée dans ma donneeslv et que le petit MSGBOX s'affiche).
...
Private Sub Enregistrer_Click()
For Each Cel In Sheets("DataPlq").Range("W3:W" & Sheets("DataPlq").Range("w65536").End(xlUp).Row)
If UCase(Cel) = IDBox Then
Sheets("DataPlq").Range("C" & Cel.Row).Value = GaucheLongue.Value
Sheets("DataPlq").Range("D" & Cel.Row).Value = GaucheCourte.Value
Sheets("DataPlq").Range("E" & Cel.Row).Value = GaucheBizarre.Value
Sheets("DataPlq").Range("F" & Cel.Row).Value = Gauche1234.Value
Sheets("DataPlq").Range("G" & Cel.Row).Value = DroiteLongue.Value
Sheets("DataPlq").Range("H" & Cel.Row).Value = DroiteCourte.Value
Sheets("DataPlq").Range("I" & Cel.Row).Value = DroiteBizarre.Value
Sheets("DataPlq").Range("J" & Cel.Row).Value = Droite1234.Value
Sheets("DataPlq").Range("K" & Cel.Row).Value = Longue1234.Value
Sheets("DataPlq").Range("L" & Cel.Row).Value = LongueBizarre.Value
Sheets("DataPlq").Range("M" & Cel.Row).Value = Courte1234.Value
Sheets("DataPlq").Range("N" & Cel.Row).Value = CourteBizarre.Value
Sheets("DataPlq").Range("O" & Cel.Row).Value = D1234.Value
Sheets("DataPlq").Range("P" & Cel.Row).Value = Bizarre.Value
Sheets("DataPlq").Range("Q" & Cel.Row).Value = Extremite.Value
End If
Next
End Sub
Private Sub ListBox1_Click()
Dim TypePlq
Dim plage As Range
Dim DernLigne As Long
ListView1.ListItems.Clear
ListView1.Enabled = True
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Set plage = Range("A2:X" & DernLigne)
TypePlq = plage(1 + ListBox1.ListIndex, 1)
Set mondico = CreateObject("Scripting.Dictionary")
Sheets("DonneesLV").Activate
With ListView1: .Gridlines = True: .View = 3: .FullRowSelect = True
With .ColumnHeaders
For z = 1 To 24 'nbcol
.Add , , DLV.Cells(1, z).Value, 70 'entetes
Next z
End With
For z = 1 To DLV.[A65536].End(3).Row
If DLV.Cells(z, 1) = TypePlq Then
For k = 1 To 24: tx = tx & DLV.Cells(z, k): Next
If Not mondico.Exists(tx) Then
mondico.Add tx, tx
.ListItems.Add , , DLV.Cells(z, 1).Value
For J = 2 To 24 '
.ListItems(.ListItems.Count).ListSubItems.Add , , DLV.Cells(z, J).Value
Next J
End If
End If
Next z
End With
End Sub
Private Sub ListView1_Click()
Dim plage As Range
Dim DernLigne As Long
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Set plage = Range("A2:X" & DernLigne)
Nom.Value = plage(1 + ListBox1.ListIndex, 1)
Fabricant.Value = ListView1.SelectedItem.ListSubItems(1)
GaucheLongue.Value = ListView1.SelectedItem.ListSubItems(2)
GaucheCourte.Value = ListView1.SelectedItem.ListSubItems(3)
GaucheBizarre.Value = ListView1.SelectedItem.ListSubItems(4)
Gauche1234.Value = ListView1.SelectedItem.ListSubItems(5)
DroiteLongue.Value = ListView1.SelectedItem.ListSubItems(6)
DroiteCourte.Value = ListView1.SelectedItem.ListSubItems(7)
DroiteBizarre.Value = ListView1.SelectedItem.ListSubItems(8)
Droite1234.Value = ListView1.SelectedItem.ListSubItems(9)
Longue1234.Value = ListView1.SelectedItem.ListSubItems(10)
LongueBizarre.Value = ListView1.SelectedItem.ListSubItems(11)
Courte1234.Value = ListView1.SelectedItem.ListSubItems(12)
CourteBizarre.Value = ListView1.SelectedItem.ListSubItems(13)
D1234.Value = ListView1.SelectedItem.ListSubItems(14)
Bizarre.Value = ListView1.SelectedItem.ListSubItems(15)
Extremite.Value = ListView1.SelectedItem.ListSubItems(16)
Total.Value = ListView1.SelectedItem.ListSubItems(17)
DateSortie.Value = ListView1.SelectedItem.ListSubItems(19)
DateRetour.Value = ListView1.SelectedItem.ListSubItems(21)
Client.Value = ListView1.SelectedItem.ListSubItems(23)
IDBox.Value = ListView1.SelectedItem.ListSubItems(22)
End Sub
Private Sub ListView1_DblClick()
Dim ID
ID = ListView1.SelectedItem.ListSubItems(22)
a = MsgBox("Voulez-vous modifier le prêt N° " & ID & ", concernant le client " & Client.Text & ", pour les plaques : " & Nom.Value & " ?", 4, "Attention")
If a = 6 Then
b = MsgBox("Est-ce un retour de prêt ?", 4, "Attention")
If b = 6 Then
For Each Cel In Sheets("DataPlq").Range("W3:W" & Sheets("DataPlq").Range("w65536").End(xlUp).Row)
If UCase(Cel) = IDBox Then
Sheets("DataPlq").Range("U" & Cel.Row).Value = "Oui"
Sheets("DataPlq").Range("V" & Cel.Row).Value = Date
End If
Next
Else
c = MsgBox("Est-ce une modification de la quantité ?", 4, "Attention")
If c = 6 Then
MsgBox ("Modifiez les quantités puis enregistrez.")
GaucheLongue.Enabled = True
GaucheCourte.Enabled = True
GaucheBizarre.Enabled = True
Gauche1234.Enabled = True
DroiteLongue.Enabled = True
DroiteCourte.Enabled = True
DroiteBizarre.Enabled = True
Droite1234.Enabled = True
Longue1234.Enabled = True
LongueBizarre.Enabled = True
Courte1234.Enabled = True
CourteBizarre.Enabled = True
D1234.Enabled = True
Bizarre.Enabled = True
Extremite.Enabled = True
Enregistrer.Enabled = True
Else
Exit Sub
End If
End If
End If
End Sub
Private Sub Quitter_Click()
Unload Me
End Sub
Private Sub Retour_Click()
Unload Me
USFKeops.Show
End Sub
Private Sub UserForm_Initialize()
ListView1.ListItems.Clear
Call MEP
Call InitialisationListbox
End Sub
Sub InitialisationListbox()
Dim no_colonne As Integer, nb_lignes As Integer
If Sheets("DonneesLV").Range("A3").Value = "" Then
MsgBox ("Aucun prêt n'a été rengistré.")
Unload Me
Else
ListBox1.Clear 'Zone de liste vidée (sinon les villes sont ajoutées à la suite)
no_colonne = 1 'Numéro de la sélection (ListIndex commence à 0) :
nb_lignes = Sheets("DonneesLV").Cells(1, no_colonne).End(xlDown).Row 'Nombre de lignes de la colonne du pays choisi :
For i = 2 To nb_lignes ' => pour lister les villes
ListBox1.AddItem Sheets("DonneesLV").Cells(i, no_colonne)
Next
End If
End Sub
Sub MEP()
Sheets("DonneesLV").Activate
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
For Each Cel In Sheets("DataPlq").Range("U3:U" & Sheets("DataPlq").Range("U65536").End(xlUp).Row)
If UCase(Cel) = "NON" Then
Sheets("DataPlq").Range("A" & Cel.Row & ":X" & Cel.Row).Copy _
Sheets("DonneesLV").Range("A" & Sheets("DonneesLV").Range("A65536").End(xlUp).Row + 1)
End If
Next
End Sub
...
Merci à vous,
Arkh
J'ai un petit soucis avec une partie de ma macro, mais hélas, je en trouve pas de porte de sortie... pourrais-je avoir une lumière sur cette erreur 91 ?
Je vous transmets une partie du code... (l'erreur survient lorsqu'il n'y a pas d'entrée dans ma donneeslv et que le petit MSGBOX s'affiche).
...
Private Sub Enregistrer_Click()
For Each Cel In Sheets("DataPlq").Range("W3:W" & Sheets("DataPlq").Range("w65536").End(xlUp).Row)
If UCase(Cel) = IDBox Then
Sheets("DataPlq").Range("C" & Cel.Row).Value = GaucheLongue.Value
Sheets("DataPlq").Range("D" & Cel.Row).Value = GaucheCourte.Value
Sheets("DataPlq").Range("E" & Cel.Row).Value = GaucheBizarre.Value
Sheets("DataPlq").Range("F" & Cel.Row).Value = Gauche1234.Value
Sheets("DataPlq").Range("G" & Cel.Row).Value = DroiteLongue.Value
Sheets("DataPlq").Range("H" & Cel.Row).Value = DroiteCourte.Value
Sheets("DataPlq").Range("I" & Cel.Row).Value = DroiteBizarre.Value
Sheets("DataPlq").Range("J" & Cel.Row).Value = Droite1234.Value
Sheets("DataPlq").Range("K" & Cel.Row).Value = Longue1234.Value
Sheets("DataPlq").Range("L" & Cel.Row).Value = LongueBizarre.Value
Sheets("DataPlq").Range("M" & Cel.Row).Value = Courte1234.Value
Sheets("DataPlq").Range("N" & Cel.Row).Value = CourteBizarre.Value
Sheets("DataPlq").Range("O" & Cel.Row).Value = D1234.Value
Sheets("DataPlq").Range("P" & Cel.Row).Value = Bizarre.Value
Sheets("DataPlq").Range("Q" & Cel.Row).Value = Extremite.Value
End If
Next
End Sub
Private Sub ListBox1_Click()
Dim TypePlq
Dim plage As Range
Dim DernLigne As Long
ListView1.ListItems.Clear
ListView1.Enabled = True
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Set plage = Range("A2:X" & DernLigne)
TypePlq = plage(1 + ListBox1.ListIndex, 1)
Set mondico = CreateObject("Scripting.Dictionary")
Sheets("DonneesLV").Activate
With ListView1: .Gridlines = True: .View = 3: .FullRowSelect = True
With .ColumnHeaders
For z = 1 To 24 'nbcol
.Add , , DLV.Cells(1, z).Value, 70 'entetes
Next z
End With
For z = 1 To DLV.[A65536].End(3).Row
If DLV.Cells(z, 1) = TypePlq Then
For k = 1 To 24: tx = tx & DLV.Cells(z, k): Next
If Not mondico.Exists(tx) Then
mondico.Add tx, tx
.ListItems.Add , , DLV.Cells(z, 1).Value
For J = 2 To 24 '
.ListItems(.ListItems.Count).ListSubItems.Add , , DLV.Cells(z, J).Value
Next J
End If
End If
Next z
End With
End Sub
Private Sub ListView1_Click()
Dim plage As Range
Dim DernLigne As Long
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Set plage = Range("A2:X" & DernLigne)
Nom.Value = plage(1 + ListBox1.ListIndex, 1)
Fabricant.Value = ListView1.SelectedItem.ListSubItems(1)
GaucheLongue.Value = ListView1.SelectedItem.ListSubItems(2)
GaucheCourte.Value = ListView1.SelectedItem.ListSubItems(3)
GaucheBizarre.Value = ListView1.SelectedItem.ListSubItems(4)
Gauche1234.Value = ListView1.SelectedItem.ListSubItems(5)
DroiteLongue.Value = ListView1.SelectedItem.ListSubItems(6)
DroiteCourte.Value = ListView1.SelectedItem.ListSubItems(7)
DroiteBizarre.Value = ListView1.SelectedItem.ListSubItems(8)
Droite1234.Value = ListView1.SelectedItem.ListSubItems(9)
Longue1234.Value = ListView1.SelectedItem.ListSubItems(10)
LongueBizarre.Value = ListView1.SelectedItem.ListSubItems(11)
Courte1234.Value = ListView1.SelectedItem.ListSubItems(12)
CourteBizarre.Value = ListView1.SelectedItem.ListSubItems(13)
D1234.Value = ListView1.SelectedItem.ListSubItems(14)
Bizarre.Value = ListView1.SelectedItem.ListSubItems(15)
Extremite.Value = ListView1.SelectedItem.ListSubItems(16)
Total.Value = ListView1.SelectedItem.ListSubItems(17)
DateSortie.Value = ListView1.SelectedItem.ListSubItems(19)
DateRetour.Value = ListView1.SelectedItem.ListSubItems(21)
Client.Value = ListView1.SelectedItem.ListSubItems(23)
IDBox.Value = ListView1.SelectedItem.ListSubItems(22)
End Sub
Private Sub ListView1_DblClick()
Dim ID
ID = ListView1.SelectedItem.ListSubItems(22)
a = MsgBox("Voulez-vous modifier le prêt N° " & ID & ", concernant le client " & Client.Text & ", pour les plaques : " & Nom.Value & " ?", 4, "Attention")
If a = 6 Then
b = MsgBox("Est-ce un retour de prêt ?", 4, "Attention")
If b = 6 Then
For Each Cel In Sheets("DataPlq").Range("W3:W" & Sheets("DataPlq").Range("w65536").End(xlUp).Row)
If UCase(Cel) = IDBox Then
Sheets("DataPlq").Range("U" & Cel.Row).Value = "Oui"
Sheets("DataPlq").Range("V" & Cel.Row).Value = Date
End If
Next
Else
c = MsgBox("Est-ce une modification de la quantité ?", 4, "Attention")
If c = 6 Then
MsgBox ("Modifiez les quantités puis enregistrez.")
GaucheLongue.Enabled = True
GaucheCourte.Enabled = True
GaucheBizarre.Enabled = True
Gauche1234.Enabled = True
DroiteLongue.Enabled = True
DroiteCourte.Enabled = True
DroiteBizarre.Enabled = True
Droite1234.Enabled = True
Longue1234.Enabled = True
LongueBizarre.Enabled = True
Courte1234.Enabled = True
CourteBizarre.Enabled = True
D1234.Enabled = True
Bizarre.Enabled = True
Extremite.Enabled = True
Enregistrer.Enabled = True
Else
Exit Sub
End If
End If
End If
End Sub
Private Sub Quitter_Click()
Unload Me
End Sub
Private Sub Retour_Click()
Unload Me
USFKeops.Show
End Sub
Private Sub UserForm_Initialize()
ListView1.ListItems.Clear
Call MEP
Call InitialisationListbox
End Sub
Sub InitialisationListbox()
Dim no_colonne As Integer, nb_lignes As Integer
If Sheets("DonneesLV").Range("A3").Value = "" Then
MsgBox ("Aucun prêt n'a été rengistré.")
Unload Me
Else
ListBox1.Clear 'Zone de liste vidée (sinon les villes sont ajoutées à la suite)
no_colonne = 1 'Numéro de la sélection (ListIndex commence à 0) :
nb_lignes = Sheets("DonneesLV").Cells(1, no_colonne).End(xlDown).Row 'Nombre de lignes de la colonne du pays choisi :
For i = 2 To nb_lignes ' => pour lister les villes
ListBox1.AddItem Sheets("DonneesLV").Cells(i, no_colonne)
Next
End If
End Sub
Sub MEP()
Sheets("DonneesLV").Activate
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
For Each Cel In Sheets("DataPlq").Range("U3:U" & Sheets("DataPlq").Range("U65536").End(xlUp).Row)
If UCase(Cel) = "NON" Then
Sheets("DataPlq").Range("A" & Cel.Row & ":X" & Cel.Row).Copy _
Sheets("DonneesLV").Range("A" & Sheets("DonneesLV").Range("A65536").End(xlUp).Row + 1)
End If
Next
End Sub
...
Merci à vous,
Arkh
Dernière édition: