[VBA/Excel] Hauteur de ligne

Résolu
grotone Messages postés 14 Date d'inscription   Statut Membre -  
 D.O.C. -
Bonjour,

J'ai un léger problème avec VBA sur Excel.

En cliquant sur un bouton, je veux copier le texte d'une cellule avec pleins de texte dedans (comprendre le texte dépasse du cadre de la cellule, la cellule n'est pas formattée du tout).

Je cherche à copier ce texte dans plusieurs cellules fusionnée ensemble, en formattant le texte pour que celui-ci aille à la ligne, et que la hauteur de la cellule s'ajuste pour qu'on voit le texte dans sa totalité.

Pour le moment, ca veut pas, si je fusionne les cellules puis je copie le texte après, la hauteur de la ligne s'ajuste pas.
Inversement, si je copie d'abord le texte dans une cellule, ca s'ajuste bien la hauteur du texte à cette cellule, mais après quand je fusionne les cellules, ca s'ajuste plus et la hauteur est bien trop grande.

J'ai ici un fichier .xls sous la main pour un peu plus de clarification visuelle si jamais.

Merci d'avance pour l'aide.

a+
Configuration: Windows 2003
Internet Explorer 6.0

3 réponses

  1. Henri_Montreal
     
    Il y a une astuce très simple pour ajuster la hauteur d'une ligne contenant des cellules fusionnées, en gardant l'alignement du texte à gauche :

    Voici mon code, sachant que la plage de cellule s'étend de la colonne C à la colonne K.

    'Ajuste automatiquement la hauteur de ligne
    Function ligne_hauteur(ByVal lngRow As Long)
    Dim strRange As String
    Dim dblHeight As Double

    Application.ScreenUpdating = False

    'Range en cours de modification
    strRange = "C" & lngRow & ":K" & lngRow

    'On enlève la fusion et on centre sur plusieurs cellules
    'pour récupérer la vraie hauteur de la ligne
    With Range(strRange)
    .MergeCells = False
    .Locked = False
    .HorizontalAlignment = xlCenterAcrossSelection
    End With

    'Hauteur réelle de la ligne
    Rows(lngRow & ":" & lngRow).EntireRow.AutoFit
    dblHeight = Rows(lngRow & ":" & lngRow).RowHeight

    'On refusionne et on centre è gauche
    With Range(strRange)
    .MergeCells = True
    .HorizontalAlignment = xlLeft
    End With

    'Ajustement de la hauteur réelle de la ligne
    Rows(lngRow & ":" & lngRow).RowHeight = dblHeight

    'Protection et refresh de l'écran
    Application.ScreenUpdating = True
    End Function

    Et voilou !!! :)

    Henri.
    2
    1. Quart'
       
      Merci beaucoup pour l'astuce !
      0
    2. D.O.C.
       
      Merci Henri_Montreal pour ce gain de temps.
      il semble que ce principe reste le plus rapide de ce que j'ai trouvé pour l'instant.
      avec du code simple et lisible
      Olivier-D.O.C.
      0