Microsoft 365 Problème de dernière ligne dans un tableau

yassine.013 · 20 Décembre 2022

Bonjour à tous

Je suis en alternance dans une entreprise de production des pièces d’avion en effet j'ai une base de donnée que j'ai mis dans un tableau et que j'incrémente avec un Userforme standard pour la remplire.

Et j’ai 3 feuilles la première « Formulaire de la faf » il y’a un bouton ça s’appelle Nouvelle faf en cliquant dessus ça s’affiche le formulaire en le remplissant ils renvoient au tableau de la deuxième feuille « Validation ». Dans cette dernière y’a un bouton Valider il copie la dernière ligne et la colle dans la dernière ligne du tableau dans la troisième feuille « source ».

J’ai deux soucis le premier est dans le bouton de commande « Ajouter dans une base » qui se trouve dans le formulaire nouveau Faf

Quand je clique dessus la ligne s’ajoute n’importe où sur le tableau alors que je veux ligne en dessous d’une ligne ou quand je remplis à nouveau le formulaire la nouvelle ligne écrase l’ancienne ligne

Le deuxième souci est dans la feuille validation dans le bouton valider Je souhaite récupérer à chaque fois la dernière ligne du tableau copier ses valeurs et les coller dans le tableau à sa dernière ligne de feuille source.

vgendron · 20 Décembre 2022

Hello

essaie ce code en lieu et place de l'existant

VB:

'Bouton d'ajouter à la base '
Private Sub ab_Click()
On Error Resume Next
Dim ligne As Integer
With Sheets("Validation")
    .Activate 'pas obligatoire
    ligne = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    Set cellule = .Range("A" & ligne)
    cellule.Value = TextBox1.Value
    cellule.Offset(0, 1).Value = TextBox2
    cellule.Offset(0, 2).Value = TextBox3
    cellule.Offset(0, 3).Value = TextBox4
    cellule.Offset(0, 4).Value = TextBox5
    cellule.Offset(0, 5).Value = TextBox6
    cellule.Offset(0, 6).Value = TextBox7
    cellule.Offset(0, 7).Value = ComboBox1
    cellule.Offset(0, 8).Value = TextBox8
    cellule.Offset(0, 9).Value = TextBox9
    cellule.Offset(0, 10).Value = TextBox10
    cellule.Offset(0, 11).Value = TextBox11
    cellule.Offset(0, 12).Value = TextBox12
    cellule.Offset(0, 13).Value = TextBox13
    cellule.Offset(0, 14).Value = TextBox14
    cellule.Offset(0, 15).Value = TextBox15
    cellule.Offset(0, 16).Value = TextBox16
    cellule.Offset(0, 17).Value = TextBox17
    cellule.Offset(0, 18).Value = TextBox18
    cellule.Offset(0, 19).Value = TextBox19
    cellule.Offset(0, 20).Value = TextBox20
    cellule.Offset(0, 21).Value = ComboBox2
    cellule.Offset(0, 22).Value = TextBox20
End With

End Sub

yassine.013 · 20 Décembre 2022

vgendron à dit:

Hello

essaie ce code en lieu et place de l'existant

VB:

'Bouton d'ajouter à la base '
Private Sub ab_Click()
On Error Resume Next
Dim ligne As Integer
With Sheets("Validation")
    .Activate 'pas obligatoire
    ligne = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    Set cellule = .Range("A" & ligne)
    cellule.Value = TextBox1.Value
    cellule.Offset(0, 1).Value = TextBox2
    cellule.Offset(0, 2).Value = TextBox3
    cellule.Offset(0, 3).Value = TextBox4
    cellule.Offset(0, 4).Value = TextBox5
    cellule.Offset(0, 5).Value = TextBox6
    cellule.Offset(0, 6).Value = TextBox7
    cellule.Offset(0, 7).Value = ComboBox1
    cellule.Offset(0, 8).Value = TextBox8
    cellule.Offset(0, 9).Value = TextBox9
    cellule.Offset(0, 10).Value = TextBox10
    cellule.Offset(0, 11).Value = TextBox11
    cellule.Offset(0, 12).Value = TextBox12
    cellule.Offset(0, 13).Value = TextBox13
    cellule.Offset(0, 14).Value = TextBox14
    cellule.Offset(0, 15).Value = TextBox15
    cellule.Offset(0, 16).Value = TextBox16
    cellule.Offset(0, 17).Value = TextBox17
    cellule.Offset(0, 18).Value = TextBox18
    cellule.Offset(0, 19).Value = TextBox19
    cellule.Offset(0, 20).Value = TextBox20
    cellule.Offset(0, 21).Value = ComboBox2
    cellule.Offset(0, 22).Value = TextBox20
End With

End Sub

Je te remercie beaucoup tu m'a sauvé la vie !!
premier problème résolu il me reste le deuxième problème

vgendron · 20 Décembre 2022

Voir en PJ les quelques améliorations effectuées sur ton code

ainsi qu'un lien qui pourrait t'etre utile pour comprendre les tables structurées

The VBA Guide To ListObject Excel Tables

For a data analyst, Excel Tables are a necessity! They are the most efficient way to organize your raw data and refer to data that contracts or expands on a regular basis. Likewise, Excel tables can be extremely useful in combination with VBA.

www.thespreadsheetguru.com

Note: pour quitter le formulaire. il faut que les 17 premiers TextBox soient remplis?? bizarre..
d'habitude. on utilise le bouton quitter pour sortir et mettre fin à l'appli..?

Phil69970 · 20 Décembre 2022

Bonjour @yasmine et Vincent

Juste en passant une petite erreur d'inattention dans le code de Vincent :

vgendron à dit:
cellule.Offset(0, 20).Value = TextBox20
cellule.Offset(0, 21).Value = ComboBox2
cellule.Offset(0, 22).Value = TextBox20

A remplacer par :

cellule.Offset(0, 20).Value = TextBox20
cellule.Offset(0, 21).Value = ComboBox2
cellule.Offset(0, 22).Value = TextBox21

@Phil69970

vgendron · 20 Décembre 2022

salut @Phil69970
héhé ....vu que je n'ai pas touché aux indices de TB, l'erreur n'est pas de moi, mais de l'auteur lui même
en tout cas, merci d'avoir noté ce point, que je n'avais pas vu

yassine.013 · 20 Décembre 2022

vgendron à dit:
Voir en PJ les quelques améliorations effectuées sur ton code

ainsi qu'un lien qui pourrait t'etre utile pour comprendre les tables structurées

The VBA Guide To ListObject Excel Tables

For a data analyst, Excel Tables are a necessity! They are the most efficient way to organize your raw data and refer to data that contracts or expands on a regular basis. Likewise, Excel tables can be extremely useful in combination with VBA.

www.thespreadsheetguru.com

Note: pour quitter le formulaire. il faut que les 17 premiers TextBox soient remplis?? bizarre..
d'habitude. on utilise le bouton quitter pour sortir et mettre fin à l'appli..?

Je te remercie beaucoup, tu es un génie en effet je voulais pas qu'ils quittent le formulaire avant de remplir quelques champs essentiels.
et je souhaite savoir si ta un code pour bloquer l'accès a la feuille source(on pourra pas remplir au clavier) de la colonne A jusqu'à W si c'est possible svp

vgendron · 20 Décembre 2022

Plutot que de les empecher de quitter le formulaire, il vaudrait mieux les empecher de valider la saisie tant que les infos obligatoires (celles avec un atérisque, je présume) sont incomplètes: non??

pour empecher l'accès à la feuille source
soit tu la masques, soit tu la protège.. attention, il faudra la déprotéger pour que le code VBA puisse copier dessus (le code peut se charger de déprotéger et reprotéger)..

yassine.013 · 20 Décembre 2022

Justement si je la protège le code pour coller ça ne marche pas et je dois interdire l'accès donc c'est impossible de faire ça

vgendron · 20 Décembre 2022

Comme indiqué, le code peut se charger de la protection de la feuille

Phil69970 · 20 Décembre 2022

Re

Vincent

Si j'ai compris ton code dans les cas ci dessous la re protection ne se fait pas puisque l'on sort avant

Private Sub CommandButton1_Click()
Dim CellCible As Range

ActiveSheet.Unprotect 'on déprotège la feuille
On Error Resume Next
Set CellCible = Application.InputBox("Sélectionnez la cellule à modifier", Type:=8)
If CellCible.Count <> 1 Then
MsgBox "Veuillez ne sélectionner qu'une seule cellule"
Exit Sub
End If

If CellCible.ListObject.Name = "" Then
MsgBox "la cellule n'appartient pas à la table"
Exit Sub
End If

CellCible = InputBox("vous pouvez modifier votre cellule")

ActiveSheet.Protect 'on reprotège la feuille
End Sub

Perso je ferais plutôt

VB:

Private Sub CommandButton1_Click()
Dim CellCible As Range

ActiveSheet.Unprotect 'on déprotège la feuille
On Error Resume Next
Set CellCible = Application.InputBox("Sélectionnez la cellule à modifier", Type:=8)
If CellCible.Count <> 1 Then
    MsgBox "Veuillez ne sélectionner qu'une seule cellule"
    ActiveSheet.Protect 'on reprotège la feuille
    Exit Sub
End If

If CellCible.ListObject.Name = "" Then
    MsgBox "la cellule n'appartient pas à la table"
    ActiveSheet.Protect 'on reprotège la feuille
    Exit Sub
End If

CellCible = InputBox("vous pouvez modifier votre cellule")

ActiveSheet.Protect 'on reprotège la feuille
End Sub

@Phil69970

vgendron · 20 Décembre 2022

Oui, exact.
le pire c'est que je me suis dit: "attention à l'exit sub qui sort avant la reprotection..."
mais bon. j'y pense et puis j'oublie

Cousinhub · 20 Décembre 2022

Bonjour,
Sinon, il existe aussi l'option :

VB:

Const Mdp As String = "xld" '
Sheets("Feuil1").Protect Mdp, UserInterfaceOnly:=True

Peut-être?

vgendron · 20 Décembre 2022

bhbh à dit:
Bonjour,
Sinon, il existe aussi l'option :

VB:

Const Mdp As String = "xld" ' Sheets("Feuil1").Protect Mdp, UserInterfaceOnly:=True

Peut-être?

Hello

Pas mal ca.. je ne connaissais pas cette option.. fut un temps elle m'aurait été bien utile..

yassine.013 · 20 Décembre 2022

Phil69970 à dit:

Re

Vincent

Si j'ai compris ton code dans les cas ci dessous la re protection ne se fait pas puisque l'on sort avant

Perso je ferais plutôt

VB:

Private Sub CommandButton1_Click()
Dim CellCible As Range

ActiveSheet.Unprotect 'on déprotège la feuille
On Error Resume Next
Set CellCible = Application.InputBox("Sélectionnez la cellule à modifier", Type:=8)
If CellCible.Count <> 1 Then
    MsgBox "Veuillez ne sélectionner qu'une seule cellule"
    ActiveSheet.Protect 'on reprotège la feuille
    Exit Sub
End If

If CellCible.ListObject.Name = "" Then
    MsgBox "la cellule n'appartient pas à la table"
    ActiveSheet.Protect 'on reprotège la feuille
    Exit Sub
End If

CellCible = InputBox("vous pouvez modifier votre cellule")

ActiveSheet.Protect 'on reprotège la feuille
End Sub

@Phil69970

Merci beaucoup !!!

Microsoft 365 Problème de dernière ligne dans un tableau

yassine.013

XLDnaute Nouveau

Pièces jointes

vgendron

XLDnaute Barbatruc

yassine.013

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

The VBA Guide To ListObject Excel Tables

Pièces jointes

Phil69970

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

yassine.013

XLDnaute Nouveau

The VBA Guide To ListObject Excel Tables

vgendron

XLDnaute Barbatruc

yassine.013

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Pièces jointes

Phil69970

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

yassine.013

XLDnaute Nouveau

Discussions similaires