je complète ma réponse en mettant la macro complète
[/CODE]
'Macro Faite par DESVIGNE Christophe le 30/05/2019
Option Explicit
Private Sub Bt1_Click()
Dim Lig&, i&
If T1 = "" Or T2 = "" Then MsgBox "Vous devez au minimum remplir le nom et le pr?nom pour pouvoir enregistrer un ?l?ve!!", vbCritical, "Manque de donn?e": Exit Sub
With Feuil5
If T1.ListIndex <> -1 Then
Lig = T1.ListIndex + 2
For i = 1 To 30
If i = 10 Or i = 11 Or i = 15 Or i = 18 Or i = 21 Then .Cells(Lig, i) = Controls("T" & i): GoTo 1
If IsNumeric(Controls("T" & i)) Then
.Cells(Lig, i) = CDbl(Controls("T" & i))
Else
.Cells(Lig, i) = Controls("T" & i)
End If
1 Next i
Else
Lig = .Range("A" & Rows.Count).End(3).Row + 1
For i = 1 To 30
If i = 10 Or i = 11 Or i = 15 Or i = 18 Or i = 21 Then .Cells(Lig, i) = Controls("T" & i): GoTo 2
If IsNumeric(Controls("T" & i)) Then
.Cells(Lig, i) = CDbl(Controls("T" & i))
Else
.Cells(Lig, i) = Controls("T" & i)
End If
2 Next i
End If
End With
Bt2_Click
End Sub
Private Sub Bt2_Click()
Unload Me
r?glement_facturation.Show 0
End Sub
Private Sub Bt3_Click()
Dim rep, rep1
If T1.ListIndex <> -1 Then
rep = MsgBox("Attention vous allez Supprimer l'?l?ve actuellement s?lectionn?, ?tes vous sur de vouloir Supprimer l'?l?ve??", vbCritical + vbYesNo, "Suppression d'un ?l?ve")
If rep = vbNo Then Exit Sub
rep1 = MsgBox("Attention vous allez Supprimer un ?l?ve??, confirmer vous la suppression, action irr?versible??", vbCritical + vbYesNo, "Confirmation de Suppression d'un ?l?ve")
If rep1 = vbNo Then Exit Sub
Feuil1.Rows(T1.ListIndex + 2).Delete shift:=xlUp
Bt2_Click
End If
End Sub
Private Sub Bt4_Click()
Unload Me
End Sub
Private Sub edition_facture_Click()
On Error GoTo OuvertureFichierErreur
Dim MonApplication As Object
Dim MonFichier As String
Set MonApplication = CreateObject("Shell.Application")
MonFichier = "C:\Users\Christophe DESVIGNE\Desktop\Nouveau dossier\attestation de paiement.docx"
MonApplication.Open (MonFichier)
Set MonApplication = Nothing
Exit Sub
OuvertureFichierErreur:
Set MonApplication = Nothing
MsgBox "Erreur lors de l'ouverture de fichier..."
End Sub
Private Sub T1_Click()
Dim Lig&, i&
If T1.ListIndex <> -1 Then
Lig = T1.ListIndex + 2
For i = 1 To 30
Controls("T" & i) = Feuil5.Cells(Lig, i).Value
Next i
End If
Call PrixCours
End Sub
Private Sub T28_Change()
End Sub
Private Sub T29_Change()
T29.Value = Val(T21.Value) + Val(T22.Value) + Val(T23.Value) + Val(T24.Value) + Val(T25.Value) + Val(T26.Value) + Val(T27.Value)
End Sub
Private Sub T30_Change()
T30.Value = Val(T28.Value) - Val(T29.Value)
End Sub
Private Sub T6_Change()
Call PrixCours
End Sub
Private Sub T7_Change()
Call PrixCours
End Sub
Private Sub UserForm_Initialize()
Dim aa, fin&, i&
With Feuil5
fin = .Range("A" & Rows.Count).End(3).Row
If fin < 2 Then Exit Sub
aa = .Range("A2:AC" & fin)
End With
T1.ColumnCount = 2
T1.List = aa
T4.List = Feuil2.Range("C2:C" & Feuil2.Range("C" & Rows.Count).End(3).Row).Value
For i = 6 To 13
Controls("T" & i).List = Feuil2.Range("A2:A" & Feuil2.Range("A" & Rows.Count).End(3).Row).Value
Next i
For i = 14 To 20
Controls("T" & i).List = Feuil2.Range("E2:E" & Feuil2.Range("E" & Rows.Count).End(3).Row).Value
Next i
End Sub
Sub PrixCours()
Dim i As Integer, M As Boolean, NM As Integer, NH As Integer, PH, PM As Integer, j As Integer
PM = 200 'prix cours mensuel
PH = Array(0, 200, 360, 520) ' tableau prix hebdo
With Worksheets("Crit?res")
For i = 6 To 13
M = False
If Controls("T" & i).ListIndex <> -1 Then
For j = 3 To .Range("G" & Rows.Count).End(xlUp).Row
If .Range("G" & j) = Controls("T" & i) Then
M = True
Exit For
End If
Next
If M Then 'si cours mensuel
NM = NM + 1
Else 'cours hebdo
NH = NH + 1
End If
End If
Next
End With
If NH > 3 Then NH = 3
Label70.Caption = PH(NH)
Label72.Caption = NM * PM
End Sub
[/CODE]
A l'execution le débogueur bloque sur T1.ColumnCount = 2, un peu plus haut en jaune . Jusqu'à présent ca lui posait pa de problème .
Peux tu m'aider a comprendre ce qui se passe ?
Merci