Créer une macro pour ajouter des lignes

morganSOCO

XLDnaute Junior
Bonjour,

Aujourd'hui j'aimerais créer une macro sous Excel 2003 qui me permettrai d'entrer dans une case un chiffre et qui, en fonction de ce chiffre, insererait autant de ligne ...

EX: j'ai besoin de 5 ligne. J'écris 5 dans une case, alors, il me met 5 lignes....

Je ne sais pas si c'est très clair ...

Merci par avance de votre aide.
 

morganSOCO

XLDnaute Junior
Re : Créer une macro pour ajouter des lignes

Quand je mes 2 et je clic il m'ajoute une ligne, ok ca m'en fais 2 ! mais quand je reclik il m'en rajoute encore une etc ... ??? deplus, a chaque fois que je clik j'ai l'erreur 438 qui s'affiche et quand je clik sur débogage il m'emmene au VBA et me surligne la ligne .TintAndShade = 0 ...
 

Venitien

XLDnaute Occasionnel
Re : Créer une macro pour ajouter des lignes

Ah... je croyais que tu étais passé sur 2007 depuis l'autre fois...

En toute franchise et tu as dû t'en apercevoir, je suis complètement débutant en macro, du coup je ne sais absolument pas comment modifier ma macro pour l'adapter à Excel 2003. Mais ce que je te propose, c'est de copier le code ci-dessous (qui et le code qui code pour l'instant pour ta macro) et d'ouvrir un nouveau sujet pour que quelqu'un qui sait faire nous l'adapte. En plus de ça elle est vraiment longue, y'a peut-être moyen de la raccourcir pour qu'elle soit plus rapide. Peut-être aussi qu'il y a une solution plus simple... enfin bon, ça pourrait être pas mal que quelqu'un la corrige.

En plus de ça, il manque encore les bordures qui ne se mettent pas comme il faut si M5 = 1 (au dessus de 1 c'est nickel). Il manque aussi l'histoire des formules... l'idée serait peut-être de les replacer dans les cases adéquates une fois le nombre de lignes ajustées mais j'ai pas encore pu regarder.

Je te suit sur le nouveau sujet pour garder un œil là dessus et voir si je peux encore t'aider. Si tu as besoin n'hésites pas à demander même en MP.

Code:
Private Sub CommandButton1_Click()
' Si moins de 1 alors erreur
If Range("M5") < 1 Then
MsgBox "Nombre d'infrastrucutures érroné, veuillez choisir minimum une infrastructure."
GoTo Endsub
End If
'Pour le nord
N = Application.CountIf(Range("B:B"), "NORD")
If N > Range("M5").Value Then
r = 11 + N - Range("M5").Value
Range("B12", "Q" & r).Select
Selection.Delete
End If
If N < Range("M5").Value Then
Rows(11 + N).Resize(Range("M5") - N).Insert
End If
For p = 11 To 11 + Range("M5").Value - 1
Range("B11:Q11").Copy
Range("B" & p, "Q" & p).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
   Next p

'Pour L'est
    N2 = Application.CountIf(Range("B:B"), "NORD")

E = Application.CountIf(Range("B:B"), "EST")
If E > Range("M5").Value Then
r = 11 + N2 + E - Range("M5").Value
Range("B" & 11 + N2 + 1, "Q" & r).Select
Selection.Delete
End If
If E < Range("M5").Value Then
Rows(11 + N2 + E).Resize(Range("M5") - E).Insert
End If
For r = 11 + N2 To 11 + N2 + Range("M5").Value - 1
Range("B" & 11 + N2, "Q" & 11 + N2).Copy
Range("B" & r, "Q" & r).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
   Next r

'Pour le sud
     N2 = Application.CountIf(Range("B:B"), "NORD")
     E2 = Application.CountIf(Range("B:B"), "EST")
     
S = Application.CountIf(Range("B:B"), "SUD")
If S > Range("M5").Value Then
t = 11 + N2 + E2 + S - Range("M5").Value
Range("B" & 11 + N2 + E2 + 1, "Q" & t).Select
Selection.Delete
End If
If S < Range("M5").Value Then
Rows(11 + N2 + E2 + S).Resize(Range("M5") - S).Insert
End If
For u = 11 + N2 + E2 To 11 + N2 + E2 + Range("M5").Value - 1
Range("B" & 11 + N2 + E2, "Q" & 11 + N2 + E2).Copy
Range("B" & u, "Q" & u).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
   Next u
  
'Pour L 'ouest

Dim dernl As Long
dernl = Cells.Range("B" & Rows.Count).End(xlUp).Row

     N2 = Application.CountIf(Range("B:B"), "NORD")
     E2 = Application.CountIf(Range("B:B"), "EST")
     S2 = Application.CountIf(Range("B:B"), "SUD")
     
O = Application.CountIf(Range("B:B"), "OUEST")
If O > Range("M5").Value Then
v = 11 + N2 + E2 + S2 + O - Range("M5").Value
Range("B" & 11 + N2 + E2 + S2 + 1, "Q" & v).Select
Selection.Delete
End If
If O < Range("M5").Value Then
Rows(11 + N2 + E2 + S2 + O).Resize(Range("M5") - O).Insert
End If
For w = 11 + N2 + E2 + S2 To 11 + N2 + E2 + S2 + Range("M5").Value - 1
Range("B" & 11 + N2 + E2 + S2, "Q" & 11 + N2 + E2 + S2).Copy
Range("B" & w, "Q" & w).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
   Next w


'On remet les bordures épaisses entre les point cardinaux
'pour les têtes de colonnes
 Range("B10:Q10").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'Pour le nord
    'If Range("M5").Value = 1 Then
    Range("B" & 11 + N2 - 1, "Q" & 11 + N2 - 1).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'pour l'est
    
    Range("B" & 11 + N2 + E2 - 1, "Q" & 11 + N2 + E2 - 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'Pour le sud
    
    Range("B" & 11 + N2 + E2 + S2 - 1, "Q" & 11 + N2 + E2 + S2 - 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'Pour l'ouest
    O2 = Application.CountIf(Range("B:B"), "OUEST")
    Range("B" & 11 + N2 + E2 + S2 + O2 - 1, "Q" & 11 + N2 + E2 + S2 + O2 - 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    GoTo Endsub
    
Endsub:
End Sub

et le fichier aussi pour le poster dans ton nouveau sujet.

A+
 

Pièces jointes

  • Arrêté actuel2.xls
    113 KB · Affichages: 42
  • Arrêté actuel2.xls
    113 KB · Affichages: 36
  • Arrêté actuel2.xls
    113 KB · Affichages: 36

Discussions similaires

Statistiques des forums

Discussions
312 836
Messages
2 092 655
Membres
105 479
dernier inscrit
chaussadas.renaud