Modification macro pour excel 2003

[morganSOCO]

Bonjour XLDnautes !

Mon problème est "simple". J'ai une macro créée pour ajouter des lignes qui fonctionne sous excel 2007, or je suis sous excel 2003. Je souhaiterais donc la modifier et peut-être (avis au pro de la macro) la simplifier. Je vous joins un exemple du fichier qui fonctionne bien sous 2007 et le code macro.

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




Cordialement,
Morgan

 

[mécano41]

Re : Modification macro pour excel 2003

Bonjour,

Il me semble (mais pas sûr du tout...) que les .TintAndShade = 0 ne sont pas compris par 2003 ; essaie déjà en les enlevant...

Cordialement

 

[morganSOCO]

Re : Modification macro pour excel 2003

Bonjour Mécano !!!!

Tu as effectivement raison, je viens de les enlever et ca marche niquel ! Maintenant le problème est que les formules finales (de la colonne isolement) ne se font pas automatiquement. Par exemple quand je tape 5 les formules sont ok mais si je tape 2 après les formules pour sud et uoest ne fonctionnent plus .. et si ensuite je retape 5 elles ne fonctionnent pas non plus ... je pense que ca vient du fait que la formule finale ne fonctionne pas s'il n'ya qu'une valeur ... Quelqu'un serait il en mesure de la modifier si il n'ya qu'une valeur ?

 

[Venitien]

Re : Modification macro pour excel 2003

Re morganSOCO,

la solution était toute bête en fait mais encore fallait-il y penser, merci mécano41.

Il reste aussi le problème des bordures quand M5=1...

Pour tes formules, il faudrait que tu me les redonne, je sais comment faire mais je n'ai plus tes formules pour modèle...

Merci.

 

[morganSOCO]

Re : Modification macro pour excel 2003

OUi vraiment bête étant donné que nous avions tout les deux parlé de ce tintandshade ... Les bordures se n'est pas très important d'autant plus qu'il est rare de n'avoir qu'une infrastructure. je te mes l'exemple de l'arrêté !!!

Merci a vous !!

 

[Efgé]

Re : Modification macro pour excel 2003

Bonjour morganSOCO, Venitien, Salut mécano41 , J'avais fait quelque chose pour le code (maintenant sans bouton, au changelment en M5) _ je le dépose _ Cordialement

 

[morganSOCO]

Re : Modification macro pour excel 2003

Bonjour Efgé !

Merci beaucoup pour ton aide maintenant il ne me reste plus qu'a voir pour les formules !! =)

 

[Venitien]

Re : Modification macro pour excel 2003

Salut!

Je savais bien qu'il y avait moyen de raccourcir ce code lol.

Efgé, pourrais-tu mettre une version avec des notes dans ta macro pour expliquer ce qu'il se passe par étape? Histoire qu'on puisse regarder et comprendre pour progresser??

Merci.

 

[Efgé]

Re : Modification macro pour excel 2003

Re _ @ Venitien : je dois partir en rendez-vous, je ferai les commentaires ce soir ou demain et posterai le fichier_ Cordialement

 

[Venitien]

Re : Modification macro pour excel 2003

Merci beaucoup!

Bonne journée.

 

[morganSOCO]

Re : Modification macro pour excel 2003

Pour les formules il faudrait rajouter une condition "si il n'ya qu'une valeur alors mettre cette unique valeur" j'ai beau chercher dans l'aide excel je ne trouve pas =S

 

[Venitien]

Re : Modification macro pour excel 2003

MorganSOCO, pourrais-tu me donner la formule qui doit au final se trouver dans la dernière case ouest colonne P de ton tableau s'il te plais?

Je veux la formule qui marche si tu utilise ton tableau sans macro..

Et il faudrait que tu me dise comme ta formule reprend les valeur des case O de chaque ligne au-dessous, s'il faut à la dernière ligne nord, prendre les valeurs O de Est ou pas.

Je sais pas si je suis très clair mais en gros utilise ton tableau comme tu le ferais sans macro, et donne moi les formules que tu aurais dans ta dernière ligne Nord, et dans ta dernière ligne Ouest.

Merci!

Merci.

 

[morganSOCO]

Re : Modification macro pour excel 2003

Voilà un exemple. Le premier 35 correspond a l'isolement acoustique de la façade NORD par rapport aux 3 infrastructures. Le 31 a celui de la façade EST etc ... Est-ce que cela répond à ta question ??

 

[Venitien]

Re : Modification macro pour excel 2003

carrément ! ^^

Voici ton fichier avec formules. Je suis pas sur pour la colonne O d'avoir bien compris ta demande dans le cas ou il n'y à qu'une valeur... vérifies.

Je n'ai pas repris le code de Efgé car ne le comprenant pas, je ne savais pas l'adapter.

Mais la ça marche.

(Peut-être que j'ai laissé les .TintAndShade = 0.... je ne sais plus trop ou j'ai travaillé...)

dis moi si c'est ok.

 

[morganSOCO]

Re : Modification macro pour excel 2003

Je n'arrive pas a m'en servir .. l'extension est xlsm et du coup rien ne fonctionne dedans ... et tu as bien compris, s'il n'y a qu'une valeur j'aimerais cette unique valeur mais s'il y en a plus j'aimerais qu'il calcul avec cette formule :

=SI(GRANDE.VALEUR(O11:O14;1)-GRANDE.VALEUR(O11:O14;2)>3;MAX(O11:O14);MAX(O11:O14)+3)

en fait, il faudrait rajouter à cette même formule, une condition qui permette de mettre le résultat s'il n'y a qu'une valeur. Pour l'instant s'il 'ya qu'une valeur la case isolement m'affiche #### ... tu vois ce que je veux dire ??