compléter avec des espaces sans tronquer

[C@thy]

Bonjour le forum,

je cherche à compléter le titre de mes colonnes avec des espaces jusqu'à 30 caractères, puis à formater la largeur des mes colonnes ayant un titre sur cette largeur (celle des titres) et faire un renvoi à la ligne automatique lorsque ça dépasse 30 car.

j'ai écrit ceci :

Sub Macro1()
Range("A1", Range("A1").End(xlToRight)).Select
    For Each cel In Selection
        cel.Value = Left(cel.Value & Space(30), 30)
    Next cel
 Selection.Columns.AutoFit
 Selection.CurrentRegion.Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
End Sub

le problème c'est que ça me tronque lorsque le titre a + de 30 car, et ça, il ne faut pas, il faut un renvoi à la ligne auto.
Une idée pour corriger ma macro???

Merci à vous

C@thy

 

[Pierrot93]

Re : compléter avec des espaces sans tronquer

Bonjour C@thy

pas sûr d'avoir tout compris, mais regarde peut être ceci si cela peut t'aider à avancer....

With ActiveCell
    If Len(.Value) <= 30 Then
        .Value = .Value & Space(30 - Len(.Value))
    Else
        .Value = Mid(.Value, 1, 30) & vbLf & Mid(.Value, 31)
    End If
End With

bonne journée
@+

Edition remplacé le < par <=

 

[tototiti2008]

Re : compléter avec des espaces sans tronquer

Bonjour C@thy ,

Peut-être

Sub Macro1()
Dim Texte As String, T As String
Range("A1", Range("A1").End(xlToRight)).Select
    For Each cel In Selection
        Texte = cel.Value & Space(IIf(Len(cel.Value) > 30, 0, 30 - Len(cel.Value)))
        If Len(Texte) > 30 Then
            T = ""
            For i = 1 To Len(Texte) \ 30
                T = T & Mid(Texte, (i - 1) * 30 + 1, 30) & Chr(10)
            Next i
            Texte = Left(T, Len(T) - 1)
        End If
        cel.Value = Texte
    Next cel
 Selection.Columns.AutoFit
 Selection.CurrentRegion.Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
End Sub

Edit : bing, Bonjour Pierrot