Modification macro pour excel 2003

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

  • Arrêté actuel2.xls
    113 KB · Affichages: 40
  • Arrêté actuel2.xls
    113 KB · Affichages: 38
  • Arrêté actuel2.xls
    113 KB · Affichages: 47
Trier par date Trier par votes
morganSOCO

morganSOCO

XLDnaute Junior
Re : Modification macro pour excel 2003

C'est exactement ça !!!! C'est vraiment parfait !!

Merci beaucoup Venitien tu as été d'une aide vraiment précieuse !

Maintenant je vais voir pour enlever le bouton comme Efgé l'a fait =)

Merci encore !!!
 
Vote positif 0 Vote négatif
V

Venitien

XLDnaute Occasionnel
Re : Modification macro pour excel 2003

Pour ça, au tout début du code tu remplaces

Code: 
Private Sub CommandButton1_Click()

Par

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$M$5" Or Target.Count > 1 Then Exit Sub

De rien pour l'aide, bonne continuation, et au plaisir.

Bye!
 
Vote positif 0 Vote négatif
morganSOCO

morganSOCO

XLDnaute Junior
Re : Modification macro pour excel 2003

J'ai besoin de votre aide une dernière fois ... j'essais d'adapter la macro a un autre arrêté mais en vain a chaque fois j'obtiens un résultat horrible ... je vous mes en PJ le futur arrêté si vous y arrivez ...

D'autant plus que pour cet arrêté futur il est nécéssaire de supprimer les lignes vides pour que le calcul de l'isolement se fasse automatiquement.

Merci d'avance !
 

Pièces jointes

  • Futur arrêté.xls
    81 KB · Affichages: 14
  • Futur arrêté.xls
    81 KB · Affichages: 16
  • Futur arrêté.xls
    81 KB · Affichages: 16
Dernière édition:
Vote positif 0 Vote négatif
V

Venitien

XLDnaute Occasionnel
Re : Modification macro pour excel 2003

Re!

ça marche, il suffisait de remplacer les B par des A car ta première colonne est A maintenant.

J'avais dit que je t'annoterais la macro, je vais m'en occuper et je te l'enverrais.

pour ton bouton en bas pour la selection, il faut que tu remplace le code assigné à ton bouton par celui qui se trouve tout en bas de la macro

Code: 
     N3 = Application.CountIf(Range("A:A"), "NORD")
     E3 = Application.CountIf(Range("A:A"), "EST")
     S3 = Application.CountIf(Range("A:A"), "SUD")
     O3 = Application.CountIf(Range("A:A"), "OUEST")
'selectionne puis copie la zone entre B2 et Qdernière ligne pleine + 1 (pour ne pas couper juste sous le tableau)
 Range("A2", "R" & 10 + N3 + E3 + S3 + O3 + 1).Select
    Selection.Copy
    'On selectionne la zone ou coller
    'Range(plage de cellule ou coller la copie).Select
    'On colle
    'ActiveSheet.Paste
Pour cette feuille.

Remplace Range("A:A") par Range("B:B") pour l'ancien fichier. Si non il ne sélectionne que jusqu'à la 26ème cellule au lieu de prendre tout le tableau.

A+
 

Pièces jointes

  • Futur arrêté.xls
    125.5 KB · Affichages: 14
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : Modification macro pour excel 2003

Bonjour à tous, Comme promis à Venitien, le fichier commenté _ j'ai utilisé le fichier du post 16, avec les formules données _ Cordialement
 

Pièces jointes

  • actuel2(3).xls
    85 KB · Affichages: 24
Vote positif 0 Vote négatif

Discussions similaires

R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
289
vgendron
vgendron
L
  • Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
365
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
2 K
fanou06
F
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
565
Kevin38
K
ZAKAO
  • Résolu(e)
XL 2013 Ecriture de code condensé
Réponses
9
Affichages
367
ZAKAO
ZAKAO
Syracoti
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
Staple1600
M
  • Question
XL 2010 code VBA pour trier une colonne de mon tableau
Réponses
8
Affichages
1 K
Michelrib
M
P
  • Question
XL 2019 appliquer une macro sur n'importe quel fichier excel
2
Réponses
22
Affichages
2 K
pasquetp
P
D
  • Résolu(e)
XL 2016 VBA Problème avec les bordures intérieures
Réponses
2
Affichages
2 K
danielco
D

Membres actuellement en ligne

8 membres et 115 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 305
Messages
2 087 077
Membres
103 455
dernier inscrit
saramachado