Toujours Ecrire en partant de la gauche dans une cellule

[yves03]

Bonjour à tous,

J'utilise cette macro pour copier des lignes sur une autre feuille, cela fonctionne tres bien, par contre je voudrais toujours forcer l'ecriture en partant de la gauche pour la colonne A.
Si vous avez une idée .

Merci d'avance

Option Explicit

Dim sh5 As Worksheet
Dim sh6 As Worksheet


Sub HistoriqueCde()

    
    Dim PlageCodes As Range, r As Range
    Dim ModeCalcul
    Dim cpt As Long 'compeur du nombre de lignes écrites
    
    On Error GoTo FinEcritures
    
    'Pour accélérer les écritures
    ModeCalcul = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    'Références aux feuilles de travail
    Set sh5 = Sheets("Pieces A Cder")
    Set sh6 = Sheets("Historique Cde")
    
    
    With sh5
        ' Réferences à la plage de cellules qui contient les codes
        Set PlageCodes = .Range("D3:D" & .Range("D" & .Rows.Count).End(xlUp).Row)
        
    End With
    
             
    ' Pour chaque ligne de la plage de code
    For Each r In PlageCodes.Rows
        ' Ecriture des lignes si elles ne sont pas vides
        If r.Cells(1, 1).Text >= 0 Then EcrireLigne r.Cells(1, 1): cpt = cpt + 1
                 
    Next r
    
FinEcritures:
    ' Rétablir la mise à jour écran
    Application.ScreenUpdating = True
    
    ' Rétablir le mode de calcul par défaut
    Application.Calculation = ModeCalcul
    
    ' Signaler une erreur éventuelle
    If Err.Number > 0 Then
    
        MsgBox Err.Description & vbCrLf & "Fin de la macro", vbExclamation, "LignesEcritures"
            
    End If
    
    
    
End Sub

Private Sub EcrireLigne(c As Range)
    
   Dim derLigne As Long
   Dim cRow As Long
   cRow = c.Row
    
   On Error GoTo FinEcrireLigne
    
    With sh6
       derLigne = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        If derLigne = 2 Then derLigne = 3
       .Cells(derLigne, 1) = sh5.Cells(cRow, 1)
       .Cells(derLigne, 2) = sh5.Cells(cRow, 2)
       .Cells(derLigne, 3) = sh5.Cells(cRow, 3)
       .Cells(derLigne, 4) = sh5.Cells(cRow, 4)
       .Cells(derLigne, 5) = Now
       MiseEnForme .Range(.Cells(derLigne, 1), .Cells(derLigne, 5))
    End With
       
    
FinEcrireLigne:
    If Err.Number > 0 Then
        MsgBox "Une erreur c'est produite pendant l'écriture de la ligne de compte n° " _
                & c.Value, vbExclamation, "EcrireLigne"
    End If
End Sub

Private Sub MiseEnForme(Cellules As Range)
    On Error GoTo FinMiseEnForme
    With Cellules
        With .Interior
            .ColorIndex = 2
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 1
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 1
        End With
        With Cellules.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 1
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 1
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 1
        End With
    End With

FinMiseEnForme:
    If Err.Number > 0 Then
        MsgBox "une erreur s'est produite lors de la mise en forme de la ligne: " _
                & Cellules.Row & vbCrLf & "sur la feuille " & sh6.Name, vbExclamation, "MiseEnForme"
    End If
End Sub

 

[mécano41]

Re : Toujours Ecrire en partant de la gauche dans une cellule

Bonjour,

Si tu veux que les caractères dans la colonne A soient alignés à gauche, tu ajoutes la quatrième ligne ci dessous :

Private Sub MiseEnForme(Cellules As Range)
    On Error GoTo FinMiseEnForme
    With Cellules
        [COLOR="Red"].Cells(1).HorizontalAlignment = xlLeft[/COLOR]
        With .Interior
            .ColorIndex = 2

Pour info. il y a eu des choses dites sur le même genre de code que le tien, cela pourrait peut-être t'intéresser. C'est ici :

https://www.excel-downloads.com/threads/mise-en-forme-avec-une-macro.102899/

Cordialement

 

[yves03]

Re : Toujours Ecrire en partant de la gauche dans une cellule

Merci beaucoup de ton aide, je vais aller voir le lien que tu m'as indiqué.
Bon Dimanche.