modifier code pour intégré des options

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

grisan29

XLDnaute Accro
bonjour a vous tous
j'ai un code qui fonctionne bien derrière le commandbutton8 car il envoi les données de la listview dans la feuille "commande" mais lorsqu'il y a des articles qui sont sur 2 lignes (wraptext) comment puis je faire pour que ces articles soit identiquement transmis sur la feuille, sur ce code j'ai fait quelque essai infructueux mais que j'ai laissé
Code:
Private Sub CommandButton8_Click()
    Dim L As Long, C As Byte


    With Worksheets("Commande")
        L = .Range("A65536").End(xlUp).Row
        For i = 1 To Me.ListView1.ListItems.Count
            .Range("A" & L + i).Value = Me.ListView1.ListItems(i).ListSubItems(1).Text
            If UCase(.Range("A" & L + i).Value) <> .Range("A" & L + i).Value Then
                .Range("A" & L + i).Font.Italic = True
            End If
        '<======================================================================================
                    'partie ci dessous qui concerne la modification         '<======================================================================================
        
            If Me.ListView1.ListItems(i).ListSubItems(2).Text <> "" Then
                .Range("B" & L + i).Value = Me.ListView1.ListItems(i).ListSubItems(2).Text 'article
              With .Range("B" & L + i, "F" & L + i)
                .Font.Size = 12
                .Font.Name = "arial"
                .MergeCells = False
                .WrapText = True 'retour du texte à la ligne
                .EntireRow.AutoFit 'mettre la ligne en ajustement auto de la hauteur
                MaHauteur = .RowHeight 'voir quelle est la hauteur de la ligne une fois cet autofit fait
                .MergeCells = True 'refusionner
         
                .VerticalAlignment = xlCenter
                .RowHeight = IIf(MaHauteur > 19, MaHauteur, 19) 'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
      End With
                
                
            End If
        '<===========================================================================================
        
            If Me.ListView1.ListItems(i).ListSubItems(3).Text <> "" Then
            
                .Range("H" & L + i).Value = Me.ListView1.ListItems(i).ListSubItems(3).Text 'unité
            End If
            If IsNumeric(Me.ListView1.ListItems(i).ListSubItems(4)) Then
                .Range("I" & L + i).Value = CDbl(Me.ListView1.ListItems(i).ListSubItems(4).Text) 'q
            End If
            If IsNumeric(Me.ListView1.ListItems(i).ListSubItems(5)) Then
                .Range("G" & L + i).Value = CDbl(Me.ListView1.ListItems(i).ListSubItems(5).Text) 'pu
                .Range("G" & L + i).NumberFormat = "#,##0.00€"
            End If
            '====================================================================
            '==============================tva7================================
            If IsNumeric(Me.ListView1.ListItems(i).ListSubItems(6)) Then
                .Range("K" & L + i).Value = CDbl(Me.ListView1.ListItems(i).ListSubItems(6).Text) 'TVA7=1
                
            End If
            '=============================tva19==================================
            If IsNumeric(Me.ListView1.ListItems(i).ListSubItems(7)) Then
                .Range("K" & L + i).Value = CDbl(Me.ListView1.ListItems(i).ListSubItems(7).Text) 'TVA19=2
                
            End If
            '============================taux tva7====================================
            If IsNumeric(Me.ListView1.ListItems(i).ListSubItems(8)) Then
                .Range("M" & L + i).Value = CDbl(Me.ListView1.ListItems(i).ListSubItems(8).Text) 'taux tva7
                .Range("M" & L + i).NumberFormat = "#,##0.00€"
            End If
            '==============================taux tva 19================================
            If IsNumeric(Me.ListView1.ListItems(i).ListSubItems(9)) Then
                .Range("N" & L + i).Value = CDbl(Me.ListView1.ListItems(i).ListSubItems(9).Text) 'taux tva 19
                .Range("N" & L + i).NumberFormat = "#,##0.00€"
            End If
            '====================================================================================
            '=================================================================================
            If 11 <= Me.ListView1.ListItems(i).ListSubItems.Count Then

                If IsNumeric(Me.ListView1.ListItems(i).ListSubItems(11)) Then

                    .Range("J" & L + i).Value = CDbl(Me.ListView1.ListItems(i).ListSubItems(11).Text) 'q*pu

                    .Range("J" & L + i).NumberFormat = "#,##0.00€"
                End If
              End If
            
                Next i
    '<==========================================================================================================
    '<===========================partie d'essai ci dessous======================================================
                
      ' With .Range("B" & L + i, "F" & L + i)
     ' .Font.Size = 12
       '.Font.Name = "arial"
        ' .MergeCells = False
         '.WrapText = True 'retour du texte à la ligne
         '.EntireRow.AutoFit 'mettre la ligne en ajustement auto de la hauteur
         'MaHauteur = .RowHeight 'voir quelle est la hauteur de la ligne une fois cet autofit fait
         '.MergeCells = True 'refusionner
         
        '.VerticalAlignment = xlCenter
        ' .RowHeight = IIf(MaHauteur > 19, MaHauteur, 19) 'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
      'End With
    '<=====================================================================================================================
    '<=====================================================================================================================
            End With


            Me.ListView1.ListItems.Clear
            TextBox17.Value = ""
            TextBox18.Value = ""
            TextBox10.Value = ""
            TOTTVA.Value = ""
            TextBox12.Value = ""

        End Sub

les autres articles s'écrivent bien en cell"B" mais j'ai penser qu'en fusionnant les cells B à F cela serai mieux que sans car cela fait une longue cellule en coll"B" pour cet article

merci de votre compréhension

je vous joints un fichier exemple, ce sont surtout les articles comme la ligne 22 de la base qui pose problème et je pense que l'on peut appliquer la taille d'écriture autrement que je l'ai fait pour que toute la lignes soit traitées


Pascal
 
Dernière édition:
Re : modifier code pour intégré des options

bonjour a vous tous

j'ai apporter une petite évolution a ce que je demande car maintenant les celllules se formatent mais le wraptext,non l'appel se fait dans le module1
je vous remet le fichier tel que

Pascal
 
Re : modifier code pour intégré des options

bonjour a tous

j'ai finalement réussi a intégré les lignes de codes
donc voici ce que j'ai fait dans la partie incriminée
Code:
             If Me.ListView1.ListItems(I).ListSubItems(2).Text <> "" Then
            
      .Range("D" & L + I) = Me.ListView1.ListItems(I).ListSubItems(2).Text
      Lg_Origine = .Columns(3).ColumnWidth
      LargeurCol = .Columns(3).ColumnWidth + .Columns(4).ColumnWidth + .Columns(5).ColumnWidth + .Columns(6).ColumnWidth + _
         .Columns(7).ColumnWidth + .Columns(8).ColumnWidth
      .Columns(4).ColumnWidth = LargeurCol
      With .Range("D" & L + I, "H" & L + I)
      .Font.Size = 14
       .Font.Name = "arial"
         .MergeCells = False
         .WrapText = True 'retour du texte à la ligne
         .EntireRow.AutoFit 'mettre la ligne en ajustement auto de la hauteur
         MaHauteur = .RowHeight 'voir quelle est la hauteur de la ligne une fois cet autofit fait
         .MergeCells = True 'refusionner
         
        '.VerticalAlignment = xlCenter
         .RowHeight = IIf(MaHauteur > 15, MaHauteur, 15) 'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
         End With
         End If
         'End With
        .Columns(4).ColumnWidth = Lg_Origine

Pascal
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
481
Réponses
4
Affichages
461
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
650
Réponses
2
Affichages
511
Retour