bug sur userform

atc

XLDnaute Junior
Bonjour Forum
Etant un débutant en VBA je sollicite votre aide afin de remédier à un bug dans le code suivant il s’agit d’un user form pour bases de données, j’aimerais pouvoir l’utiliser pour stocker des données en ref et texte pour cette fin j’ai essayé d’adapter le TextBox2 pour un texte relativement long, le pb c’est que parfois à partir d’une certaine longueur de texte ça plante et il me renvoie un message erreur d’exécution.

Le code :

Dim WS As Worksheet 'Variable pour un Objet Worksheet en PUBLIC pour tous les Controls de ce UserForm

Dim REG As String 'Variable poyr récupérer l'ancienne valeur pour le Bouton Modif
Dim Appareil As String 'idem
Dim Trajet As String 'idem
Dim Rsfta As String 'idem
Dim Recu_le As String 'idem
Dim Validite As String 'idem
Dim Statut As String 'idem


Const T As String = 'Autorisations'

Private Sub Frame1_Click()

End Sub

Private Sub CommandButton3_Click()

End Sub


Private Sub TextBox2_Change()
Dim Fichier As String
Dim val As Long
Dim Cible As String
Fichier = Application.GetOpenFilename('Text Files (.), .')
If Fichier = 'Faux' Then Exit Sub
Open Fichier For Input As #1 'recup données fichier texte
val = FileLen(Fichier)
Cible = Input(val, 1)
Close #1
TextBox2 = Cible
End Sub



Private Sub TextBox4_Change()
Dim Texte As String
Texte = TextBox4.Text
Select Case Len(Texte)
Case 2, 5
Texte = Texte
End Select
TextBox4.Text = Texte
End Sub

Private Sub TextBox4_Enter()
TextBox4.Text = ''
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With TextBox4
If .Value = '' Then Exit Sub

If Not IsDate(.Value) Then
.SelStart = 0
.SetFocus
.SelLength = Len(.Text)
Cancel = True


Else
TextBox4.Text = Format(TextBox4.Text, 'dd/mm/yy')
End If
End With

End Sub

Private Sub TextBox5_Change()

End Sub

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'INITIALISATION DU USERFORM============================================================================
Private Sub UserForm_Initialize()
Me.Caption = T
Ini
End Sub
Private Sub TextBox3_Change()
Dim Texte As String
Texte = TextBox3.Text
Select Case Len(Texte)
Case 2, 5
Texte = Texte
End Select
TextBox3.Text = Texte
End Sub

Private Sub TextBox3_Enter()
TextBox3.Text = ''
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With TextBox3
If .Value = '' Then Exit Sub

If Not IsDate(.Value) Then
.SelStart = 0
.SetFocus
.SelLength = Len(.Text)
Cancel = True


Else
TextBox3.Text = Format(TextBox3.Text, 'dd/mm/yy')
End If
End With

End Sub
Sub Ini()
Dim CTRL As Control 'Variable pour la collection des controls
Dim L As Integer 'Variable pour connaitre le numéro de derniere ligne
Dim i As Integer 'Variable pour connaitre incrémenter les Data

'On Vide tous les Controls
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 'On vide les précédentes données
Me.ComboBox2.Clear 'On vide les précédentes données

Set WS = ThisWorkbook.Sheets('DataBase') 'On identifie l'objet pour la feuille de travail

L = WS.Range('A65536').End(xlUp).Row 'On identifie la dernière ligne en partant du bas


'Pour éviter les fash d'écran pour le select ci dessous
Application.ScreenUpdating = False
WS.Select 'On sélectionne la feuille sinon bug si elle ne l'est pas
WS.Range('A2').Sort Key1:=Range('A2'), Order1:=xlAscending, Header:=xlGuess 'Le Sort


For i = 2 To L 'Boucle départ 2 (Ligne 2 de la feuille, jusqu'à dernière
With Me.ComboBox1 'Avec la ComboBox1
.AddItem WS.Range('A' & i) 'On ajoute dans la ComboBox toutes les valeurs, cellules après cellules
End With
Next i 'Next pour poursuivre la boucle pour le i suivant

Application.ScreenUpdating = True
End Sub


' A l'activation on démarre le focus sur la Première Combobox
Private Sub UserForm_Activate()
Me.ComboBox1.SetFocus
End Sub

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'MISE A JOUR DES VALEURS DEPUIS LA COMBOBOX1===========================================================
Private Sub ComboBox1_Click()
If Me.ComboBox1.ListIndex = -1 Then Exit Sub 'ON sort si pas de sélection

TextBox1 = WS.Range('B' & Me.ComboBox1.ListIndex + 2) 'On alimente les données correspondant à la ligne
TextBox2 = WS.Range('C' & Me.ComboBox1.ListIndex + 2) 'de l'index de la Combobox + 2 pour la ligne de Feuille
ComboBox2 = WS.Range('D' & Me.ComboBox1.ListIndex + 2) 'il ne faut pas se planter ici !! lol
TextBox3 = WS.Range('E' & Me.ComboBox1.ListIndex + 2)
TextBox4 = WS.Range('F' & Me.ComboBox1.ListIndex + 2)
TextBox5 = WS.Range('G' & Me.ComboBox1.ListIndex + 2)
'ici on initialise les Variable pour mémoriser le valeur précédente en cas de Modif
With Me
REG = .ComboBox1
Appareil = .TextBox1
Trajet = .TextBox2
Rsfta = .ComboBox2
Recu_le = .TextBox3
Validite = .TextBox4
Statut = .TextBox5
End With
End Sub


'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'AJOUT DE VALEUR DU USERFORM===========================================================================
Private Sub CmdAjouter_Click()
Dim CTRL As Control 'Variable pour la collection des controls
Dim L As Integer 'Variable pour connaitre le numéro de derniere ligne vide
Dim X As Integer, i As Integer 'Variables pour faire la boucle de checking de Duplication
Dim Response As Byte
Dim Match As Byte

'ici une boucle sur tous les controls, si un est vide on sort et on set le focus dessus
For Each CTRL In Me.Controls
If ComboBox1 = '' Or TextBox1 = '' Or TextBox2 = '' Or ComboBox2 = '' Or TextBox3 = '' Or TextBox4 = '' Then
MsgBox 'Donnée Incomplete', vbCritical: Exit Sub
End If
Next CTRL

L = WS.Range('A65536').End(xlUp).Row + 1 ' On identifie la dernière ligne vide en partant du bas

'ici un Control de Duplication
For X = 2 To L
If ComboBox1 = WS.Range('A' & 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 & _
'Reg : ' & vbTab & vbTab & WS.Cells(i, 1) & vbCrLf & _
'Appareil : ' & vbTab & vbTab & WS.Cells(i, 2) & vbCrLf & _
'Rsfta : ' & vbTab & WS.Cells(i, 4) & vbCrLf & _
'Recu_le : ' & vbShortDate & vbShortDate & WS.Cells(i, 5) & vbCrLf & _
'Validite : ' & vbTab & vbTab & WS.Cells(i, 6) & vbCrLf & _
'Statut : ' & vbTab & vbTab & WS.Cells(i, 7) & vbCrLf & _
'Voulez-Vous Valider ces données ?', vbQuestion + vbOKCancel, T & ' Duplication ' & ComboBox1)

If Response = 1 Then
GoTo Suite 'On suit le déroulement si réponse OK
Else: GoTo Fin 'Sinon On sort
End If
End If

Suite:
'ici avec la Feuille on va faire :
With WS
.Range('A' & L) = ComboBox1 ' On écrit dans chaque colonne les valeurs des différents controls
.Range('B' & L) = TextBox1 ' Idem
.Range('C' & L) = TextBox2 ' Idem
.Range('D' & L) = ComboBox2 ' Idem
.Range('E' & L) = TextBox3 ' Idem
.Range('F' & L) = TextBox4 ' Idem

End With
Ini 'On lance la réinitialisation du UserForm (Macro en haut du Module)

Fin:
End Sub

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'MODIFICATION DE VALEUR DU USERFORM====================================================================
Private Sub CmdModif_Click()
Dim CTRL As Control 'Variable pour la collection des controls
Dim i As Integer
Dim Response As Byte

'ici une boucle sur tous les controls, si un est vide on sort et on set le focus dessus
For Each CTRL In Me.Controls
If CTRL = '' Then MsgBox 'Donnée Incomplete', vbCritical, T: CTRL.SetFocus: Exit Sub
Next CTRL


'Si le User tente de change le nom de la ComboBox en Mode Modification
If Me.ComboBox1.ListIndex = -1 Then
MsgBox 'Attention l'Immatriculation est le Mot Cle de L'enregistrement' & vbCrLf & _
'Ce qui implique que vous ne pouvez pas La Modifier . ' & vbCrLf & _
'Par conséquent pour un changement de Nom vous devez Supprimer l'enregistrement', vbCritical, T & ' Warning System Integrity'
Exit Sub 'ON sort si pas de sélection
End If


'Ici une cascade de IF si les controls non pas été changés...
If REG = ComboBox1 Then
If Appareil = TextBox1 Then
If Trajet = TextBox2 Then
If Rsfta = ComboBox2 Then
If Recu_le = TextBox3 Then
If Validite = TextBox4 Then
If Statut = TextBox5 Then

MsgBox '', vbCritical, T & ' Operation interdite '
Exit Sub
End If
End If
End If
End If
End If
End If
End If



'Ici un message demandant d'accepter les changement en les listant
Response = MsgBox('Les données de ' & vbCrLf & vbCrLf & _
'Old Reg : ' & vbTab & REG & vbCrLf & _
'New Reg : ' & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
'Old Appareil : ' & vbTab & Appareil & vbCrLf & _
'New Appareil : ' & vbTab & TextBox1 & vbCrLf & vbCrLf & _
'Old Rsfta : ' & vbTab & Rsfta & vbCrLf & _
'New Rsfta : ' & vbTab & ComboBox2 & vbCrLf & vbCrLf & _
'Old Recu_le : ' & vbTab & Recu_le & vbCrLf & _
'New Recu_le : ' & vbTab & TextBox3 & vbCrLf & vbCrLf & _
'Old Validite : ' & vbTab & Validite & vbCrLf & _
'New Validite : ' & vbTab & TextBox4 & vbCrLf & vbCrLf & _
'Acceptez vous ces changements ? ', vbQuestion + vbOKCancel, T & ' Modification de : ' & REG)

'Si Réponse OK on continue
If Response = 1 Then

'ici avec la Feuille on va faire :
With WS
.Range('A' & Me.ComboBox1.ListIndex + 2) = ComboBox1 'On écrit dans chaque colonne les valeurs des différents controls
.Range('B' & Me.ComboBox1.ListIndex + 2) = TextBox1 'Idem
.Range('C' & Me.ComboBox1.ListIndex + 2) = TextBox2 'Idem
.Range('D' & Me.ComboBox1.ListIndex + 2) = ComboBox2 'Idem
.Range('E' & Me.ComboBox1.ListIndex + 2) = TextBox3 'Idem
.Range('F' & Me.ComboBox1.ListIndex + 2) = TextBox4 'Idem
End With
'On evoie un message de confirmation
MsgBox 'Opération accomplie', vbInformation, T

Ini 'On lance la réinitialisation du UserForm (Macro en haut du Module)

'Si Réponse Annulation on envoie un message et on a rien fait
Else: MsgBox 'Opération annulée', vbInformation, T
End If
End Sub

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'SUPPRESSION DE VALEUR DU USERFORM====================================================================
Private Sub CmdSupprimer_Click()
Dim CTRL As Control 'Variable pour la collection des controls
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

'Ici un message demandant d'accepter la suppression en les listant
Response = MsgBox('Les données de ' & vbCrLf & vbCrLf & _
' Reg : ' & vbTab & vbTab & ComboBox1 & vbCrLf & vbCrLf & _
' Appareil : ' & vbTab & TextBox1 & vbCrLf & vbCrLf & _
' Rsfta : ' & vbTab & ComboBox2 & vbCrLf & vbCrLf & _
' Recu_le : ' & vbTab & TextBox3 & vbCrLf & vbCrLf & _
' Validite : ' & vbTab & TextBox4 & vbCrLf & vbCrLf & _
' Statut : ' & vbTab & TextBox5 & vbCrLf & vbCrLf & _
'Vont être définitivement Supprimées ? ', vbCritical + vbOKCancel, T & ' Suppression de : ' & REG)

'Si Réponse OK on continue
If Response = 1 Then

'ici avec la Feuille on va faire :
With WS
.Rows(Me.ComboBox1.ListIndex + 2).EntireRow.Delete
End With
'On evoie un message de confirmation
MsgBox 'Opération accomplie', vbInformation, T
Ini 'On lance la réinitialisation du UserForm (Macro en haut du Module)

'Si Réponse Annulation on envoie un message et on a rien fait
Else: MsgBox 'Opération annulée', vbInformation, T
End If
End Sub


d'avance merci
@+
 

flo2002

XLDnaute Impliqué
Bonjour,

trés long comme code!
Personnelement et n'étant une bete en Vba, je pense que c'est dans la definition de tes variables que se pose le probleme.

Regarde ceci c'est extrait d'un fichier fait par MichelXld je crois.


Variant :
Type de données particulier pouvant contenir des données numériques, des chaînes ou des dates, des types définis par l'utilisateur ainsi que les valeurs spéciales Empty et Null.
Le type de données Variant est doté d'une taille de stockage numérique de 16 octets et peut contenir la même plage de données que le type Decimal, ou d'une taille de stockage de caractère de 22 octets (plus la longueur de la chaîne) ; dans ce dernier cas, il peut stocker tout texte.

Donc je mettrais variant au lieu de string mais autant je te dis n'importe quoi... :p
 

Discussions similaires

Réponses
6
Affichages
202

Statistiques des forums

Discussions
311 735
Messages
2 082 024
Membres
101 873
dernier inscrit
excellllll