Bonjour,
j'ai enregistré la macro ci-dessous et j'ai ajouté devant une macro trouve sur le web pour ajouter une ligne sous la cellule sélectionnée.
je voudrais qu'au final ma macro me permette d'insérer une ligne en-dessous de la case sélectionnée, puis de fusionner des cellules, puis d'insérer une formule d'une case du dessus pour qu'elle s'applique à la nouvelle ligne et enfin mettre une mise en forme conditionnelle sur des cases de cette nouvelle ligne.
Comment fait on pour que tout cela puisse s'appliquer à n'importe quelle cellule? et non pas au cellule indiquée dans Range(""). Select...
voici mon code. Bien sûr il ne marche pas comme cela car j'y ajouté le code pour insérer une ligne au début mais qui bug.
Merci pour votre aide
Sub AjoutDT()
'
' AjoutDT Macro
' Ajouter un DT dans une affaire
'
'
Dim xRg As Range
On Error Resume Next
Application.ScreenUpdating = False
Set xRg = ActiveCell.Offset(1, 0)
xRg.EntireRow.Select
Selection.Insert Shift:=xlDown
Selection.ClearFormats
Application.ScreenUpdating = True
End Sub
Range("A43:A44").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("B43:B44").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("F43").Select
ActiveCell.FormulaR1C1 = _
"=""ICEF-""&RC[-5]&IF(RC[-2]="""","""","" ESM""&RC[-2])&IF(RC[-1]="""","""","" rev""&RC[-1])"
Range("F44").Select
ActiveCell.FormulaR1C1 = _
"=""ICEF-""&R[-1]C[-5]&IF(RC[-2]="""","""","" ESM""&RC[-2])&IF(RC[-1]="""","""","" rev""&RC[-1])"
Range("F44").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G44:H44").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NBCAR(SUPPRESPACE(G44))=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A43:H44").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
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 = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Posté le 27 octobre 2023, 21:39par GillesE
Bonjour Gilles,
je te propose ce fichier : https://www.cjoint.com/c/MJCgeOQlfa0
la cellule active est A2 ; fais Ctrl e ; sélectionne A7 ; fais Ctrl e ;
sélectionne A12 ; fais Ctrl e ; sélectionne A17 ; fais Ctrl e.
(les lettres a à h, c'est pour montrer que ça insère bien 2 lignes entre)
regarde les règles de MFC de la feuille de calcul : tu en verras 4.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
code VBA de Module1 (20 lignes) :
Option Explicit
Sub AjoutDT() 'Ajouter un DT dans une affaire
On Error Resume Next
Dim s$, p&, r&: p = ActiveCell.Row + 1: r = p + 1: Application.ScreenUpdating = 0
Rows(p).Resize(2).Insert 2: Rows(p).Resize(2).Clear
With Cells(p, 1).Resize(2): .HorizontalAlignment = 3: .Merge: End With
With Cells(p, 2).Resize(2): .HorizontalAlignment = 3: .Merge: End With
s = "&IF(D" & p & "="""","""","" ESM""&D" & p & ")&IF(E" & p & "="""","""","" rev""&E" & p & ")"
Cells(p, 6).Formula = "=""ICEF-""&A" & p & s
With Cells(r, 6)
.Formula = "=""ICEF-""&A" & p & Replace$(s, p, r)
.HorizontalAlignment = 3: .VerticalAlignment = 3
End With
With Cells(r, 7).Resize(, 2).FormatConditions
.Add 2, Formula1:="=NBCAR(SUPPRESPACE(G" & r & "))=0": .Parent(.Count).SetFirstPriority
With .Parent.FormatConditions(1): .Interior.Color = 65535: .StopIfTrue = 0: End With
End With
With Cells(p, 1).Resize(2, 8).Borders: .LineStyle = 1: .Weight = 2: End With
End Sub
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
si besoin, tu peux demander une adaptation ;
à te lire pour avoir ton avis. :)
rhodo
Posté le Bonjour Gilles,
Lis d'abord mon post précédent ; après avoir fait les Ctrl e,
tu devras avoir ce qui est sur cette image :
https://www.cjoint.com/c/MKdmSgs6zi0
rhodo