Concatener avec mise en place spéciale

Bonjour

Je cherche par concaténation a mettre 2 cellules dans une mais avec un placement des caractères

un peu spécial.

Est ce possible?

Merci pour votre aide

Bonjour,

Je pense que vous pourriez le faire avec un groupement de 2 formes ajusté à la taille de la cellule. Mais après, adieu les calculs.

Bonjour Eric

Merci pour ta réponse mais cela ne fonctionne pas.

Crdlt

Bonjour Joco7915

Pourquoi ne pas faire 2 colonnes de largeur 5 et mettre côte à côte les valeurs avec le format souhaité

En tout cas avec concaténer, c'est impossible

A+

Bonjour Bruno,

Merci pour ton aide

J'avais essayé ce que tu préconises mais pour ce que je veux faire ça ne va pas.

je clos le sujet

Merci pour vos réponses

Comme suite à mon premier message, deux possibilités :

• On copie les deux cellules en tant qu'image et on la réduit à la taille de la cellule C6. Nb : Il faudra augmenter la taille des textes en C4 et C5 pour obtenir la proportion en C6. Dans l'exemple, la procédure est rendue paramétrique pour traiter plusieurs cellules sur la ligne 4.

  Option Explicit
  
  Sub ConcatenerLesCellules(ByVal CellRef As Range)
  
  Dim ShCellule As Worksheet
  Dim NbShapes As Integer
  Dim MaForme As Shape
  
      Set ShCellule = CellRef.Parent
      With ShCellule
           NbShapes = .Shapes.Count + 1
           .Range(CellRef, CellRef.Offset(1, 0)).CopyPicture Appearance:=xlScreen, Format:=xlPicture
           .Paste
           Set MaForme = .Shapes(NbShapes)
           With MaForme
                .Name = "Forme" & NbShapes
                .LockAspectRatio = msoFalse
                .Top = CellRef.Offset(2, 0).Top
                .Height = CellRef.Offset(2, 0).Height
                .Left = CellRef.Offset(2, 0).Left
                .Width = CellRef.Offset(2, 0).Width
           End With
  
      End With
  
      Set ShCellule = Nothing: Set MaForme = Nothing
  
  End Sub
  
  Sub TestConcatenerLesCellules()
  
  Dim I As Integer
  
      With ActiveSheet
           ActiveWindow.DisplayGridlines = False
           For I = 2 To 3
               ConcatenerLesCellules .Cells(4, I)
           Next I
      End With
  
  End Sub

• On crée deux formes que l'on groupe et qu'on réduit à la taille de la cellule C6.

Option Explicit

Sub ConcatenerAvecFormes()

Dim Cellule1 As Range, Cellule2 As Range, CelluleDest As Range
Dim Shape1 As Shape, Shape2 As Shape, ShapeFin As Shape

    Range("C4").Activate
    Set Cellule1 = ActiveCell
    Set Cellule2 = ActiveCell.Offset(1, 0)
    Set CelluleDest = ActiveCell.Offset(2, 0)

    With ActiveSheet
         Set Shape1 = .Shapes.AddShape(msoShapeRectangle, CelluleDest.Left + 1, CelluleDest.Top + 1, CelluleDest.Width - 4, 40)
         Shape1.Name = "Forme" & ActiveSheet.Shapes.Count
         Set Shape2 = .Shapes.AddShape(msoShapeRectangle, CelluleDest.Left + 1, CelluleDest.Top + CelluleDest.Height - 2, CelluleDest.Width - 4, 20)
         Shape2.Name = "Forme" & ActiveSheet.Shapes.Count
         .Shapes.Range(Array(Shape1.Name, Shape2.Name)).Select
         Selection.ShapeRange.Group.Select
         Selection.Name = "Forme" & .Shapes.Count
         Set ShapeFin = .Shapes("Forme" & .Shapes.Count)
    End With

         With Shape2
              With .TextFrame2.TextRange
                   .Text = Cellule2
                   .ParagraphFormat.Alignment = msoAlignRight
                   With .Font
                        .Size = 10
                        .Bold = msoTrue
                        .Fill.ForeColor.RGB = RGB(0, 0, 0)
                   End With
             End With
             With .Fill
                  .Visible = msoTrue
                  .ForeColor.RGB = RGB(255, 255, 255)
             End With

             .Line.Visible = msoFalse
             .TextFrame2.VerticalAnchor = msoAnchorBottom

         End With

          With Shape1
              '.Name = "Forme" & ActiveSheet.Shapes.Count
              With .TextFrame2.TextRange
                   .Text = Cellule1
                   .ParagraphFormat.Alignment = msoAlignLeft
                   With .Font
                        .Size = 24
                        .Bold = msoTrue
                        .Fill.ForeColor.RGB = RGB(0, 0, 0)
                   End With
               End With
                With .Fill
                     .Visible = msoTrue
                     .ForeColor.RGB = RGB(255, 255, 255)
               End With
               .Line.Visible = msoFalse
               .TextFrame2.VerticalAnchor = msoAnchorTop
         End With

         With ShapeFin
              .Top = CelluleDest.Top
              .Left = CelluleDest.Left
              .Width = CelluleDest.Width
              .Height = CelluleDest.Height
         End With

     Set Shape1 = Nothing: Set Shape2 = Nothing:  Set ShapeFin = Nothing

End Sub