Modification macro pour excel 2003

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion morganSOCO
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
morganSOCO

morganSOCO

XLDnaute Junior
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
 

Pièces jointes

Trier par date Trier par votes
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 ?
 
Dernière édition:
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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 !!
 

Pièces jointes

Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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.
 

Pièces jointes

Vote positif 0 Vote négatif
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 ??
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Pouvez-vous traduire le code VBA SVP ?
Réponses
8
Affichages
259
MOLY_
M
M
  • Question Question
Autres Problème de sélection
Réponses
14
Affichages
253
fanch55
fanch55
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
H
  • Question Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
477
vgendron
vgendron
R
  • Question Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
2 K
TooFatBoy
TooFatBoy
L
  • Question Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
681
lolo_excelbeginner
L
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
4 K
fanou06
F
K
  • Question Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
886
Kevin38
K
ZAKAO
  • Résolu(e)
XL 2013 Ecriture de code condensé
Réponses
9
Affichages
637
ZAKAO
ZAKAO
Syracoti
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
Staple1600
P
  • Question Question
XL 2019 appliquer une macro sur n'importe quel fichier excel
2
Réponses
22
Affichages
3 K
pasquetp
P
M
  • Question Question
XL 2010 code VBA pour trier une colonne de mon tableau
Réponses
8
Affichages
1 K
Michelrib
M
D
  • Question Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
1 K
AtTheOne
AtTheOne
T
  • Question Question
XL pour MAC Recherche date
Réponses
5
Affichages
2 K
tdenis
T
D
  • Résolu(e)
XL 2016 VBA Problème avec les bordures intérieures
Réponses
2
Affichages
2 K
danielco
D
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
S
  • Question Question
Microsoft 365 comparaison texte
Réponses
5
Affichages
716
svn
S
D
  • Question Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
1 K
Hasco
Hasco
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
881
fanfan38
fanfan38
O
  • Question Question
XL 2016 Equilibrage gestion de comptes
Réponses
3
Affichages
888
obyone
O
Retour