Réduction code de l'enregistreur

bonjour a vous tous

j'essaie de créer des bordures automatiquement autour des cellules ("F24:G25") et l'enregisteur de macros ma fait ceci

with.Range("F24:G25")
.Borders(xlDiagonalDown).LineStyle = xlNone
 .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 with

que j'ai commencé a modifier mais je suis bloqué et doit m'en remettre a vos compétences car je suis sur que l'on peux le réduire, car il y a plusieures lignes qui se répètent

Pascal

Pascal

re

j'ai essayer comme ceci et ça ne bug pas mais a confirmer auprès de pros

 With .Range("F24:G25")
.Borders(xlDiagonalDown).LineStyle = xlNone
 .Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
   .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
With .Borders
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End With

Pascal

edit dans les cellules ("G24") et ("G25") il faudrai pouvoir réinscrire également en même temps la formule

pour G24

=DECALER(F51;-4;10)

qu'il y avait sur la feuille avant effacement et

pour G25

=DECALER(F51;-4;9)

Pascal

bonjour

pour les formules j'ai essayer comme ceci et cela fonctionne

    .Range("G24").FormulaR1C1 = "=OFFSET(R[0]C[-1],-4,10)"
    .Range("G25").FormulaR1C1 = "=OFFSET(R[0]C[-1],-5,9)"

fait également par l'enregistreur

Pascal

Bonjour

Pour les bordures, généralement cela suffit

Sub testbis()
  Sheets(1).Range("F24:G25").Borders.Weight = xlThin
End Sub

Et ensuite 2 lignes de code pour tes formules

bonjour Banzai64

WAOUH ça c'est ce qui s'appelle de la réduction merci beaucoup

Bon après midi

Pascal

bonjour banzai64

merci pour ta réponse qui fonctionne merveilleusement maintenant je faudrais pouvoir mettre toutes les lignes du code en

With .Font
              .Size = 14
              .Name = "Arial"
          End With

en même temps, plutôt que de le faire ligne par ligne

voici le code

.Range("F74:G75").Borders.Weight = xlThin
    .Range("G74").FormulaR1C1 = "=OFFSET(R[-60]C[-1],-4,10)"
    .Range("G75").FormulaR1C1 = "=OFFSET(R[-61]C[-1],-5,9)"
    .Range("L76").FormulaR1C1 = "=OFFSET(R[-1]C,-6,0)"
    .Range("L76").NumberFormat = "#,##0.00 €"
    .Range("E77").HorizontalAlignment = xlRight
    .Range("E77").Font.Bold = True
    .Range("F74").Value = "TVA2 = 20%"
    .Range("F75").Value = "TVA1 = 10%"
    .Range("J76").Value = "ACOMPTE RECU"
    .Range("J76").Font.Bold = True
    .Range("J76:K76").Merge True
    .Range("J76:K76").HorizontalAlignment = xlRight
    .Range("C72").Value = "Arrêtée la présente facture à la somme de : "
    .Range("L76").Name = "MTTC"
   .Range("C73").Formula = "=chiffrelettre(MTTC)"
    'Application.Calculate
    .Range("E77").Value = "mode de paiement"
    .Range("F77").Value = "par chèque "

Pascal

re

j'ai finalement trouvé qu'il fallait étendre la plage a

With .Range("C72:L77").Font
        .Name = "Arial"
        .Size = 14
    End With

pour que cela fonctionne

Merci pour tout

Pascal

Bonjour

A tester : Peut être que l'on peut simplifier encore

Sub test()
  With Sheets(1)
    .Range("F74:G75").Borders.Weight = xlThin
    .Range("G74").FormulaR1C1 = "=OFFSET(R[-60]C[-1],-4,10)"
    .Range("G75").FormulaR1C1 = "=OFFSET(R[-61]C[-1],-5,9)"
    With .Range("L76")
      .FormulaR1C1 = "=OFFSET(R[-1]C,-6,0)"
      .NumberFormat = "#,##0.00 €"
      .Name = "MTTC"
    End With
    With .Range("E77")
      .Value = "mode de paiement"
      .HorizontalAlignment = xlRight
      .Font.Bold = True
    End With
    .Range("F77").Value = "par chèque "
    .Range("F74").Value = "TVA2 = 20%"
    .Range("F75").Value = "TVA1 = 10%"
    With .Range("J76:K76")
      .Font.Bold = True
      .Merge True
      .HorizontalAlignment = xlRight
    End With
    .Range("J76").Value = "ACOMPTE RECU"
    .Range("C72").Value = "Arrêtée la présente facture à la somme de : "
    .Range("C73").Formula = "=chiffrelettre(MTTC)"
    'Application.Calculate
    With .Range("F74:G75,J76:L76,E77:F77,C73:C73").Font
      .Size = 14
      .Name = "Arial"
    End With
  End With
End Sub

re Banzai64

Merci ta dernière réduction rends le code beaucoup moins fouillis que tel que je l'avais fait et fonctionne très bien

merci beaucoup de ton implication et de tes solutions

Pascal