modifier code pour intégré des options

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:

grisan29

XLDnaute Accro
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
 

grisan29

XLDnaute Accro
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
 

Discussions similaires

Réponses
4
Affichages
209
Réponses
1
Affichages
242

Statistiques des forums

Discussions
312 196
Messages
2 086 098
Membres
103 116
dernier inscrit
kutobi87