Microsoft 365 Amélioration de mon code VBA

C

Cherrylie

XLDnaute Junior
Bonjour matinal à tous, 😇

Dans le cadre de mon cursus scolaire, je dois réaliser un projet citoyen. Afin d'avoir des données crédibles et visuelles, j'essaye de créer un tableau de bord avec différents onglets et un onglet de synthèse qui représentera graphiquement les chiffres clés de mon projet.

Bien que je débute en VBA, je suis avide d'apprendre et cherche toujours à m'améliorer (même si ce n'est pas gagné 😅).

Bref, voici mon problème :

J'ai créé un tableau qui s'incrémente automatiquement avec une macro à partir d'un formulaire (onglet Inscriptions). Le problème, c'est qu'à chaque fois que j'ajoute une personne via la macro, cela ajoute une ligne dans la feuille et décale la mise en page de mon menu latéral.

Existe-t-il une solution pour que les données s'insèrent à la fin du tableau sans ajouter de ligne ? (N'hésitez pas à me dire si je ne suis pas clair)

Voici le code VBA que j'ai réalisé :
VB: 
Sub ajouter_qqn()
'Permet d'ajouter une personne dans la liste des inscrits
With Sheets("Inscriptions")
[Inscrits].ListObject.ListRows.Add 1
[Inscrits[Nom]].Rows(1) = .[G5]
[Inscrits[Prénom]].Rows(1) = .[G9]
[Inscrits[Statut]].Rows(1) = .[I5]
[Inscrits[Promo]].Rows(1) = .[I9]
[Inscrits[Date]].Rows(1) = .[K9]
[Inscrits[Adresse mail]].Rows(1) = .[K5]
.Range("G5,G9,I5,I9,K5,K9").ClearContents
End With

End Sub

Je vous serai extrêmement reconnaissante si vous avez des propositions de code à me faire car j'ai cherché sur le forum mais sans succès.

Merci d'avance et bonne journée

Cherrylie
 

Pièces jointes

  • Suivi du projet.xlsm
    284.3 KB · Affichages: 11
Solution
cathodique
Bonjour,

@Cherrylie : Supprime de la de 1ère ligne la formule qui concatène le nom et prénom, ça se fera par code.
VB: 
Sub ajouter_qqn()
'Permet d'ajouter une personne dans la liste des inscrits
   Dim Ligne As ListRow, Table As ListObject
   With Sheets("Inscriptions")
      Set Table = .Range("Inscrits").ListObject
      Set Ligne = Table.ListRows.Add
      Ligne.Range.Cells(1) = .[G5]
      Ligne.Range.Cells(2) = .[G9]
      Ligne.Range.Cells(3) = .[G5] & " - " & .[G9]
      Ligne.Range.Cells(4) = .[I5]
      Ligne.Range.Cells(5) = .[I9]
      Ligne.Range.Cells(6) = .[K9]
      Ligne.Range.Cells(7) = .[K5]
      .Range("G5,G9,I5,I9,K5,K9").ClearContents
   End With

End Sub

Bonne journée.
Trier par date Trier par votes
cathodique

cathodique

XLDnaute Barbatruc
Bonjour,

@Cherrylie : Supprime de la de 1ère ligne la formule qui concatène le nom et prénom, ça se fera par code.
VB: 
Sub ajouter_qqn()
'Permet d'ajouter une personne dans la liste des inscrits
   Dim Ligne As ListRow, Table As ListObject
   With Sheets("Inscriptions")
      Set Table = .Range("Inscrits").ListObject
      Set Ligne = Table.ListRows.Add
      Ligne.Range.Cells(1) = .[G5]
      Ligne.Range.Cells(2) = .[G9]
      Ligne.Range.Cells(3) = .[G5] & " - " & .[G9]
      Ligne.Range.Cells(4) = .[I5]
      Ligne.Range.Cells(5) = .[I9]
      Ligne.Range.Cells(6) = .[K9]
      Ligne.Range.Cells(7) = .[K5]
      .Range("G5,G9,I5,I9,K5,K9").ClearContents
   End With

End Sub

Bonne journée.
 
Vote positif 0 Vote négatif
Solution
C

Cherrylie

XLDnaute Junior
cathodique à dit:
Bonjour,

@Cherrylie : Supprime de la de 1ère ligne la formule qui concatène le nom et prénom, ça se fera par code.
VB: 
Sub ajouter_qqn()
'Permet d'ajouter une personne dans la liste des inscrits
   Dim Ligne As ListRow, Table As ListObject
   With Sheets("Inscriptions")
      Set Table = .Range("Inscrits").ListObject
      Set Ligne = Table.ListRows.Add
      Ligne.Range.Cells(1) = .[G5]
      Ligne.Range.Cells(2) = .[G9]
      Ligne.Range.Cells(3) = .[G5] & " - " & .[G9]
      Ligne.Range.Cells(4) = .[I5]
      Ligne.Range.Cells(5) = .[I9]
      Ligne.Range.Cells(6) = .[K9]
      Ligne.Range.Cells(7) = .[K5]
      .Range("G5,G9,I5,I9,K5,K9").ClearContents
   End With

End Sub

Bonne journée.
Cliquez pour agrandir...
Bonjour Cathodique,

Merci beaucoup pour ton aide, ça marche parfaitement !

DU coup j'ai supprimé les colonnes Nom et Prénom pour en garder qu'une et j'ai réadapter le code.

Peux-tu me dire pourquoi quelle partie du code a permis d'ajouter une ligne sans tout bouger ? J'aimerai savoir au cas où je rencontrerai un problème similaire à l'avenir.

Merci encore !

Cherrylie
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Cherrylie, cathodique,

Vous pouvez utiliser cette macro :
VB: 
Sub ajouter()
Dim lig&
With [Inscrits] 'tableau structuré
    lig = .Rows.Count + IIf(.Cells(.Rows.Count, 1) = "", 0, 1)
    .Cells(lig, 1) = .Parent.[G5]
    .Cells(lig, 2) = .Parent.[G9]
    .Cells(lig, 4) = .Parent.[I5]
    .Cells(lig, 5) = .Parent.[I9]
    .Cells(lig, 6) = .Parent.[K9]
    If .Parent.[K5] Like "*@*" Then _
        .Parent.Hyperlinks.Add .Cells(lig, 7), "mailto:" & .Parent.[K5], TextToDisplay:=.Parent.[K5].Text _
            Else .Cells(lig, 7) = ""
    .Parent.[G5,G9,I5,I9,K5,K9] = ""
End With
End Sub
Comme l'a dit cathodique on peut supprimer les 2 premières colonnes.

A+
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Hello tous

tu peux aussi utiliser ce code légèrement modifié
VB: 
Sub ajouter_qqn()
'Permet d'ajouter une personne dans la liste des inscrits
With Sheets("Inscriptions").ListObjects("Inscrits")
    .ListRows.Add
    LastLine = .ListRows.Count
    
    .ListColumns("Nom").DataBodyRange(LastLine) = [G5]
    .ListColumns("Prénom").DataBodyRange(LastLine) = [G9]
    .ListColumns("Statut").DataBodyRange(LastLine) = [I5]
    .ListColumns("Promo").DataBodyRange(LastLine) = [I9]
    .ListColumns("Date").DataBodyRange(LastLine) = [K9]
    .ListColumns("Adresse Mail").DataBodyRange(LastLine) = [K5]
    Range("G5,G9,I5,I9,K5,K9").ClearContents
End With

End Sub
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Cherrylie à dit:
Bonjour Cathodique,:cool:

Merci beaucoup pour ton aide, ça marche parfaitement !

DU coup j'ai supprimé les colonnes Nom et Prénom pour en garder qu'une et j'ai réadapter le code.

Peux-tu me dire pourquoi quelle partie du code a permis d'ajouter une ligne sans tout bouger ? J'aimerai savoir au cas où je rencontrerai un problème similaire à l'avenir.

Merci encore !

Cherrylie
Cliquez pour agrandir...
Bonjour @Cherrylie :), @job75 ;), @vgendron ;),

@Cherrylie : [Inscrits].ListObject.ListRows.Add 1 ajoute une ligne en position 1 du tableau
Par contre si tu fais: [Inscrits].ListObject.ListRows.Add ça rajoute une ligne en fin de tableau, il faut récupérer le numéro de la ligne ajoute.
Tu as aussi les codes de Job75 et Vgendron.
J'avoue que je viens d'apprendre une autre façon de faire, le code de Job5 toujours au top:cool:
Bonne journée.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Après suppression des colonnes Nom et Prénom :
VB: 
Sub ajouter()
Dim lig&
With [Inscrits] 'tableau structuré
    lig = .Rows.Count + IIf(.Cells(.Rows.Count, 1) = "", 0, 1)
    .Cells(lig, 1) = Trim(.Parent.[E5] & " " & .Parent.[E9])
    .Cells(lig, 2) = .Parent.[G5]
    .Cells(lig, 3) = .Parent.[G9]
    .Cells(lig, 4) = .Parent.[I9]
    .Cells(lig, 5) = .Parent.[I5]
    If .Parent.[I5] Like "*@*" Then _
        .Parent.Hyperlinks.Add .Cells(lig, 5), "mailto:" & .Parent.[I5]
    .Parent.[E5,E9,G5,G9,I5,I9] = "" 'RAZ
End With
End Sub
J'ai aussi modifié la création du lien hypertexte : le tableau est agrandi même s'il est entré seul.
 

Pièces jointes

  • Suivi du projet.xlsm
    286.3 KB · Affichages: 8
Vote positif 0 Vote négatif
C

Cherrylie

XLDnaute Junior
cathodique à dit:
Bonjour @Cherrylie :), @job75 ;), @vgendron ;),

@Cherrylie : [Inscrits].ListObject.ListRows.Add 1 ajoute une ligne en position 1 du tableau
Par contre si tu fais: [Inscrits].ListObject.ListRows.Add ça rajoute une ligne en fin de tableau, il faut récupérer le numéro de la ligne ajoute.
Tu as aussi les codes de Job75 et Vgendron.
J'avoue que je viens d'apprendre une autre façon de faire, le code de Job5 toujours au top:cool:
Bonne journée.
Cliquez pour agrandir...
Bonjour @cathodique ,

Merci beaucoup pour ton explication !

Bon week-end :)

Cherrylie
 
Vote positif 0 Vote négatif
C

Cherrylie

XLDnaute Junior
job75 à dit:
Après suppression des colonnes Nom et Prénom :
VB: 
Sub ajouter()
Dim lig&
With [Inscrits] 'tableau structuré
    lig = .Rows.Count + IIf(.Cells(.Rows.Count, 1) = "", 0, 1)
    .Cells(lig, 1) = Trim(.Parent.[E5] & " " & .Parent.[E9])
    .Cells(lig, 2) = .Parent.[G5]
    .Cells(lig, 3) = .Parent.[G9]
    .Cells(lig, 4) = .Parent.[I9]
    .Cells(lig, 5) = .Parent.[I5]
    If .Parent.[I5] Like "*@*" Then _
        .Parent.Hyperlinks.Add .Cells(lig, 5), "mailto:" & .Parent.[I5]
    .Parent.[E5,E9,G5,G9,I5,I9] = "" 'RAZ
End With
End Sub
J'ai aussi modifié la création du lien hypertexte : le tableau est agrandi même s'il est entré seul.
Cliquez pour agrandir...
Bonjour @job75 ,

Merci pour ce nouveau code, il est top !

Bonne journée et bon week-end !

Cherrylie
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Microsoft 365 De Excel 2006 à EXCEL 365, ma macro ne fonctionne plus, que dois-je faire ?
2
Réponses
15
Affichages
1 K
Katido
K
J
  • Résolu(e)
XL 2016 VBA - Erreur de redimensionnement de mon tableau
Réponses
9
Affichages
2 K
mapomme
mapomme
R
  • Question
XL 2010 Création d'un tableau croisé dynamique à partir de cellule déjà sélectionnée
Réponses
1
Affichages
966
MP59
MP59
A
  • Question
Microsoft 365 Incrémentation VBA : Impression automatique adresses client papier autocollant thermique - Excel gestion de commandes - Génération QR codes
Réponses
4
Affichages
962
sylvanu
sylvanu
S
  • Résolu(e)
XL 2019 Macro: Automatisation tableau de trésorerie (données et mois)
2
Réponses
16
Affichages
3 K
SCORP95
S
N
  • Résolu(e)
XL 2016 Comment filtrer une listbox a mesure qu'on saisie dans textbox (2 colonnes)
2
Réponses
21
Affichages
4 K
ChTi160
ChTi160
F
  • Question
XL 2010 Débutant Tableau de bord code VBA
Réponses
1
Affichages
2 K
Rouge
R
Ayem
  • Résolu(e)
Autres macro-excel-pour-ajouter-une-ligne juste après la dernière ligne de mon tableau -avec-conservation-des formules et formats
Réponses
10
Affichages
4 K
Ayem
Ayem
M
  • Question
XL 2019 Aide et Assistance sur mon code VBA
Réponses
4
Affichages
834
sousou
sousou
S
  • Question
XL 2016 Amélioration d’un outil de suivi de production (il contient une erreur 13 d’incompatibilité)
Réponses
4
Affichages
1 K
Douni 56
D

Membres actuellement en ligne

6 membres et 113 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 192
Membres
102 809
dernier inscrit
Sandrine83