Vider userform si référence inconnue

Le 16/01/2023 à 19:48

Bonjour, j'ai un userform (formulaire lié à une BDD) dans lequel j'ai une combobox (Référence) de saisie intuitive dont découle le remplissage des textbox du formulaire. Lorsque je tape les premières lettres le formulaire commence à se remplir mais lorsque je saisi une nouvelle référence il se rempli également avec les premières lettres et je souhaiterai que si la référence n'existe pas les textbox se mettent à "vide". J'ai bricolé ce code VBA en allant sur internet, il marche bien mais j'aimerais le peaufiner. Merci à vous pour vos conseils. Cordialement, Stéphane

Le 16/01/2023 à 19:50

Je ne sais pas comment joindre un fichier alors le vous envoie le code. Merci de votre compréhension. Je vais chercher comment faire pour joindre le fichier.

Function copy_from_form()
Dim LastRow As Long
ActiveSheet.Unprotect
LastRow = ActiveWorkbook.Sheets("BDD").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("BDD")
.Range("A" & LastRow).Value = ComboBox3.Value
.Range("B" & LastRow).Value = TextBox2.Value
.Range("C" & LastRow).Value = ComboBox1.Value
.Range("D" & LastRow).Value = ComboBox2.Value
.Range("E" & LastRow).Value = TextBox5.Value
.Range("F" & LastRow).Value = TextBox6.Value
.Range("G" & LastRow).Value = TextBox7.Value
.Range("H" & LastRow).Value = TextBox8.Value
.Range("I" & LastRow).Value = TextBox9.Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End With
End Function

Function reset_all_controls()
Dim ctl As MSForms.Control
ActiveSheet.Unprotect
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Select
Next ctl
End Function

Function delete_from_form_with_confirmation()
Dim answer As Integer
ActiveSheet.Unprotect
answer = MsgBox("Voulez-vous supprimer cette référence de la base de données ?", vbQuestion + vbYesNo + vbDefaultButton2, "Confirmation")
If answer = vbYes Then
Dim rng1 As Range
Dim str_search As String
str_search = ComboBox3.Value
ActiveWorkbook.Sheets("BDD").Activate
Set rng1 = Sheets("BDD").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("BDD").Rows(row_number).EntireRow.Delete
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Else
End If
End If
End Function

Function search_from_form()
Dim rng1 As Range
Dim str_search As String
ActiveSheet.Unprotect
str_search = ComboBox3.Value
ActiveWorkbook.Sheets("BDD").Activate
Set rng1 = Sheets("BDD").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ComboBox3.Value = Sheets("BDD").Range("A" & row_number).Value
TextBox2.Value = Sheets("BDD").Range("B" & row_number).Value
ComboBox1.Value = Sheets("BDD").Range("C" & row_number).Value
ComboBox2.Value = Sheets("BDD").Range("D" & row_number).Value
TextBox5.Value = Sheets("BDD").Range("E" & row_number).Value
TextBox6.Value = Sheets("BDD").Range("F" & row_number).Value
TextBox7.Value = Sheets("BDD").Range("G" & row_number).Value
TextBox8.Value = Sheets("BDD").Range("H" & row_number).Value
TextBox9.Value = Sheets("BDD").Range("I" & row_number).Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Else
'MsgBox "Cette référencen'existe pas"
End If
End Function

Function edit_from_form()
Dim rng1 As Range
Dim str_search As String
ActiveSheet.Unprotect
str_search = ComboBox3.Value
ActiveWorkbook.Sheets("BDD").Activate
Set rng1 = Sheets("BDD").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
With ActiveWorkbook.Sheets("BDD")
.Range("A" & row_number).Value = ComboBox3.Value
.Range("B" & row_number).Value = TextBox2.Value
.Range("C" & row_number).Value = ComboBox1.Value
.Range("D" & row_number).Value = ComboBox2.Value
.Range("E" & row_number).Value = TextBox5.Value
.Range("F" & row_number).Value = TextBox6.Value
.Range("G" & row_number).Value = TextBox7.Value
.Range("H" & row_number).Value = TextBox8.Value
.Range("I" & row_number).Value = TextBox9.Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
ActiveSheet.Unprotect
    Range("TBDD[[#Headers],[Référence]]").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Range("J20:L20").Select
    Selection.AutoFill Destination:=Range("TBDD[[A distribuer]:[NB POINTS]]"), _
        Type:=xlFillDefault
    Range("TBDD[[A distribuer]:[NB POINTS]]").Select
    Range("A4").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End With
Else
'MsgBox str_search & "Not Found"
End If
End Function

Function items_from_database_to_combobox()
Sheets("BDD").Activate
Dim LastRow As Long
ActiveSheet.Unprotect
LastRow = Cells(Rows.Count, "I").End(xlUp).Row
ComboBox1.List = Range("I2:I" & LastRow).Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Function

Function items_from_database_to_combobox1()
Sheets("BDD").Activate
Dim LastRow As Long
ActiveSheet.Unprotect
LastRow = Cells(Rows.Count, "H").End(xlUp).Row
ComboBox2.List = Range("H2:H" & LastRow).Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Function

Function items_from_database_to_combobox3()
Sheets("BDD").Activate
Dim LastRow As Long
ActiveSheet.Unprotect
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
ComboBox3.List = Range("A20:A" & LastRow).Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Function

Private Sub CommandButton1_Click()
Call copy_from_form
Call reset_all_controls
End Sub

Private Sub CommandButton2_Click()
Call edit_from_form
Call reset_all_controls
End Sub

Private Sub CommandButton3_Click()
Call reset_all_controls
End Sub

Private Sub CommandButton4_Click()
Call delete_from_form_with_confirmation
Call reset_all_controls
End Sub

Private Sub CommandButton6_Click()
    Unload Me
End Sub

'Private Sub CommandButton5_Click()
'Call search_from_form
'End Sub

Private Sub ComboBox3_Change()
Call search_from_form
End Sub

Private Sub CommandButton7_Click()
'
' essai Macro
'

'
    Sheets("ACCOMPAGNEMENT").Select
    ActiveSheet.Unprotect ""
    Sheets("COMPLEMENT").Select
    ActiveSheet.Unprotect ""
    Sheets("DESSERT").Select
    ActiveSheet.Unprotect ""
    Sheets("HYGIENE").Select
    ActiveSheet.Unprotect ""
    Sheets("LAITAGE").Select
    ActiveSheet.Unprotect ""
    Sheets("MIXTE").Select
    ActiveSheet.Unprotect ""
    Sheets("PROTEINE").Select
    ActiveSheet.Unprotect ""
    Sheets("Récap").Select
    ActiveSheet.Unprotect ""
    Sheets("LAIT").Select
    ActiveSheet.Unprotect ""
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("A distribuer" _
        ).CurrentPage = "(All)"
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "A distribuer")
        .PivotItems("0").Visible = False
    End With
    Sheets("ACCOMPAGNEMENT").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("COMPLEMENT").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("DESSERT").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("HYGIENE").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("LAITAGE").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("MIXTE").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("PROTEINE").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("Récap").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("LAIT").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Range("H13").Select
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub

Private Sub UserForm_Initialize()
Me.ComboBox3.SetFocus
Call items_from_database_to_combobox3
Call items_from_database_to_combobox1
Call items_from_database_to_combobox
End Sub

Le 16/01/2023 à 20:39

Re...Voici le fichier. Merci

13fichier1.xlsm (71.36 Ko)

Le 16/01/2023 à 23:13

Bonjour Legreffier

Je serais toujours intrigué par les gens comme vous qui savez remplir des contrôles mais pas les vider

Function search_from_form()
  Dim rng1 As Range
  Dim str_search As String
  ActiveSheet.Unprotect
  str_search = ComboBox3.Value
  ActiveWorkbook.Sheets("BDD").Activate
  Set rng1 = Sheets("BDD").Range("A:A").Find(str_search, , xlValues, xlWhole)
  If Not rng1 Is Nothing Then
    rng1.Select
    Dim row_number As Long
    row_number = ActiveCell.Row
    ComboBox3.Value = Sheets("BDD").Range("A" & row_number).Value
    TextBox2.Value = Sheets("BDD").Range("B" & row_number).Value
    ComboBox1.Value = Sheets("BDD").Range("C" & row_number).Value
    ComboBox2.Value = Sheets("BDD").Range("D" & row_number).Value
    TextBox5.Value = Sheets("BDD").Range("E" & row_number).Value
    TextBox6.Value = Sheets("BDD").Range("F" & row_number).Value
    TextBox7.Value = Sheets("BDD").Range("G" & row_number).Value
    TextBox8.Value = Sheets("BDD").Range("H" & row_number).Value
    TextBox9.Value = Sheets("BDD").Range("I" & row_number).Value
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
      , AllowFiltering:=True
  Else
    TextBox2.Value = ""
    ComboBox1.Value = ""
    ComboBox2.Value = ""
    TextBox5.Value = ""
    TextBox6.Value = ""
    TextBox7.Value = ""
    TextBox8.Value = ""
    TextBox9.Value = ""
    'MsgBox "Cette référencen'existe pas"
  End If
End Function

Bref, voilà

Le 17/01/2023 à 09:56

Bonjour BrunoM45, merci beaucoup, ça fonctionne du tonnerre ! Si ça peut vous rassurer ça m'intrigue aussi - Je n'ai aucune culture en VBA, je me borne à essayer de recopier et trafiquer les codes des tutos sur les blogs mais je ne comprends pas grand chose à ce que j'écris. Pour le coup, c'est vrai que là j'aurais pu creuser encore un peu... Merci à vous et bonne journée

Rechercher des sujets similaires à "vider userform reference inconnue"