Simplifier code

castor30

castor30

XLDnaute Occasionnel
Bonjour,
J'ai fait ce code avec l'enregistreur, peut-on le simplifier ?
je vous remercie

Sub MisForm()
Range("A1").Select
ActiveCell.FormulaR1C1 = "Nom" & Chr(13) & "" & Chr(10) & "Adresse "
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Times New Roman"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=4, Length:=2).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=6, Length:=8).Font
.Name = "Times New Roman"
.FontStyle = "Italique"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "Prénom" & Chr(13) & "" & Chr(10) & " Complément Adresse"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Times New Roman"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=7, Length:=3).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=10, Length:=18).Font
.Name = "Times New Roman"
.FontStyle = "Italique"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C1").Select
ActiveCell.FormulaR1C1 = "Tél Maison" & Chr(13) & "" & Chr(10) & " CP"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Times New Roman"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=11, Length:=3).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=14, Length:=2).Font
.Name = "Times New Roman"
.FontStyle = "Italique"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "Tél Portable" & Chr(13) & "" & Chr(10) & " Commune"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Times New Roman"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=13, Length:=2).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=15, Length:=8).Font
.Name = "Times New Roman"
.FontStyle = "Italique"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "Sel"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Times New Roman"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
 
Trier par date Trier par votes
JBARBE

JBARBE

XLDnaute Barbatruc
Bonjour à tous,
Difficile de faire un tri dans tout cette sélection de activecell :
Peut être ceci à tester :
Code: 
    Sub MisForm()
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Nom" & Chr(13) & "" & Chr(10) & "Adresse "
    With ActiveCell.Characters(Start:=1, Length:=3).Font
    .Name = "Times New Roman"
    .FontStyle = "Gras"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=4, Length:=2).Font
    .Name = "Times New Roman"
    .FontStyle = "Normal"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=6, Length:=8).Font
    .Name = "Times New Roman"
    .FontStyle = "Italique"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Prénom" & Chr(13) & "" & Chr(10) & " Complément Adresse"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
    .Name = "Times New Roman"
    .FontStyle = "Gras"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=7, Length:=3).Font
    .Name = "Times New Roman"
    .FontStyle = "Normal"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=10, Length:=18).Font
    .Name = "Times New Roman"
    .FontStyle = "Italique"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Tél Maison" & Chr(13) & "" & Chr(10) & " CP"
    With ActiveCell.Characters(Start:=1, Length:=10).Font
    .Name = "Times New Roman"
    .FontStyle = "Gras"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=11, Length:=3).Font
    .Name = "Times New Roman"
    .FontStyle = "Normal"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=14, Length:=2).Font
    .Name = "Times New Roman"
    .FontStyle = "Italique"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Tél Portable" & Chr(13) & "" & Chr(10) & " Commune"
    With ActiveCell.Characters(Start:=1, Length:=12).Font
    .Name = "Times New Roman"
    .FontStyle = "Gras"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=13, Length:=2).Font
    .Name = "Times New Roman"
    .FontStyle = "Normal"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=15, Length:=8).Font
    .Name = "Times New Roman"
    .FontStyle = "Italique"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Sel"
    With ActiveCell.Characters(Start:=1, Length:=3).Font
    .Name = "Times New Roman"
    .FontStyle = "Gras"
    .Size = 10
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Range("A1:E1").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    End With
    End Sub
Bonne journée !
 
Vote positif 0 Vote négatif

Discussions similaires

PORCHER
  • Question
Microsoft 365 Y a t'il plus simple pour la formule
Réponses
5
Affichages
311
PORCHER
PORCHER
V
Verdanto
Réponses
0
Affichages
323
verdanto
V
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
517
M@xu3L
M
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
761
Kevin38
K
My<3
  • Question
XL 2019 HTML Corps de mail
Réponses
6
Affichages
554
My<3
My<3
Syracoti
  • Résolu(e)
XL 2016 Changer de feuille dans une macro
2
Réponses
28
Affichages
3 K
Staple1600
Staple1600
B
  • Résolu(e)
XL 2019 Problème macro sur Excel 2019
Réponses
9
Affichages
1 K
BOUBRED
B
B
  • Question
Microsoft 365 colorer une plage
Réponses
2
Affichages
793
bd.afaf
B
Salmander
  • Résolu(e)
Autres Couleur de Shape
Réponses
3
Affichages
447
patricktoulon
patricktoulon

Membres actuellement en ligne

17 membres et 275 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
314 656
Messages
2 111 610
Membres
111 224
dernier inscrit
Test66