Re : Code dans un USF
OUPS mon fichier ne passe pas trop volumineux
Je met le code
Private Sub CmdAjouter_Click()
Dim Ctrl As Control
Dim L As Integer
Dim X As Integer, i As Integer
Dim Response As Byte
Dim Match As Byte
L = ws.Range("B65536").End(xlUp).Row + 1
'ici un Control de Duplication
For X = 2 To L
If ComboBox1 = ws.Range("B" & X) Then
Match = Match + 1: i = X
End If
Next X
'Si il y a Duplication on demande en montrant les détails de la Duplication
If Match > 0 Then
Response = MsgBox("Duplication trouvée dans la Database pour : " & ComboBox1 & vbCrLf & _
"Nom : " & vbTab & vbTab & ws.Cells(i, 1) & vbCrLf & _
"Adresse : " & vbTab & vbTab & ws.Cells(i, 2) & vbCrLf & _
"CodePostal : " & vbTab & ws.Cells(i, 3) & vbCrLf & _
"Voulez-Vous Intégrer cet enregistrement ?", vbQuestion + vbOKCancel, T & " DUPLICATION " & ComboBox1)
If Response = 1 Then
GoTo Suite
Else: GoTo Fin
End If
End If
Suite:
On Error Resume Next
With ws
.Range("A" & L) = TextBox19
.Range("B" & L) = ComboBox1
.Range("C" & L) = CDate(TextBox22)
.Range("D" & L) = TextBox23
.Range("E" & L) = TextBox18
.Range("F" & L) = TextBox12
.Range("G" & L) = TextBox13
.Range("H" & L) = TextBox14
.Range("I" & L) = TextBox15
.Range("J" & L) = TextBox16
.Range("K" & L) = TextBox20
.Range("L" & L) = TextBox44
.Range("M" & L) = TextBox36
.Range("N" & L) = TextBox30
.Range("O" & L) = TextBox31
.Range("P" & L) = TextBox39
.Range("Q" & L) = TextBox40
.Range("R" & L) = TextBox41
.Range("S" & L) = TextBox42
.Range("T" & L) = TextBox17
.Range("U" & L) = TextBox24
.Range("V" & L) = TextBox25
.Range("W" & L) = TextBox38
.Range("X" & L) = TextBox34
.Range("Y" & L) = TextBox35
.Range("Z" & L) = TextBox43
.Range("AA" & L) = TextBox27
.Range("AB" & L) = TextBox33
.Range("AC" & L) = TextBox26
.Range("AD" & L) = TextBox32
.Range("AE" & L) = TextBox28
.Range("AF" & L) = TextBox29
.Range("AG" & L) = TextBox37
.Range("AH" & L) = TextBox21
End With
Ini 'On lance la réinitialisation du UserForm (Macro en haut du Module)
Fin:
End Sub
Private Sub CmdModif_Click()
Dim Ctrl As Control
Dim i As Integer
Dim Response As Byte
If Me.ComboBox1.ListIndex = -1 Then
MsgBox "Attention comme dans toute Base de Données, le Nom est la Clef de L'enregistrement" & vbCrLf & _
"Ce qui implique que vous ne pouvez pas Modifier cette Clef. " & vbCrLf & _
"Par conséquent pour un changement de Nom vous devez Supprimer l'enregistrement", vbCritical, T & " Warning System Integrity"
Exit Sub
End If
Response = MsgBox("Les coordonnées de " & vbCrLf & vbCrLf & _
"Old Nom : " & vbTab & Nom & vbCrLf & _
"New Nom : " & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
"Old Date naissance : " & vbTab & DateNaissance & vbCrLf & _
"New Date naissance : " & vbTab & TextBox22 & vbCrLf & vbCrLf & _
"Old Adresse : " & vbTab & Adresse & vbCrLf & _
"New Adresse : " & vbTab & TextBox12 & vbCrLf & vbCrLf & _
"Old C/Postal : " & vbTab & CodePostal & vbCrLf & _
"New C/Postal : " & vbTab & TextBox13 & vbCrLf & vbCrLf & _
"Old Commune : " & vbTab & Ville & vbCrLf & _
"New Commune : " & vbTab & TextBox14 & vbCrLf & vbCrLf & _
"Acceptez vous ces changements ? ", vbQuestion + vbOKCancel, T & " Modification de : " & Nom)
If Response = 1 Then
With ws
.Range("A" & Me.ComboBox1.ListIndex + 2) = TextBox19
.Range("B" & Me.ComboBox1.ListIndex + 2) = ComboBox1
.Range("C" & Me.ComboBox1.ListIndex + 2) = TextBox22
.Range("D" & Me.ComboBox1.ListIndex + 2) = TextBox23
.Range("E" & Me.ComboBox1.ListIndex + 2) = TextBox18
.Range("F" & Me.ComboBox1.ListIndex + 2) = TextBox12
.Range("G" & Me.ComboBox1.ListIndex + 2) = TextBox13
.Range("H" & Me.ComboBox1.ListIndex + 2) = TextBox14
.Range("I" & Me.ComboBox1.ListIndex + 2) = TextBox15
.Range("J" & Me.ComboBox1.ListIndex + 2) = TextBox16
.Range("K" & Me.ComboBox1.ListIndex + 2) = TextBox20
.Range("L" & Me.ComboBox1.ListIndex + 2) = TextBox31
.Range("M" & Me.ComboBox1.ListIndex + 2) = TextBox36
.Range("N" & Me.ComboBox1.ListIndex + 2) = TextBox30
.Range("0" & Me.ComboBox1.ListIndex + 2) = TextBox31
.Range("P" & Me.ComboBox1.ListIndex + 2) = TextBox39
.Range("Q" & Me.ComboBox1.ListIndex + 2) = TextBox40
.Range("R" & Me.ComboBox1.ListIndex + 2) = TextBox41
.Range("S" & Me.ComboBox1.ListIndex + 2) = TextBox42
.Range("T" & Me.ComboBox1.ListIndex + 2) = TextBox17
.Range("U" & Me.ComboBox1.ListIndex + 2) = TextBox24
.Range("V" & Me.ComboBox1.ListIndex + 2) = TextBox25
.Range("W" & Me.ComboBox1.ListIndex + 2) = TextBox38
.Range("X" & Me.ComboBox1.ListIndex + 2) = TextBox34
.Range("Y" & Me.ComboBox1.ListIndex + 2) = TextBox35
.Range("Z" & Me.ComboBox1.ListIndex + 2) = TextBox43
.Range("AA" & Me.ComboBox1.ListIndex + 2) = TextBox27
.Range("AB" & Me.ComboBox1.ListIndex + 2) = TextBox33
.Range("AC" & Me.ComboBox1.ListIndex + 2) = TextBox26
.Range("AD" & Me.ComboBox1.ListIndex + 2) = TextBox32
.Range("AE" & Me.ComboBox1.ListIndex + 2) = TextBox28
.Range("AF" & Me.ComboBox1.ListIndex + 2) = TextBox29
.Range("AG" & Me.ComboBox1.ListIndex + 2) = TextBox37
.Range("AH" & Me.ComboBox1.ListIndex + 2) = TextBox21
End With
MsgBox "Opération accomplie", vbInformation, T
Ini
Else: MsgBox "Opération annulée", vbInformation, T
End If
End Sub
Private Sub CmdSupprimer_Click()
Dim Ctrl As Control
Dim i As Integer
Dim Response As Byte
Response = MsgBox("Les coordonnées de " & vbCrLf & vbCrLf & _
"Nom : " & vbTab & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
"New Adresse : " & vbTab & TextBox12 & vbCrLf & vbCrLf & _
"New C/Postal : " & vbTab & TextBox13 & vbCrLf & vbCrLf & _
"New Commune : " & vbTab & TextBox14 & vbCrLf & vbCrLf & _
"Vont être définitivement Supprimées ? ", vbCritical + vbOKCancel, T & " SUPPRESSION de : " & Nom)
If Response = 1 Then
With ws
.Rows(Me.ComboBox1.ListIndex + 2).EntireRow.Delete
End With
MsgBox "Opération accomplie", vbInformation, T
Ini
Else: MsgBox "Opération annulée", vbInformation, T
End If
End Sub
Private Sub CommandButton8_Click()
Unload Me
End Sub
Cela est long, excusez-moi
Je voie pas comment faire d'autre
