Probleme sur le codage d'un userform
Bonjour a vous les amis je viens encore vous embêter.
pour avoir un peut moins de travail un amis ma envoyer un userform que j'ai modifié .
mais le code que j'ai a des défauts pourriez vous m'aidez a les résoudre .
et me les expliquer pour que je ne refasse pas les mêmes erreurs ?
merci d'avance voici l e fichier
Bonjour et bienvenue sur le forum
Essaie ce code mais sans garantie car sans fichier...
Private Sub CommandButton1_Click()
Set trouve = Feuil4.Cells.Find(What:=TextBox2.Text, LookAt:=xlWhole)
If trouve Then
MsgBox "Le Fournisseur est déja présent dans la base de données.", vbInformation + vbOKOnly = ""
If Not trouves Is Nothing Then
rep = MsgBox("Voulez-vous ajouter cette fiche Fournisseur ?", vbQuestion + vbYesNo, "")
If rep = vbYes Then
With Feuil4
Nlig = Feuil4.Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Nlig).Value = TextBox1
.Range("B" & Nlig).Value = TextBox2
.Range("C" & Nlig).Value = TextBox3
.Range("D" & Nlig).Value = TextBox4
.Range("E" & Nlig).Value = TextBox6
.Range("F" & Nlig).Value = TextBox6
.Range("G" & Nlig).Value = TextBox7
.Range("H" & Nlig).Value = TextBox8
.Range("I" & Nlig).Value = TextBox9
End With
Unload NOUVEAUF
MsgBox "Les modifications sont prises en compte !", vbInformation + vbOKOnly = ""
End If
'Else
End If
'Exit Sub
End If
End Sub
Bye !
Bonjour "gmb" merci de votre aide .
je vous pris de m'excuser je vous joint le fichier merci de votre aide.
roms30 a écrit :... je vous joint le fichier...
Désolé mais je ne vois rien.
Peut-être ton fichier est-il trop gros ? Alors, essaie de le compresser avec .zip ou encore, passa par www.cjoint.com
Bye !
Bonsoir
A tester
Private Sub CommandButton1_Click()
Set trouve = Feuil4.Cells.Find(What:=TextBox2.Text, LookAt:=xlWhole)
If Not trouve Is Nothing Then
MsgBox "Le Fournisseur est déja présent dans la base de données.", vbInformation + vbOKOnly
Else
If MsgBox("Voulez-vous ajouter cette fiche Fournisseur ?", vbQuestion + vbYesNo, "Nouveau") <> vbYes Then Exit Sub
With Feuil4
Nlig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & Nlig).Value = TextBox1
.Range("B" & Nlig).Value = TextBox2
.Range("C" & Nlig).Value = TextBox3
.Range("D" & Nlig).Value = TextBox4
.Range("E" & Nlig).Value = TextBox6
.Range("F" & Nlig).Value = TextBox6
.Range("G" & Nlig).Value = TextBox7
.Range("H" & Nlig).Value = TextBox8
.Range("I" & Nlig).Value = TextBox9
End With
Unload Me
MsgBox "Les modifications sont prises en compte !", vbInformation + vbOKOnly
End If
End Sub
Bonjour et merci de votre aide .
Bonzai merci beaucoup, le code fonctionne a merveille.
je suppose que mes erreurs vienne des lignes concernant les msgbox?
merci aussi gmb pour votre aide et du temps que vous m'avez tous les deux consacré.
Bonjour a vous les amis je viens encore vous embêter.
pour avoir un peut moins de travail un amis ma envoyer un userform que j'ai modifié .
mais le code que j'ai a des défauts pourriez vous m'aidez a les résoudre .
et me les expliquer pour que je ne refasse pas les mêmes erreurs ?
merci d'avance voici l e fichier
mon problème ce situe dans le code de du fomulaire FICHE_FOURNISSEURS .
merci de votre aide a tous .
bonjour gmb merci de ton aide . j'ai réussi a corriger certaine erreurs mais une persiste les donées de la feuille fournisseurs devrais s’afficher en cliquant sur c1 et remplir le formulaire mais cela ne fonctionne pas .
voici le code modifier et le fichier:
Dim modif_fich As String
Dim dernlign As Long
Dim saisie As String
Private Sub C1_Change()
Dim trouves As Range
Dim i As Integer
Application.ScreenUpdating = False
If saisie <> "yes" Then
If Me.C1.Text <> "" Then
Me.Image2.Visible = True
Me.Image3.Visible = True
Me.Image4.Visible = False
Feuil4.Activate
Set trouves = Feuil4.Cells.Find(What:=Me.C1.Text, LookAt:=xlWhole)
If Not trouves Is Nothing Then
i = trouves.Row
ligne_F = trouves.Row
'Me.C1.Text = Feuil4.Range("A" & i).Value
Me.C7.Text = Feuil4.Range("B" & i).Value
Me.T2.Text = Feuil4.Range("C" & i).Value
Me.T4.Text = Feuil4.Range("D" & i).Value
Me.T5.Text = Feuil4.Range("E" & i).Value
Me.T6.Text = Feuil4.Range("F" & i).Value
Me.T8.Text = Feuil4.Range("G" & i).Value
Me.T9.Text = Feuil4.Range("H" & i).Value
Me.T11.Text = Feuil4.Range("I" & i).Value
Me.C3.Text = Feuil4.Range("J" & i).Value
Me.C4.Text = Feuil4.Range("K" & i).Value
Me.T25.Text = Feuil4.Range("L" & i).Value
End If
End If
End If
End Sub
Private Sub C7_Change()
If saisie <> "yes" Then
Me.C1.ListIndex = Me.C7.ListIndex
saisie = "no"
End If
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub Image2_Click()
Dim rep As String
Dim dernlign_f As Integer
Application.ScreenUpdating = False
If Me.C1.Text = "" Or Me.C7.Text = "" Then
If Me.C1.Text = "" Then
Me.C1.BackColor = &HC0& 'rouge vif
Me.C1.BackStyle = fmBackStyleOpaque
End If
If Me.C7.Text = "" Then
Me.C7.BackColor = &HC0& 'rouge vif
Me.C7.BackStyle = fmBackStyleOpaque
End If
Exit Sub
Else
Me.C1.BackStyle = fmBackStyleTransparent
Me.C7.BackStyle = fmBackStyleTransparent
Me.C1.BackColor = &HFFFFFF 'blanc
Me.C7.BackColor = &HFFFFFF 'blanc
End If
rep = MsgBox("Voulez-vous ajouter cette fiche Fournisseur ?", vbQuestion + vbYesNo)
If rep = vbYes Then
Set trouves = Feuil4.Cells.Find(What:=Me.C1.Text, LookAt:=xlWhole)
If Not trouves Is Nothing Then
MsgBox "La référence " & Me.C1.Text & " existe déjà dans la base, vous pouvez modifier la fiche, mais pas en enregistrer une nouvelle !", vbExclamation + vbOKOnly
Exit Sub
End If
dernlign = Feuil4.Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row 'dernière ligne de la colonne A
If dernlign = 4 Then
dernlign_f = dernlign + 2
Else
dernlign_f = dernlign + 1
End If
Feuil4.Range("A" & dernlign_f).Value = Me.C1.Text
Feuil4.Range("B" & dernlign_f).Value = Me.C7.Text
Feuil4.Range("C" & dernlign_f).Value = Me.T2.Text
Feuil4.Range("D" & dernlign_f).Value = Me.T4.Text
Feuil4.Range("E" & dernlign_f).Value = Me.T5.Text
Feuil4.Range("F" & dernlign_f).Value = Me.T6.Text
Feuil4.Range("G" & dernlign_f).Value = Me.T8.Text
Feuil4.Range("H" & dernlign_f).Value = Me.T9.Text
Feuil4.Range("I" & dernlign_f).Value = Me.T11.Text
Feuil4.Range("J" & dernlign_f).Value = Me.C3.Text
Feuil4.Range("K" & dernlign_f).Value = Me.C4.Text
Feuil4.Range("L" & dernlign_f).Value = Me.T25.Text
If dernlign_f > 6 Then
Feuil4.Activate
Feuil4.Range(Cells(6, 2), Cells(dernlign_f, 50)).Select '50 en cas d'extension
Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Feuil14.Activate
Feuil14.Range("D20").Select
End If
modif_fich = "no"
Unload Me
FICHE_F.Show
MsgBox "La fiche est bien enregistrée !", vbInformation + vbOKOnly
End If
End Sub
Private Sub Image3_Click()
Dim rep As String
rep = MsgBox("Etes-vous sûr de vouloir supprimer cette fiche ?", vbQuestion + vbCritical + vbYesNo)
If rep = vbYes Then
Feuil4.Rows(ligne_F & ":" & ligne_F).Delete
MsgBox "La fiche est bien supprimée !", vbInformation + vbOKOnly
Unload Me
FICHE_FOURNISSEURS.Show
End If
End Sub
Private Sub Image4_Click()
Dim rep As String
rep = MsgBox("Voulez-vous enregistrer les modifications sur cette fiche ?", vbQuestion + vbYesNo)
If rep = vbYes Then
If fiche_stat = "F" Then
Feuil4.Range("A" & ligne_F).Value = Me.C1.Text
Feuil4.Range("B" & ligne_F).Value = Me.C7.Text
Feuil4.Range("C" & ligne_F).Value = Me.T2.Text
Feuil4.Range("D" & ligne_F).Value = Me.T4.Text
Feuil4.Range("E" & ligne_F).Value = Me.T5.Text
Feuil4.Range("F" & ligne_F).Value = Me.T6.Text
Feuil4.Range("G" & ligne_F).Value = Me.T8.Text
Feuil4.Range("H" & ligne_F).Value = Me.T9.Text
Feuil4.Range("I" & ligne_F).Value = Me.T11.Text
Feuil4.Range("J" & ligne_F).Value = Me.C3.Text
Feuil4.Range("K" & ligne_F).Value = Me.C4.Text
Feuil4.Range("L" & ligne_F).Value = Me.T25.Text
modif_fich = "no"
MsgBox "Les modifications sont prises en compte !", vbInformation + vbOKOnly
Exit Sub
End If
End Sub
Private Sub Image5_Click()
'BOITE DE DIALOGUE POUR LA DEMANDE D'IMPRESSION
Dim IPVM
IPVM = MsgBox("AVEZ-VOUS UNE IMPRIMANTE DE CONNECTEE ?", vbYesNo + vbDefaultButton2 + vbQuestion, " DEMANDE D'IMPPRESSION")
If IPVM = vbNo Then Exit Sub
If IPVM = vbYes Then
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
Application.ScreenUpdating = False
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
With ActiveSheet
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
.Range("A1").Activate
.PageSetup.Orientation = xlLandscape
.PageSetup.LeftMargin = Application.InchesToPoints(0)
.PageSetup.RightMargin = Application.InchesToPoints(0)
.PageSetup.TopMargin = Application.InchesToPoints(0.3)
.PageSetup.BottomMargin = Application.InchesToPoints(0)
.PageSetup.HeaderMargin = Application.InchesToPoints(0)
.PageSetup.FooterMargin = Application.InchesToPoints(0)
.PageSetup.PrintHeadings = False
.PageSetup.PrintGridlines = False
.PageSetup.PrintComments = xlPrintNoComments
.PageSetup.CenterHorizontally = False
.PageSetup.CenterVertically = False
.PageSetup.Draft = False
.PageSetup.PaperSize = xlPaperA4
.PageSetup.Order = xlDownThenOver
.PageSetup.BlackAndWhite = False
.PageSetup.Zoom = 100
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False
UserForm1.CommandButton1.SetFocus
Application.ScreenUpdating = True
End If
End Sub
Private Sub T25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
Me.T25.BorderColor = &H808080
End Sub
Private Sub C1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
saisie = "yes"
Me.C1.ForeColor = &H80FF& 'orange
Me.Image2.Visible = True
End Sub
Private Sub C3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.C3.ForeColor = &H80FF& 'orange
End Sub
Private Sub C4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.C4.ForeColor = &H80FF& 'orange
End Sub
Private Sub C7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
saisie = "yes"
Me.C7.ForeColor = &H80FF& 'orange
End Sub
Private Sub T11_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T11.ForeColor = &H80FF& 'orange
End Sub
Private Sub T2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T2.ForeColor = &H80FF& 'orange
End Sub
Private Sub T25_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T25.ForeColor = &H80FF& 'orange
End Sub
Private Sub T4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T4.ForeColor = &H80FF& 'orange
End Sub
Private Sub T5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T5.ForeColor = &H80FF& 'orange
End Sub
Private Sub T6_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T6.ForeColor = &H80FF& 'orange
End Sub
Private Sub T8_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T8.ForeColor = &H80FF& 'orange
End Sub
Private Sub T9_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
modif_fich = "yes"
Me.Image4.Visible = True
Me.T9.ForeColor = &H80FF& 'orange
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
Me.T25.BorderColor = &H404040
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim rep As String
If modif_fich = "yes" Then
Me.Image4.Visible = True
modif_fich = "no"
Image4_Click
End If
End Sub
merci les amis et désoler je suis novice mai on ma toujours dit c'est en faisant que l'on apprend .
bonne soirée.
Bonjour
roms30 a écrit :les donées de la feuille fournisseurs devrais s’afficher en cliquant sur c1 et remplir le formulaire mais cela ne fonctionne pas .
Désolé mais je ne vois dans ton fichier aucune cellue C1, sur aucune feuille, attachée à une macro…
Bye !
Bonjour, le c1 correspond a mon combobox 1 de mon userform fiche f .
bonjour gmb merci de l'aide mais les donées d e la fiche fournisseurs ne se charge pas dans le fomulaire .
je supose que j'aioublier quelque chose dans mes lignes de codes ou dans les propriétées de c1 ou c7 de mon formulaire fiche_f .
bonne soirée a vous
Bonjour
roms30 a écrit :les donées d e la fiche fournisseurs ne se charge pas dans le fomulaire .
Tiens ? C’est curieux que tout aille bien sur mon PC et pas sur le tien…
Essaie avec cette nouvelle version où j’ai fait autrement pour charger les combobox.
Bye !
bonjour gmb , merci encore de ton aide.
quand je clique sur le bouton pour développer la liste de mon combobox la liste des fournisseurs présent sur la fiche fournisseurs n' apparaissent pas .
cela ne viendrais pas du fait que ma version office soit en 32 bit ??
bonne soirée.
roms30 a écrit :cela ne viendrais pas du fait que ma version office soit en 32 bit ??
Je ne sais pas mais cela doit venir de ton PC....
Désolé !
Bye!
Merci de ton aide gmb .
je vais essayer sur un autre pc.