XL 2019 Tableau- creation de lignes: probleme de hauteur de lignes

C

Cheyenne_2021

XLDnaute Junior
Bonjour,

1 fichier Excel avec plusieurs onglets.

Pour la création de ligne, il y a une macro sur le 1er onglet, où il est possible de créer plusieurs lignes d’un coup. Les lignes sont créées dans chaque onglet, en début de tableau. Cela se passe bien sur tous les onglets sauf sur un où, à la fin du tableau, les lignes déjà existantes , autant qu’il y en eu de créées, perdent en hauteur de ligne.

Je vous mets une image, la macro.

Je ne peux pas vous mettre le fichier car il est très lourd et contient trop de données confidentielles.

Merci

Hauteur_Lignes.jpg

VB: 
Dim NumL1 As Integer            ' variable globale
Dim Lig As Integer

Sub Ajouter_Ligne_1()

Dim start As Double
start = Timer

Call Initialisation_Variables_Public
'deverouilage de tous les onglets
    Onglet_SuiviDi.Unprotect Evaluate("MotPasse")
    Onglet_TraitDi.Unprotect Evaluate("MotPasse")
    Onglet_Commission.Unprotect Evaluate("MotPasse")
    Onglet_Equipement.Unprotect Evaluate("MotPasse")
    Onglet_Convention.Unprotect Evaluate("MotPasse")
  '  Onglet_SuiviTw.Unprotect Evaluate("MotPasse")

 
 
  ' enlever les filtrages sur chaque tableau
  If [T_suiviDi].ListObject.AutoFilter.FilterMode Then
    [T_suiviDi].ListObject.AutoFilter.ShowAllData
    Rows("3:3").Select
    Selection.EntireRow.Hidden = True
    Rows(3).EntireRow.Hidden = True
    
  End If
 
 
 
 If [T_TraitDi].ListObject.AutoFilter.FilterMode Then
    [T_TraitDi].ListObject.AutoFilter.ShowAllData
  Rows("4:4").Select
  Selection.EntireRow.Hidden = True
  Rows(4).EntireRow.Hidden = True
  End If
 
 
 
  If [T_Commission].ListObject.AutoFilter.FilterMode Then
    [T_Commission].ListObject.AutoFilter.ShowAllData
    Rows("3:3").Select
    Selection.EntireRow.Hidden = True
    Rows(3).EntireRow.Hidden = True
  End If
 
 
  If [T_Equipement].ListObject.AutoFilter.FilterMode Then
    [T_Equipement].ListObject.AutoFilter.ShowAllData
    Rows("3:3").Select
    Selection.EntireRow.Hidden = True
    Rows(3).EntireRow.Hidden = True
  End If
 
    
  If [T_convention].ListObject.AutoFilter.FilterMode Then            'ExcelDownloads
  
   [T_convention].ListObject.AutoFilter.ShowAllData
    End If
  '
    
  'If [T_suiviTw].ListObject.AutoFilter.FilterMode Then    onglet supprime dec2022
  '  [T_suiviTw].ListObject.AutoFilter.ShowAllData
  'Rows("3:3").Select
  'Selection.EntireRow.Hidden = True
  ' Essai autre pour masquer la ligne
  'Rows(3).EntireRow.Hidden = True
  'End If
    
  Lig = InputBox("combien de lignes voulez-vous creer ?", "création de lignes", 1)

For i = 1 To Lig
  '  Call Deverrouiller_feuille(ActiveWorkbook.Worksheets("1- Suivi des DI & avis n+1"))
    'Call Deverrouiller_feuille(Onglet_TraitDi)
    
    Application.Calculation = xlCalculationManual
      Application.ScreenUpdating = False
    
    'Creation ligne dans 1er onglet
    
    With Sheets("1- Suivi des DI & avis n+1")
        colent = Range("T_suiviDi[[#Headers]]").Row          'n° de la derniere ligne de l'entete
        'MsgBox ("n° ligne d entete " & colent)
      
        
    
        'calcul nouveau n°
         decalage = Range("T_suiviDi[[#headers]]").Row    'N° de ligne de mon entete de tableau
          [T_suiviDi].ListObject.ListRows.Add (1)
         'MsgBox ("decalage" & decalage)
        'MsgBox ("range etc " & Range("T_suiviDi[#Num]").Cells(Target.Row - (decalage + 1)).Value)  ' n)° de la ligne modifiee
        'MsgBox ("range etc " & Ligmod)  ' n° de la ligne modifiee
            
        MA = Application.WorksheetFunction.Max(Range("T_suiviDi[NumL]")) + 1   ' recherche la valeur max de toute la colonne
        'MsgBox ("MA " & MA)
                          
        'MsgBox ("1ere col : " & Range("T_suiviDi[NumL]").Cells(decalage).Value)
        Range("T_suiviDi[NumL]").Cells(1) = Format(MA, "000")
        NumL1 = Range("T_suiviDi[NumL]").Cells(1)
        'MsgBox ("Numl1 " & NumL1)
   End With
 '
    Call Ajouter_Ligne_2
    Call Ajouter_Ligne_3
    Call Ajouter_Ligne_4
    Call Ajouter_Ligne_5
  '  Call Ajouter_Ligne_6
Next i



Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
 
   Onglet_SuiviDi.Protect Evaluate("MotPasse"), DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True
        Onglet_TraitDi.Protect Evaluate("MotPasse"), DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True
        Onglet_Commission.Protect Evaluate("MotPasse"), DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True
        Onglet_Equipement.Protect Evaluate("MotPasse"), DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True
        Onglet_Convention.Protect Evaluate("MotPasse"), DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True
     '   Onglet_SuiviTw.Protect Evaluate("MotPasse"), DrawingObjects:=False, Contents:=True, Scenarios:= _
     '   True, AllowSorting:=True, AllowFiltering:=True

'Call Verouiller_feuille(ActiveWorkbook.Worksheets("1- Suivi des DI & avis n+1"))

 
    
' MsgBox ("La durée ceration de lignes st de : " & Format((Timer - start), "00:00:00.00"))

End Sub

Sub Ajouter_Ligne_2()


'MsgBox ("Numl1 pour n°2 " & NumL1)
With Worksheets("2- Traitement des DI")
    decalage_2 = Range("T_TraitDi[[#Headers]]").Row          'n° de ligne de l'entete : 3
    'MsgBox ("n° ligne d entete " & decalage_2)
    [T_TraitDi].ListObject.ListRows.Add (2)
    Range("T_TraitDi[NumL]").Cells(2) = NumL1   ' c'est tjrs la 2eme ligne du tableau qui est créee

End With
'Call Verouiller_feuille(Worksheets("2- Traitement des DI"))
End Sub

Sub Ajouter_Ligne_3()                   'Tableau : T_Commission

'Call Deverrouiller_feuille(Worksheets("3- Avis commission & notif"))


'Worksheets("3- Avis commission & notif").Activate
'MsgBox ("Numl1 pour n°3 " & NumL1)
With Worksheets("3- Avis commission & notif")
    decalage_3 = Range("T_commission[[#Headers]]").Row          'n° de ligne de l'entete : 3
    'MsgBox ("n° ligne d entete " & decalage_3)
    [T_Commission].ListObject.ListRows.Add (2)
    'Range("T_Commission").Rows(2).Select       ' apres la ligne modele masquee
    'Selection.EntireRow.Insert copyorigin = xlFormatFromRightOrBelow
    Range("T_Commission[NumL]").Cells(2) = NumL1   ' c'est tjrs la 2eme ligne du tableau qui est créee

End With
'Call Verouiller_feuille(Worksheets("3- Avis commission & notif"))
' Worksheets("3- Avis commission & notif").Deactivate  ' cree un bug
End Sub

Sub Ajouter_Ligne_4()                   'Tableau : T_Equipement

'Call Deverrouiller_feuille(Worksheets("4- Equipement et formations"))

'Worksheets("4- Equipement et formations").Activate
'MsgBox ("Numl1 pour n°3 " & NumL1)
With Worksheets("4- Equipement et formations")
    decalage_4 = Range("T_Equipement[[#Headers]]").Row          'n° de ligne de l'entete : 3
    'MsgBox ("n° ligne d entete " & decalage_4)
    [T_Equipement].ListObject.ListRows.Add (2)
    'Range("T_Equipement").Rows(2).Select                     ' apres la ligne modele masquee
    'Selection.EntireRow.Insert copyorigin = xlFormatFromRightOrBelow
    Range("T_Equipement[NumL]").Cells(2) = NumL1             ' c'est tjrs la 2eme ligne du tableau qui est créee

End With
'Call Verouiller_feuille(Worksheets("4- Equipement et formations"))
End Sub


Sub Ajouter_Ligne_5()                   'Tableau : T_Convention

'Call Deverrouiller_feuille(Worksheets("5- Edition convention"))

'Worksheets("5- Edition convention").Activate
'MsgBox ("Numl1 pour n°5 " & NumL1)
With Worksheets("5- Edition convention")
    decalage_5 = Range("T_Convention[[#Headers]]").Row          'n° de ligne de l'entete : 3
   ' MsgBox ("n° ligne d entete " & decalage_5)
   [T_convention].ListObject.ListRows.Add (1)
    'Range("T_Convention").Rows(1).Select                     ' apres la ligne modele masquee
   ' Selection.EntireRow.Insert copyorigin = xlFormatFromRightOrBelow
    'Selection.ListObject.ListRows.Add (1)
    Range("T_Convention[NumL]").Cells(1) = NumL1             ' c'est tjrs la 2eme ligne du tableau qui est créee

End With
'Call Verouiller_feuille(Worksheets("5- Edition convention"))
End Sub

Sub Ajouter_Ligne_6()                   'Tableau : T_SuiviTw      6- Suivi télétravail onglet supprime DEc 2022

'Call Deverrouiller_feuille(Worksheets("6- Suivi télétravail"))

'Worksheets("6- Suivi télétravail").Activate
'MsgBox ("Numl1 pour n°6 " & NumL1)
'With Worksheets("6- Suivi télétravail")
'    decalage_6 = Range("T_SuiviTw[[#Headers]]").Row          'n° de ligne de l'entete : 3
    'MsgBox ("n° ligne d entete " & decalage_6)
 '   [T_suiviTw].ListObject.ListRows.Add (2)
    'Range("T_SuiviTw").Rows(2).Select                     ' apres la ligne modele masquee
    'Selection.EntireRow.Insert copyorigin = xlFormatFromRightOrBelow
  '  Range("T_SuiviTw[NumL]").Cells(2) = NumL1             ' c'est tjrs la 2eme ligne du tableau qui est créee

' End With
'Call Verouiller_feuille(Worksheets("6- Suivi télétravail"))

End Sub

Sub Deverrouiller_feuille(WS As Worksheet)

    'MsgBox ("ws name deverouillage :" & WS.Name)
     WS.Unprotect Evaluate("MotPasse")
    

    'msgbox ("WS : " & WS)
    'MsgBox ("ws name deverouillage :" & WS.Name)
    '
    ' appel : deverouiller_feuille (Worksheet ("nom de la feuille"))

End Sub

Sub Verouiller_feuille(WS As Worksheet)

    
    'WS.Protect Evaluate("MotPasse"), True, True, True
    WS.Protect Evaluate("MotPasse"), DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowSorting:=True, AllowFiltering:=True


    'MsgBox ("ws name verouillage :" & WS.Name)
    'MsgBox ("motdepasse : " & Evaluate("MotPasse"))


End Sub
 
Trier par date Trier par votes
xUpsilon

xUpsilon

XLDnaute Accro
Pour autant que je puisse en juger dans votre code illisible (les commentaires c'est bien, mais quand il y a 3 lignes de commentaires toutes les 1 ligne de code, ça fiche le bazar), rien ne définit la hauteur des lignes créées. Donc il suffit que Excel choisisse un paramètre par défaut arbitraire ne correspondant pas à ce qui se trouve dans votre tête (c'est à dire, sauf coincidence, 100% des cas) pour que la hauteur des lignes créées ne soit pas correcte.

Bonne journée,
 
Vote positif 0 Vote négatif
xUpsilon

xUpsilon

XLDnaute Accro
Le principe reste le même. Aucune ligne du code mentionné ci-dessus ne modifie la hauteur des lignes.
Donc il s'agit à mon sens d'une interaction avec Excel qui attribue une certaine valeur par défaut à certaines lignes. Ou peut-être avez-vous autre part un autre bout de code qui touche à la hauteur des lignes ? Dans un évènement Worksheet_Change par exemple ?

Bonne journée,
 
Vote positif 0 Vote négatif
C

Cheyenne_2021

XLDnaute Junior
#xUpsilon : Je viens expliquer quelle solution j'ai trouvée .
J'ai agrandit la hauteur des lignes juste en dessous du tableau, en dehors du tableau et ca fontionne ! Comme si les nouvelles lignes à la fin du tableau prenaient la taille des lignes juste en dessous .
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
XL 2019 1004 sur un ActiveSheet.Paste
Réponses
5
Affichages
317
Cheyenne_2021
C
C
  • Question
XL 2019 Envoi mail : Condition dans un HTMLBODY
Réponses
2
Affichages
518
Cheyenne_2021
C
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
194
loreak
L
C
  • Question
XL 2019 Lenteur macro (nouveau cas)
2 3
Réponses
31
Affichages
3 K
ChTi160
ChTi160
C
  • Question
XL 2019 Erreur 438 sur un specialPaste
Réponses
6
Affichages
939
Cheyenne_2021
C
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
643
Oneida
Oneida
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
577
MickaeL_D
M
S
  • Question
Microsoft 365 Erreur d'exécution '91'
Réponses
11
Affichages
434
Staple1600
Staple1600
jeandechanel
  • Résolu(e)
Barre de progression
Réponses
7
Affichages
960
jeandechanel
jeandechanel
C
  • Question
XL 2019 Excel 2019 VBA Probleme sur creation de ligne en 1ere position
2
Réponses
23
Affichages
2 K
Cheyenne_2021
C

Membres actuellement en ligne

17 membres et 148 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 207
Messages
2 086 232
Membres
103 161
dernier inscrit
Rogombe bryan