Probleme sur le codage d'un userform

Le 13/11/2015 à 20:14

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

Le 13/11/2015 à 20:24

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 !

Le 13/11/2015 à 20:56

Bonjour "gmb" merci de votre aide .

je vous pris de m'excuser je vous joint le fichier merci de votre aide.

Le 13/11/2015 à 22:28

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 !

Le 13/11/2015 à 22:41

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

Le 14/11/2015 à 08:54

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é.

Le 15/11/2015 à 16:29

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

Le 15/11/2015 à 19:40

Un essai à tester. Te convient-il ?

Bye !

17suivi-des-demandes-v1.xlsm (144.53 Ko)

Le 15/11/2015 à 20:40

mon problème ce situe dans le code de du fomulaire FICHE_FOURNISSEURS .

merci de votre aide a tous .

Le 16/11/2015 à 20:08

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

8suivi-des-demandes-v2.xlsm (146.64 Ko)

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.

Le 17/11/2015 à 07:42

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 !

Le 17/11/2015 à 16:38

Bonjour, le c1 correspond a mon combobox 1 de mon userform fiche f .

Le 17/11/2015 à 18:08

Voilà :

20suivi-des-demandes-v3.xlsm (146.08 Ko)

Bye !

Le 18/11/2015 à 19:37

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

Le 19/11/2015 à 07:55

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 !

24suivi-des-demandes-v4.xlsm (148.80 Ko)

Le 19/11/2015 à 19:01

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.

Le 19/11/2015 à 22:07

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!

Le 21/11/2015 à 12:09

Merci de ton aide gmb .

je vais essayer sur un autre pc.

Rechercher des sujets similaires à "probleme codage userform"