Checkbox relance l userform vierge aprés validation

Bonjour

J'aimerai ajouter une checkbox dans mon Userform qui si coché Valide l"action si dessous mais relance l'userform vide

Actuelemnt je saisie les information je valide et l userform se ferme parfait pour une sasise mais en cas de 20 saisie consécutive

J'aimerai cocher cet checkbox pour eviter de repasser par le bouton de la feuille

Private Sub CommandButton2_Click() 'bouton valider envoi les information vers la feuille EN SERVICE
Dim sel As Range
    Set sel = Sheets("En service").Cells.Find(Me.TextBox1.Value, , xlValues, xlWhole) 'recherhce dans la feuille la valeur renseigné dans la textbox
    If sel Is Nothing Then
        MsgBox "Recherche absente"          'message si pas de resultat
    Else
        Sheets("En service").Activate       'ouvre la feuille concernée
        sel.Activate                        'active la cellule concernée
        sel.Offset(0, 3) = ActiveWorkbook.Sheets("ACCUEIL").Range("Vérificateur").Text 'met a jour le verificateur
        sel.Offset(0, 4).Select             'selectione la case date du matricule recherché
        sel.Offset(0, 4) = DateValue(Date)  'inscrit la date actuelle
        sel.Offset(0, 6).Select             'selectione la case date du prochain ctrl
        sel.Offset(0, 6) = TextBox4.Value   'inscrit la date du prochain ctrl
        sel.Offset(0, 11) = TextBox9.Value  'copie le lieux de stockkage (en cas de changement)
        sel.Offset(0, 12) = TextBox10.Value 'copie le l appartenance (en cas de changement)
        sel.Offset(0, 13) = TextBox11.Value 'copie le commentaire (en cas de changement)
        Sheets("Accueil").Activate          'ouvre la feuille Accueuil pour actualiser
        Sheets("En service").Activate       'revien sur la feuille avec valeur actualisees

    Dim dLig As Long, nCol As Long
  With Sheets("Connexions")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    nCol = .Cells(dLig, Columns.Count).End(xlToLeft).Column + 1
    With .Cells(dLig, nCol)
      .Value = TextBox1.Value
      .Interior.ColorIndex = 4
    End With
               End If
 Unload Me
End Sub

Merci

Bonsoir,

un code un peu comme celui-ci :

If CheckBox Then
    Call InitUSF
Else
    Unload Me
EndIf

Mais il vous faudra créer un code ou une procédure d'initialisation du USF.

@ bientôt

LouReeD

Merci pour votre réponse

Mais il vous faudra créer un code ou une procédure d'initialisation du USF.

je ne comprend pas ce que ca veut dire désolé je suis très novice

j insère votre code avant le Unload Me?

j'aimerai mettre cet case sur plusieurs userform de mon fichier

Je cherche une fonction qui remplace le UnloadMe par initialyse dans le code si checkbox coché au moment de valider mais dans les deux cas la procédure valider doit s'efffectuer

Bonjour,

1- vous insérez ce code dans un module de votre classeur :

Option Explicit

Dim nom_formulaire As String

Sub réafficher_formulaire()

    If UserForms.Count > 0 Then
        nom_formulaire = UserForms(UserForms.Count - 1).Name
        Application.OnTime Now + TimeValue("00:00:01"), "réaffichage_formulaire"
    End If

End Sub

Sub réaffichage_formulaire()
    UserForms.Add(nom_formulaire).Show
End Sub

2- vous modifiez votre code comme suit

Private Sub CommandButton2_Click() 'bouton valider envoi les information vers la feuille EN SERVICE
    Dim sel As Range

    Set sel = Sheets("En service").Cells.Find(Me.TextBox1.Value, , xlValues, xlWhole) 'recherhce dans la feuille la valeur renseigné dans la textbox
    If sel Is Nothing Then
        MsgBox "Recherche absente"          'message si pas de resultat
    Else
        Sheets("En service").Activate       'ouvre la feuille concernée
        sel.Activate                        'active la cellule concernée
        sel.Offset(0, 3) = ActiveWorkbook.Sheets("ACCUEIL").Range("Vérificateur").Text 'met a jour le verificateur
        sel.Offset(0, 4).Select             'selectione la case date du matricule recherché
        sel.Offset(0, 4) = DateValue(Date)  'inscrit la date actuelle
        sel.Offset(0, 6).Select             'selectione la case date du prochain ctrl
        sel.Offset(0, 6) = TextBox4.Value   'inscrit la date du prochain ctrl
        sel.Offset(0, 11) = TextBox9.Value  'copie le lieux de stockkage (en cas de changement)
        sel.Offset(0, 12) = TextBox10.Value 'copie le l appartenance (en cas de changement)
        sel.Offset(0, 13) = TextBox11.Value 'copie le commentaire (en cas de changement)
        Sheets("Accueil").Activate          'ouvre la feuille Accueuil pour actualiser
        Sheets("En service").Activate       'revien sur la feuille avec valeur actualisees

        Dim dLig As Long, nCol As Long
        With Sheets("Connexions")
            dLig = .Range("A" & Rows.Count).End(xlUp).Row
            nCol = .Cells(dLig, Columns.Count).End(xlToLeft).Column + 1
            With .Cells(dLig, nCol)
              .Value = TextBox1.Value
              .Interior.ColorIndex = 4
            End With
        End With

    End If

    If CheckBox1 Then réafficher_formulaire
    Unload Me
End Sub

Super merci pour ce super boulot

Si je veux l appliquer a un autre userform je rajoute cet partie dedans

If CheckBox1 Then réafficher_formulaire

et dans le module rien a modifier?

Si je veux l appliquer a un autre userform je rajoute cet partie dedans

If CheckBox1 Then réafficher_formulaire

et dans le module rien a modifier?

Absolument, sans rien modifier dans le module, valable pour n'importe quel UserForm.

super ca fonctionne merci

j ai un bug qui me ramene a un userform.show du module

uniquement un seul userform les autres fonctionnent correctement ca ne peut etre lié ?

Si vous avez un bug, essayer alors cette version :

module

Option Explicit

Dim nom_formulaire As String

Sub réafficher_formulaire(nom As String)

    nom_formulaire = nom
    Application.OnTime Now + TimeValue("00:00:01"), "réaffichage_formulaire"

End Sub

Sub réaffichage_formulaire()
    UserForms.Add(nom_formulaire).Show
End Sub

votre code

'.............................

    If CheckBox1 Then réafficher_formulaire Me.Name
    Unload Me

End Sub

ce code fonctionne bien aussi, mais j ai toujours le bug

Je pense que cela vient du userform initialise

qui est dans mon code de l' userform qui bug

est il possible de prendre en compte l initialisation ?

Je pense que cela vient du userform initialise

qui est dans mon code de l' userform qui bug

Dans ce cas, communiquez le code associé sinon impossible de vous aider.

C est bien ca j ai désactivé le userform_initialise ca fonctionne

Voici le code mais je risque d avoir le meme problème dé lors je devrais insérer un initialize pour un autre userform

End Sub

Private Sub CommandButton3_Click() 'boutton generer un code unique

Dim aA, aOut, ptr

     aA = Range("T_Bleu").Columns(1).Value2

     ReDim aOut(1 To 24)

     For i = 1 To 10000                      'exagéré !!!

          s = ""

          For j = 1 To 4 + (ptr \ 6)

               If ptr < 12 Or j <= 4 Then

                    X = WorksheetFunction.RandBetween(48, 57)

               Else

                    X = WorksheetFunction.RandBetween(65, 90)

               End If

               s = Chr(X) & s

          Next

          r = Application.Match(s, aA, 0)    'ne pas dans T_bleu

          If Not IsNumeric(r) Then

               r = Application.Match(s, aOut, 0)     'ne pas dans aOut

               If Not IsNumeric(r) Then

                    ptr = ptr + 1

                    aOut(ptr) = s

                    If ptr Mod 6 = 5 Then ptr = ptr + 1

               End If

          End If

          If ptr >= UBound(aOut) Then Exit For

     Next

     MsgBox Join(aOut, vbLf), vbInformation, "20 codes possible"

End Sub

Private Sub UserForm_Initialize() 'prérempli les textbox a l'ouverture

End Sub

Dim i As Byte

Dim dlg As Integer

With Me

    .TextBox3.Value = DateValue(Date)                                 'Date du jour

    .TextBox4.Value = DateAdd("D", 365, CDate(Me.TextBox3.Text))      'Date de validité date textbox3 +12 mois

End With

With ThisWorkbook

    Me.TextBox2.Value = .Sheets("ACCUEIL").Range("Vérificateur").Text 'Nom de l utilisateur cellule vérificateur sur "acceuil"

    For i = 1 To 6                                                    'Nombre d 'element pris en compte (textbox,listboxcombo....)

        With .Sheets("Création-Supression")

            dlg = .Cells(Rows.Count, i + 1).End(xlUp).Row

            Me.Controls("ComboBox" & i).List = .Range(.Cells(3, i + 1), .Cells(dlg, i + 1)).Value

        End With

    Next i

End With

With Me 'gere les messages infobulle

  ComboBox1.ControlTipText = "Si Dénomination non présente il faut l'ajouter au lexique"      'Dénomination

  ComboBox2.ControlTipText = "Si CMU non présente il faut l'ajouter au lexique"               'CMU

  ComboBox3.ControlTipText = "Si Longueur non présent il faut l'ajouter au lexique"           'Longueur

  ComboBox4.ControlTipText = "Si Diamétre non présent il faut l'ajouter au lexique"           'Diamétre

  ComboBox5.ControlTipText = "Si Lieu de stockage non présent il faut l'ajouter au lexique"   'Lieu dde stockage

  ComboBox6.ControlTipText = "Si Appartenance non présent il faut l'ajouter au lexique"       'Appartenance

  End With

'End Sub

Private Sub ComboBox1_Change() 'charge la photo liéa la selection combobox

Dim chemin As String, fichier As String  '*******************ajouter image not found si pas d image*************

chemin = "E:\LAM_TPM_FI\NEW RAPPORT FI\Accessoires_de_levage\Base de données\" 'chemin ou se trouve le dossier photo

fichier = ComboBox1.Value

If fichier <> vbNullString Then

    Me.Image1.Picture = LoadPicture(chemin & fichier & ".jpg")

    Me.Image1.PictureSizeMode = 3 'dimentionne l image a l objet image1

End If

End Sub

Je ne vois rien de particulier si ce n'est un End Sub mal placé.

Private Sub UserForm_Initialize() 'prérempli les textbox a l'ouverture

End Sub

Dim i As Byte

C'est quoi votre Bug ?

c est un bug de copie desole voila le codde

Private Sub CommandButton1_Click() 'bouton quitter
Unload Me
End
End Sub

Private Sub CommandButton2_Click() 'bouton valider

Dim obj As Object 'empeche la saisie d'un matricule en doublon
Dim FL1 As Worksheet
Dim DerniereLigneUtilisee As Long
DerniereLigneUtilisee = Sheets("En service").Range("A" & Rows.Count).End(xlUp).Row + 1  'adapter colonne
    Set FL1 = Worksheets("En service") 'adapter feuille
With FL1
  Set obj = Sheets("En service").Columns("A").Find(TextBox1.Text, , , xlWhole) 'adapter colonne
If Not obj Is Nothing Then MsgBox "Matricule non renseigné ou déjà existant!", vbCritical, "Création impossible": Exit Sub 'message en cas de doublon
 'Sheets("En service").Range("A" & DerniereLigneUtilisee).Value = TextBox1.Text ' ajout d'article
End With

  Sheets("En service").Range("A3").ListObject.ListRows.Add (1) 'ajoute une ligne et fait descendre pour laisser place a la nouvelle dans tableau "en service"
  [T_Bleu].Item(1, 1) = Me.TextBox1.Value               'Range dans T_Bleu le matricule
   [T_Bleu].Item(1, 2) = Me.TextBox2.Value              '""nom du créateur
    [T_Bleu].Item(1, 3) = CDate(Me.TextBox3.Value)      '""la date du jour ou l outil est créé
     [T_Bleu].Item(1, 4) = Me.TextBox2.Value            '""nom du vérificateur
      [T_Bleu].Item(1, 5) = CDate(Me.TextBox3.Value)    '"date du jour de la vérification
      '[T_Bleu].Item(1, 5) = position 6 reservé au calcul de nombre de jours restants
        [T_Bleu].Item(1, 7) = CDate(Me.TextBox4.Value)  '"date de la prochaine vérification (+1an de la date du jour)
         [T_Bleu].Item(1, 8) = Me.ComboBox1.Value       '"dénomination
          [T_Bleu].Item(1, 9) = Me.ComboBox2.Value      '"CMU
           [T_Bleu].Item(1, 10) = Me.ComboBox3.Value    '" longueur
            [T_Bleu].Item(1, 11) = Me.ComboBox4.Value   '" diamètre
             [T_Bleu].Item(1, 12) = Me.ComboBox5.Value  '" lieu de stockage
              [T_Bleu].Item(1, 13) = Me.ComboBox6.Value '" Appartenance
               [T_Bleu].Item(1, 14) = Me.TextBox5.Value '" commentaire

     Dim dLig As Long, nCol As Long
  With Sheets("Connexions")
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    nCol = .Cells(dLig, Columns.Count).End(xlToLeft).Column + 1
    With .Cells(dLig, nCol)
      .Value = TextBox1.Value
      .Interior.ColorIndex = 5
    End With
  End With
   If CheckBox1 Then réafficher_formulaire Me.Name 'case a cocher pour empecher le unload me
    Unload Me 'a laisser ici sous checkbox1 (lié)

    'ThisWorkbook.Save *(a dévérouillé) la sauvegarde des donees dans le classeur

 MsgBox "Vos données ont bien été prises en compte ", vbInformation, strValidationapp 'message a la fermeture de l userform
End Sub

Private Sub CommandButton3_Click() 'boutton generer un code unique
Dim aA, aOut, ptr
     aA = Range("T_Bleu").Columns(1).Value2
     ReDim aOut(1 To 24)
     For i = 1 To 10000                      'exagéré !!!
          s = ""
          For j = 1 To 4 + (ptr \ 6)
               If ptr < 12 Or j <= 4 Then
                    X = WorksheetFunction.RandBetween(48, 57)
               Else
                    X = WorksheetFunction.RandBetween(65, 90)
               End If
               s = Chr(X) & s
          Next
          r = Application.Match(s, aA, 0)    'ne pas dans T_bleu
          If Not IsNumeric(r) Then
               r = Application.Match(s, aOut, 0)     'ne pas dans aOut
               If Not IsNumeric(r) Then
                    ptr = ptr + 1
                    aOut(ptr) = s
                    If ptr Mod 6 = 5 Then ptr = ptr + 1
               End If
          End If
          If ptr >= UBound(aOut) Then Exit For
     Next
     MsgBox Join(aOut, vbLf), vbInformation, "20 codes possible"
End Sub

Private Sub UserForm_initialize() 'prérempli les textbox a l'ouverture

 Dim i As Byte
Dim dlg As Integer

With Me
    .TextBox3.Value = DateValue(Date)                                 'Date du jour
    .TextBox4.Value = DateAdd("D", 365, CDate(Me.TextBox3.Text))      'Date de validité date textbox3 +12 mois
End With

With ThisWorkbook
    Me.TextBox2.Value = .Sheets("ACCUEIL").Range("Vérificateur").Text 'Nom de l utilisateur cellule vérificateur sur "acceuil"
    For i = 1 To 6                                                    'Nombre d 'element pris en compte (textbox,listboxcombo....)
        With .Sheets("Création-Supression")
            dlg = .Cells(Rows.Count, i + 1).End(xlUp).Row
            Me.Controls("ComboBox" & i).List = .Range(.Cells(3, i + 1), .Cells(dlg, i + 1)).Value
        End With
    Next i
End With
With Me 'gere les messages infobulle
  ComboBox1.ControlTipText = "Si Dénomination non présente il faut l'ajouter au lexique"      'Dénomination
  ComboBox2.ControlTipText = "Si CMU non présente il faut l'ajouter au lexique"               'CMU
  ComboBox3.ControlTipText = "Si Longueur non présent il faut l'ajouter au lexique"           'Longueur
  ComboBox4.ControlTipText = "Si Diamétre non présent il faut l'ajouter au lexique"           'Diamétre
  ComboBox5.ControlTipText = "Si Lieu de stockage non présent il faut l'ajouter au lexique"   'Lieu dde stockage
  ComboBox6.ControlTipText = "Si Appartenance non présent il faut l'ajouter au lexique"       'Appartenance
  End With

End Sub
Private Sub ComboBox1_Change() 'charge la photo liéa la selection combobox
Dim chemin As String, fichier As String  '*******************ajouter image not found si pas d image*************

chemin = "C:\Users\Constan\Desktop\PHOTO OUTIL\" 'votre répertoire photo à adapter MAISON
'chemin = "E:\LAM_TPM_FI\NEW RAPPORT FI\Accessoires_de_levage\Base de données\" 'chemin ou se trouve le dossier photo USINE

fichier = ComboBox1.Value
On Error Resume Next 'Evite de planter si pas d'image lié a la dénomination
If fichier <> vbNullString Then
    Me.Image1.Picture = LoadPicture(chemin & fichier & ".jpg")
    Me.Image1.PictureSizeMode = 3 'dimentionne l image a l objet image1
End If
End Sub

Sur cet userform j'ai un code initialise

qui pré-rempli le formulaire avec les donnée de la feuille

je pense que la modif qu on a apporté géne sont utilisation suite a la parite initialise

lorsque je lance le seul userform qui a un initialize

Apparemment, votre problème est ici

With ThisWorkbook
    Me.TextBox2.Value = .Sheets("ACCUEIL").Range("Vérificateur").Text 'Nom de l utilisateur cellule vérificateur sur "acceuil"
    For i = 1 To 6                                                    'Nombre d 'element pris en compte (textbox,listboxcombo....)
        With .Sheets("Création-Supression")
            dlg = .Cells(Rows.Count, i + 1).End(xlUp).Row
            Me.Controls("ComboBox" & i).List = .Range(.Cells(3, i + 1), .Cells(dlg, i + 1)).Value
        End With
    Next i
End With

mais je pense qu'il n'a aucun lien avec le rechargement du formulaire.