pb userform base de dobnée

[atc]

salut le forum
j'ai un userform pour base de données ou il y'a un bug au moment des commandes et que je n'arrive pas a resoudre si quelqu'un peux m'aider j'en serais reconnaissant
d'avance merci

Option Explicit



Dim WS As Worksheet
Dim Reg As String
Dim Rsfta As String
Dim Day As String
Dim Validite As String
Dim App As String
Dim Statut As String
Dim Trajet As String


Const T As String = 'Autorisations'

Private Sub Label1_Click()

End Sub

Private Sub Label3_Click()

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox3_Change()

End Sub

Private Sub TextBox4_Change()

End Sub

Private Sub TextBox5_Change()

End Sub

Private Sub UserForm_Initialize()
Me.Caption = T
Ini
End Sub
Private Sub Ini()
Dim CTRL As Control
Dim L As Integer
Dim i As Integer

For Each CTRL In Me.Controls
If TypeOf CTRL Is MSForms.TextBox Or TypeOf CTRL Is MSForms.ComboBox Then
CTRL = ''
End If
Next CTRL


Me.ComboBox1.Clear

Set WS = ThisWorkbook.Sheets('DataBase')

L = WS.Range('A65536').End(xlUp).Row


Application.ScreenUpdating = False
WS.Select
WS.Range('A2').Sort Key1:=Range('A2'), Order1:=xlAscending, Header:=xlGuess


For i = 2 To L
With Me.ComboBox1
.AddItem WS.Range('A' & i)
End With
Next i

Application.ScreenUpdating = True
End Sub



Private Sub UserForm_Activate()
Me.ComboBox1.SetFocus
End Sub


Private Sub ComboBox1_Click()
If Me.ComboBox1.ListIndex = -1 Then Exit Sub

TextBox1 = WS.Range('B' & Me.ComboBox1.ListIndex + 2)
TextBox2 = WS.Range('C' & Me.ComboBox1.ListIndex + 2)
ComboBox2 = WS.Range('D' & Me.ComboBox1.ListIndex + 2)
TextBox3 = WS.Range('E' & Me.ComboBox1.ListIndex + 2)
TextBox4 = WS.Range('F' & Me.ComboBox1.ListIndex + 2)
TextBox5 = WS.Range('G' & Me.ComboBox1.ListIndex + 2)

With Me
Reg = .ComboBox1
Rsfta = .TextBox1
Day = .TextBox2
Validite = .ComboBox2
App = .TextBox3
Statut = .TextBox4
Trajet = .TextBox5
End With
End Sub



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


For Each CTRL In Me.Controls
If CTRL = '' Then MsgBox 'Donnée Incomplete', vbCritical, T: CTRL.SetFocus: Exit Sub
Next CTRL

L = WS.Range('A65536').End(xlUp).Row + 1


For X = 2 To L
If ComboBox1 = WS.Range('A' & X) Then
Match = Match + 1: i = X
End If
Next X


If Match > 0 Then
Response = MsgBox('Duplication trouvée dans la Database pour : ' & ComboBox1 & vbCrLf & _
'Reg : ' & vbTab & vbTab & WS.Cells(i, 1) & vbCrLf & _
'Rsfta : ' & vbTab & vbTab & WS.Cells(i, 2) & vbCrLf & _
'Day : ' & vbTab & vbTab & WS.Cells(i, 3) & vbCrLf & _
'Validite : ' & vbTab & WS.Cells(i, 4) & vbCrLf & _
'App : ' & vbTab & WS.Cells(i, 5) & vbCrLf & _
'Statut : ' & vbTab & WS.Cells(i, 6) & vbCrLf & _
'Trajet : ' & vbTab & WS.Cells(i, 7) & 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:

With WS
.Range('A' & L) = ComboBox1
.Range('B' & L) = TextBox1
.Range('C' & L) = TextBox2
.Range('D' & L) = ComboBox2
.Range('E' & L) = TextBox3
.Range('F' & L) = TextBox4
.Range('G' & L) = TextBox5
' Idem
End With
Ini

Fin:
End Sub


Private Sub CmdModif_Click()
Dim CTRL As Control
Dim i As Integer
Dim Response As Byte


For Each CTRL In Me.Controls
If CTRL = '' Then MsgBox 'Donnée Incomplete', vbCritical, T: CTRL.SetFocus: Exit Sub
Next CTRL



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



If Reg = ComboBox1 Then
If Rsfta = TextBox1 Then
If Day = TextBox2 Then
If Validite = ComboBox2 Then
If App = TextBox3 Then
If Statut = TextBox4 Then
If Trajet = TextBox5 Then
MsgBox '', vbCritical, T & ' '
Exit Sub
End If
End If
End If
End If
End If
End If
End If



Response = MsgBox('Les elements de ' & vbCrLf & vbCrLf & _
'Old Reg : ' & vbTab & Reg & vbCrLf & _
'New Reg : ' & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
'Old Rsfta : ' & vbTab & Rsfta & vbCrLf & _
'New Rsfta : ' & vbTab & TextBox1 & vbCrLf & vbCrLf & _
'Old Date : ' & vbTab & Day & vbCrLf & _
'New Date : ' & vbTab & TextBox2 & vbCrLf & vbCrLf & _
'Old Validite : ' & vbTab & Validite & vbCrLf & _
'New Validite : ' & vbTab & ComboBox2 & vbCrLf & vbCrLf & _
'Old App : ' & vbTab & App & vbCrLf & _
'New App : ' & vbTab & TextBox3 & vbCrLf & vbCrLf & _
'Old Statut : ' & vbTab & Statut & vbCrLf & _
'New Statut : ' & vbTab & TextBox4 & vbCrLf & vbCrLf & _
'Old Trajet : ' & vbTab & Trajet & vbCrLf & _
'New Trajet : ' & vbTab & TextBox5 & vbCrLf & vbCrLf & _
'Acceptez vous ces changements ? ', vbQuestion + vbOKCancel, T & ' Modification de : ' & Reg)


If Response = 1 Then


With WS
.Range('A' & Me.ComboBox1.ListIndex + 2) = ComboBox1
.Range('B' & Me.ComboBox1.ListIndex + 2) = TextBox1
.Range('C' & Me.ComboBox1.ListIndex + 2) = TextBox2
.Range('D' & Me.ComboBox1.ListIndex + 2) = ComboBox2
.Range('E' & Me.ComboBox1.ListIndex + 2) = TextBox3
.Range('F' & Me.ComboBox1.ListIndex + 2) = TextBox4
.Range('G' & Me.ComboBox1.ListIndex + 2) = TextBox5
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

For Each CTRL In Me.Controls
If CTRL = '' Then MsgBox 'Donnée Incomplete', vbCritical, T: CTRL.SetFocus: Exit Sub
Next CTRL


Response = MsgBox('Les elements de ' & vbCrLf & vbCrLf & _
'Reg : ' & vbTab & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
'New Rsfta : ' & vbTab & TextBox1 & vbCrLf & vbCrLf & _
'New Day : ' & vbTab & TextBox2 & vbCrLf & vbCrLf & _
'New Validite : ' & vbTab & ComboBox2 & vbCrLf & vbCrLf & _
'New App : ' & vbTab & TextBox3 & vbCrLf & vbCrLf & _
'New Statut : ' & vbTab & TextBox4 & vbCrLf & vbCrLf & _
'New Trajet : ' & vbTab & TextBox5 & vbCrLf & vbCrLf & _
'Vont être définitivement Supprimées ? ', vbCritical + vbOKCancel, T & ' SUPPRESSION de : ' & Reg)


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 X_Click()

End Sub

 

[Hervé]

Bonjour atc


bon, j'ai pas refait l'userform, donc je peux me planter, mais je n'ai rien vu de bizarre dans ton code.

pourrais tu nous précisez ou le bug intervient, et le message d'erreur.

salut

 

[atc]

bonjour le forum
il y'a bug au moment de la validation ,la modification et la supression des données quant au message le debogueur affiche la procedure
If CTRL = '' Then en jaune

merci pour votre aide