Pointer sur la ligne ajouter

Le 22/02/2023 à 14:24

Bonjour à toutes et tous.

Je sèche sur quelque chose de sûrement simple, mais je sèche...

J'ai un userform pour modifier des références ou en créer de nouvelles dans un tableau Excel. Lorsque je tape une référence existante dans mon userform, excel va directement à la ligne et pointe sur la cellule de la première colonne, ce qui permet de voir les modifications en temps réel, c'est pratique.

Mais lorsque je crée une référence et que je valide par le bouton "Nvelle Réf.", Excel ne va pas directement à la ligne dans le tableau, il pointe la cellule tout en haut à gauche. Je n'arrive pas à le faire pointer sur la ligne que je viens d'ajouter.

Je vous mets les lignes de codes correspondantes.

Code bouton "Nvelle Réf." :

Private Sub CommandButton1_Click()
Call copy_from_form
Call reset_all_controls
Call Macro1
CommandButton1.Visible = False
End Sub

Code "copy_from_from"

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("A17").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, "S").End(xlUp).Row
ComboBox1.List = Range("S2:S" & lastROw).Value
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Function

Code "reset_all_controls"

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

Code ""macro1"

Sub Macro1()
'
' Macro1 Macro
'

'
    Application.Goto Reference:="TBDD"
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-11
    ActiveSheet.Unprotect
    ActiveWorkbook.Worksheets("BDD").ListObjects("TBDD").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BDD").ListObjects("TBDD").Sort.SortFields.Add2 Key _
        :=Range("TBDD[Désignation]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("BDD").ListObjects("TBDD").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A21").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

Merci pour votre aide.

legreffier

Le 22/02/2023 à 16:03

Bonjour,

Heu vous parlez d'un code Copy From Form et vous mettez le code Edit_From_form

Voici ce que vous pouvez modifier.

- Remplacez le code Copy From Form par celui ci-dessous

Private Sub copy_from_form()
Dim lig As Integer

With ThisWorkbook.Worksheets("BDD")
    .Unprotect
    With .ListObjects("TBDD")
      If .ListRows.Count = 0 Then
          .ListRows.Add: lig = 1
      Else: .ListRows.Add: lig = .ListRows.Count
      End If
        With .DataBodyRange
          .Item(lig, 1) = ComboBox3.Value
          .Item(lig, 1).Select
          .Item(lig, 2) = TextBox2.Value
          .Item(lig, 3) = ComboBox1.Value
          .Item(lig, 4) = ComboBox2.Value
          .Item(lig, 5) = TextBox5.Value
          .Item(lig, 6) = TextBox6.Value
          .Item(lig, 7) = TextBox7.Value
          .Item(lig, 8) = TextBox8.Value
          .Item(lig, 9) = TextBox9.Value
        End With
    End With
    .Protect
End With
End sub

Le code sélectionnera la cellule de la première colonne.
Lors du test, pensez à désactivez l'instruction la ligne Call Macro 1 pour éviter le tri.

Dites moi déjà si ok comme cela

Edit : modifié deux lignes de code (lignes Protect et Textbox9)

Le 22/02/2023 à 21:23

Bonsoir Dan,

Ça marche du tonnerre, merci beaucoup. Je vous donne l'ancien code (le bon) au cas où pour être sûr que le nouveau code remplace bien tout. Mais c'est nickel. Merci beaucoup.

legreffier

'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
Le 23/02/2023 à 09:10

Bonjour

Je vous donne l'ancien code (le bon) au cas où pour être sûr que le nouveau code remplace bien tout

Oui j'avais vu. J'ai repris le fichier que vous aviez sur un autre fil pour comprendre votre demande et modifier le code.
Si comme je vous l'ai dit, vous voulez ajouter le tri, prenez le code ci-dessous

Private Sub copy_from_form()
Dim lig As Integer

With ThisWorkbook.Worksheets("BDD")
    .Unprotect
    With .ListObjects("TBDD")
      If .ListRows.Count = 0 Then
          .ListRows.Add: lig = 1
      Else: .ListRows.Add: lig = .ListRows.Count
      End If
        With .DataBodyRange
          .Item(lig, 1) = ComboBox3.Value
          '.Item(lig, 1).Select
          .Item(lig, 2) = TextBox2.Value
          .Item(lig, 3) = ComboBox1.Value
          .Item(lig, 4) = ComboBox2.Value
          .Item(lig, 5) = TextBox5.Value
          .Item(lig, 6) = TextBox6.Value
          .Item(lig, 7) = TextBox7.Value
          .Item(lig, 8) = TextBox8.Value
          .Item(lig, 8) = TextBox9.Value

        End With
        'tri
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("TBDD[Désignation]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        lig = WorksheetFunction.Match(ComboBox3.Value, .ListColumns(1).DataBodyRange, 0)
        .DataBodyRange.Item(lig, 1).Select
    End With
End With
ThisWorkbook.Worksheets("BDD").Protect
end sub

Ce code inclut le tri.

ensuite votre code "Nouvelle ref" comme ceci

Private Sub CommandButton1_Click()
Call copy_from_form
Call reset_all_controls
CommandButton1.Visible = False
End Sub

NB : dans votre cas, vous ne devez pas utiliser les Call avec des codes FUNCTION. Remplacez les FUNCTION par Private Sub ....

Cordialement

Le 25/02/2023 à 16:41

Nickel ! Merci beaucoup

Rechercher des sujets similaires à "pointer ligne ajouter"