Mettre à la ligne avec ses formes

Re

J'ai trouvé une solution :

Vu que la longueur de la colonne contient 47 caractères :

With Rows(L & ":" & L)
            Entier = (Len(Range("C20").Value) / 47 = Len(Range("C20").Value) \ 47)
            If Entier = False Then
                hl = Len(Range("C20").Value) \ 47 + 1
            Else
                hl = Len(Range("C20").Value) / 47
            End If
            .RowHeight = hl * 15
            .VerticalAlignment = xlCenter
        End With

Déclarer au préalable Entier en boolean

Bonne chance

Bonsoir Patty5046, LouReeD

Encore merci de votre aide, c'est sympa.

Désolé pour me réponse tardive , mais WE oblige Lol.

J'ai testé vos propositions, et en dernier le code de Patty5046 ou il me ressort un bug sur ce code,

.RowHeight = hl * 15

Signale Range introuvable malgré la déclaration des variables

Dim Entier As Boolean, hl As Boolean

Ce devient énervant Grrrrrr

Si il n'y a pas de solution pour ce cas , est il possible de faire autrement au niveau du code ?

Cdlt

Bonsoir,

hl étant le résultat de la partie entière d'un calcul mieux vaut le mettre en "Integer"

@ bientôt

LouReeD

Re,

J'ai pas fais gaffe, c'est surement la fatigue du we

Effectivement cela fonctionne beaucoup mieux avec Integer. après quelques essais cela donne le resultat attendu.

Je pousuivrai les essais demain pour en être plus sur mais je mets tout de même le post en résolu.

Grand, grand merci à vous 2 pour votre aide.

Certainement à bientôt, je dois finaliser ce fichier maintenant en archivent cet onglet MC Vierge.

Merci LouReeD, Patty5046.

Cdlt

pompaero

Bonjour,

merci @ vous et @ Patty5046

@ bientôt

LouReeD

Re bonjour,

je me suis mis à cherche sur le net et en fin de compte il ne m'aura pas fallu longtemps pour trouver...

Voici le code, qui fait appel à une procédure "de mise en forme" :

Sub Cmd_Valider_Click()
    'Pour le bouton Nouveau contact, saisissez à la suite :
    'Pour le bouton Nouveau contact
    Dim L As Integer

    If Range("B20") = "" Or Range("C20") = "" Or Range("N20") = "" Then
        MsgBox ("Des informations sont manquantes !!")
        Exit Sub
    End If

    If MsgBox(" Confirmez-vous cet évènement ? ", vbYesNo, " Demande de confirmation d’ajout ") = vbYes Then
        Application.ScreenUpdating = False
        L = ActiveSheet.Range("B999999").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne vide du tableau
        With Range("B" & L)
            .Value = Format(Range("B20"), "hh:mm")
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Font.Size = 11
        End With

        With Range("C" & L & ":L" & L)
            .Merge
            .Font.Size = 11
            .WrapText = True
            .Value = Range("C20")
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
        Range("C" & L & ":L" & L).Select
        Call AutoFitMergedCellRowHeight

        With Range("M" & L)
            If Range("M20") <> "" Then
                .Value = Format(Range("M20"), "hh:mm")
            Else
                .Value = Format(Time, "hh:mm")
            End If
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Font.Size = 11
        End With

        With Range("N" & L & ":Q" & L)
            .Merge
            .Value = Range("N20")
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Font.Size = 11
        End With
        With Rows(L & ":" & L)
            .VerticalAlignment = xlCenter
        End With
        [B20:Q20].ClearContents
        Range("B21").Select
    End If

End Sub
' trouvé sur le net
Sub AutoFitMergedCellRowHeight()
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If ActiveCell.MergeCells Then
        With ActiveCell.MergeArea
            .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
            If .Rows.Count = 1 Then 'And .WrapText = True Then
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
End Sub

De mon coté cela marche bien.

@ bientôt

LouReeD

Re LouReeD

Bien le code !!! je fais des essais depuis ce matin, ça marche nickel.

Merci pour ta recherche, tu n'étais pas obligé.

Encore merci à toi et patty.

@ bientôt

Cdlt

Mais de rien, vos recherches ne me sont pas inutiles !

@ bientôt

LouReeD