Encadrement de cellulesRésolu

Question

Bonjour, 

j'ai un code qui me génère automatiquement un échéancier en fonction du nombre de périodes de remboursement, mais j'ai un problère: je n'arrive pas à faire que les nouvelles lignes soient automatiquement encadrées. Est-ce que quelqu'un aurait une proposition? merci d'avance.

Voila le code:

Sub Bouton1_Clic()


Const fdg As Double = 0.1
Dim montant As Double
Dim tau As Double
Dim tau2 As Double
Dim dur As Integer
Dim dep As Date
Dim differ As Single
Dim maf As Worksheet
Dim index As Long
Dim rbt As Currency
Dim jour As Date
    Set maf = Sheets("Echéancier")
    maf.Range("A18:F419").ClearContents
    montant = maf.Range("d4")
    tau = maf.Range("d5")
    tau2 = maf.Range("d5") / 12 / 100
    dur = maf.Range("d6")
    differ = maf.Range("d8")
    rbt = (montant * (-tau2) * (1 + tau2) ^ dur) / (1 - (1 + tau2) ^ dur)
    dep = maf.Range("d7")
    For index = 1 To differ + dur
    maf.Range("a" & index + 17) = index
    jour = DateSerial(Year(dep), Month(dep) + index, Day(dep))    If Weekday(jour, 2) 6 Then jour jour - 1    If Weekday(jour, 2) 7 Then jour jour + 1
 
    maf.Range("b" & index + 17) = Format(jour, "dddd")
    maf.Range("c" & index + 17) = jour
        If index <= differ Then
        maf.Range("d" & index + 17) = montant * tau / 1200
        maf.Range("e" & index + 17) = montant * fdg / (dur + differ)
        maf.Range("f" & index + 17) = (montant * tau / 1200) + (montant * fdg / (dur + differ))
        Else
        maf.Range("d" & index + 17) = rbt
        maf.Range("e" & index + 17) = montant * fdg / (dur + differ)
        maf.Range("f" & index + 17) = rbt + (montant * fdg / (dur + differ))
        End If
        Next index
        
End Sub

cs_Frederic45 · Accepted Answer

Re

Essaie ceci :

derligne = Range("a65536").End(xlUp).Row

    'tous les côtés des cellules
Range("a18:d" & derligne).Borders.LineStyle = xlContinuous

    'encadrement seulement autour des cellules
Range("a18:d" & derligne).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("a18:d" & derligne).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("a18:d" & derligne).Borders(xlEdgeRight).LineStyle = xlContinuous
Range("a18:d" & derligne).Borders(xlEdgeLeft).LineStyle = xlContinuous

Je pense qu'il y a plus simple pour l'encadrement

Frédéric

cs_Frederic45 · Answer

Bonjour à tous
Bonjour Landoltp

Essaie avec cette ligne de code : 
Worksheets(1).Range("D6:I6").Borders.LineStyle = xlContinuous
à adapter bien sur

Dis nous si cela te va

Frédéric

Landoltp · Answer

Merci pour ta proposition, mais ça ne joue pas (ou alors je l'adapte mal), ce qu'il faudrait c'est que ça m'encadre les cellules A18:D18 jusqu'à la dernière ligne ou il y a un paiement. je sais pas si c'est très clair...

Landoltp · Answer

Ca fonctionne, mais il reste un problème: c'est que si j'ai fait un test avec, par exemple, 20 mensualités et qu'après j'en fait un avec moins de mensualités il me laisse les cellules encadrées même s'il n'y a rien dedans.

cs_Frederic45 · Answer

Re

Pour effacer, à la place de "xlcontinuous" tu écris "xlnone", comme par exemple :

Range("a18:d65536").Borders.LineStyle = xlnone ou 
Range("a18:d65536").Borders.LineStyle = delete

Frédéric

Landoltp · Answer

oui mais là il m'efface tous les encadrements et je voudrais qu'il me laisse uniquement ceux ou il y a quelque chose à l'intérieur des cellules.
j'ai essayé comme ça mais ça fonctionne pas: Range(derligne & "a65536 : f65536").Borders.LineStyle = xlNone

cs_Frederic45 · Answer

Re

Tu mets ce code avant de faire les bordures

Frédéric

Landoltp · Answer

Merci beaucoup

cs_MPi · Answer

Une façon serait de mettre à quelque part (autre colonnes masquées, autre feuille, ...) le format de cellules comme tu les veux. Tu n'auras qu'à faire un copier/coller du format de ces cellules par la suite.

MPi²

Encadrement de cellules

9 réponses

Votre réponse

Discussions similaires