Macro sur nouveau classeur

MASSJIPE

MASSJIPE

XLDnaute Impliqué
Bonjour,
Suite à une requête BO j'enregistre le fichier sous Excel (Pareto évolution)
Et je fais plusieurs manipulations de mise en forme mais pour éviter de faire cela tous les jours comment faire pour associer une macro ou macro complémentaire ou autre
Ci joint la macro
Merci
Sub Mise_en_forme()
'
' Mise_en_forme Macro
' Macro enregistrée le 10/04/2011 par Jean-Paul
'

'
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.ColorIndex = 0
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll Down:=-24
Cells.Select
Selection.Columns.AutoFit
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
Columns("U:U").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""A"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
Selection.FormatConditions(1).Interior.Pattern = xlNone
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""B"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 46
End With
Columns("AA:AB").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""DD"""
Selection.FormatConditions(1).Interior.ColorIndex = 9
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""LONG"""
Selection.FormatConditions(2).Interior.ColorIndex = 27
Columns("AC:AC").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""EA4"""
Selection.FormatConditions(1).Interior.ColorIndex = 5
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""EA3"""
Selection.FormatConditions(2).Interior.ColorIndex = 46
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""EA2"""
Selection.FormatConditions(3).Interior.ColorIndex = 26
ActiveWindow.SmallScroll Down:=-18
ActiveWindow.ScrollColumn = 106
ActiveWindow.ScrollColumn = 105
ActiveWindow.ScrollColumn = 104
ActiveWindow.ScrollColumn = 103
ActiveWindow.ScrollColumn = 102
ActiveWindow.ScrollColumn = 100
ActiveWindow.ScrollColumn = 98
ActiveWindow.ScrollColumn = 96
ActiveWindow.ScrollColumn = 95
ActiveWindow.ScrollColumn = 93
ActiveWindow.ScrollColumn = 90
ActiveWindow.ScrollColumn = 87
ActiveWindow.ScrollColumn = 84
ActiveWindow.ScrollColumn = 81
ActiveWindow.ScrollColumn = 78
ActiveWindow.ScrollColumn = 76
ActiveWindow.ScrollColumn = 74
ActiveWindow.ScrollColumn = 72
ActiveWindow.ScrollColumn = 70
ActiveWindow.ScrollColumn = 67
ActiveWindow.ScrollColumn = 64
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
Range("Z1").Select
ActiveCell.FormulaR1C1 = "MOTEUR"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("AA1").Select
ActiveCell.FormulaR1C1 = "DIR"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("AB1").Select
ActiveCell.FormulaR1C1 = "TYPE"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("AC1").Select
ActiveCell.FormulaR1C1 = "EQUI"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C2").Select
ActiveWindow.FreezePanes = True
Range("C1:AC1").Select
Selection.AutoFilter
End Sub
 
Trier par date Trier par votes
JNP

JNP

XLDnaute Barbatruc
Re : Macro sur nouveau classeur

Bonjour MASSJIPE :),
Ta macro peux être nettoyée, mais pour t'en servir tous les jours, est-ce que ta requête amène toujours les données dans le même positionnement ? Y-a-t'il des repères que l'on peut utiliser :rolleyes: ?
Le mieux serait que tu mettes un fichier exemple avec le résultat de plusieurs requêtes, et la mise en forme souhaitée (en décrivant les MFC) :p...
Bon dimanche :cool:
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Macro sur nouveau classeur

Re :),
Voici ta macro nettoyée
Code: 
Sub Mise_en_forme()
Rows("1:3").Delete Shift:=xlUp
With Cells
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.ColorIndex = 0
End With
Columns("B:B").Delete Shift:=xlToLeft
Columns("G:G").Delete Shift:=xlToLeft
Cells.Columns.AutoFit
With Columns("U:U")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""A"""
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 5
End With
.FormatConditions(1).Interior.Pattern = xlNone
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""B"""
With .FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 46
End With
End With
With Columns("AA:AB")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""DD"""
.FormatConditions(1).Interior.ColorIndex = 9
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""LONG"""
.FormatConditions(2).Interior.ColorIndex = 27
End With
With Columns("AC:AC")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""EA4"""
.FormatConditions(1).Interior.ColorIndex = 5
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""EA3"""
.FormatConditions(2).Interior.ColorIndex = 46
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""EA2"""
.FormatConditions(3).Interior.ColorIndex = 26
End With
Range("Z1").FormulaR1C1 = "MOTEUR"
With Range("Z1").Characters(Start:=1, Length:=6).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("AA1").FormulaR1C1 = "DIR"
With Range("AA1").Characters(Start:=1, Length:=3).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("AB1").FormulaR1C1 = "TYPE"
With Range("AB1").Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("AC1").FormulaR1C1 = "EQUI"
With Range("AC1").Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C2").Select
ActiveWindow.FreezePanes = True
Range("C1:AC1").Select
Selection.AutoFilter
End Sub
Bonne soirée :cool:
 
Vote positif 0 Vote négatif

Discussions similaires

dindin
  • Question
XL 2016 simplifier une macro enregistrée
Réponses
8
Affichages
543
dindin
dindin
S
  • Question
Microsoft 365 comparaison texte
Réponses
5
Affichages
490
svn
S
J
  • Question
XL 2019 Borné une extraction par date
2
Réponses
22
Affichages
2 K
jui42
J
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
289
vgendron
vgendron
L
  • Résolu(e)
XL 2019 lien hypertxte
Réponses
3
Affichages
338
litchoutsou
L
Syracoti
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
Staple1600
gh4
  • Question
XL 2010 conversion en nombre depuis vba
Réponses
2
Affichages
626
gh4
gh4
B
  • Question
Microsoft 365 colorer une plage
Réponses
2
Affichages
693
bd.afaf
B
F
  • Résolu(e)
XL 2016 MFC en VBA avec offset
Réponses
14
Affichages
780
flyingmuad
F
M
  • Question
XL 2016 Macro qui rame
Réponses
6
Affichages
1 K
sylvanu
sylvanu

Membres actuellement en ligne

7 membres et 97 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 070
Membres
103 453
dernier inscrit
Choupi