Aide sur prog de Sous-totaux et Loop While

[XavierJS]

Bonjour,

Je suis un autodidacte en macro VBA, et bien que je sois assez bon pour m'épater tout seul certaines fois, il y en a d'autres ou je m'exaspère !

Je suis bloqué à cet endroit, et j'ai besoin de la communauté. Voici mon code :

Sub AjoutSousTotauxStatuts(NomFichier As String)
    Dim Wkb As Workbook
    Dim Sht As Worksheet
    Dim CptLigne As Integer, CptLigneSoustotal As Integer
    Dim Total As Double, SousTotal As Double
    
    On Error Resume Next
        Set Wkb = Workbooks.Open(ThisWorkbook.Path & "\" & NomFichier & ".xls")
    On Error Resume Next
    
    If Not Wkb Is Nothing Then
        On Error Resume Next
            Set Sht = Wkb.Sheets("AtToP2010")
        On Error GoTo 0
    
        If Not Sht Is Nothing Then
            CptLigne = 4
            
            Do
                If Sht.Range("B" & CptLigne).Value <> Sht.Range("B" & CptLigne - 1).Value Then
                    If CptLigneSoustotal >= 1 Then
                        Sht.Rows(CptLigne & ":" & CptLigne + 1).Insert
                        Sht.Range("H" & CptLigne).Value = SousTotal

                        CptLigne = CptLigne + 2
                        
                    Else
                        If CptLigne <> 4 Then
                            Sht.Rows(CptLigne).Insert
                            CptLigne = CptLigne + 1
                            Sht.Range("H" & CptLigne).Value = SousTotal
                        End If
                    End If
                    SousTotal = 0
                    CptLigneSoustotal = 0
                End If
                
                SousTotal = SousTotal + Sht.Range("H" & CptLigne).Value
                CptLigneSoustotal = CptLigneSoustotal + 1
                
                Total = Total + Sht.Range("H" & CptLigne).Value
                CptLigne = CptLigne + 1
            Loop While Sht.Range("B" & CptLigne).Value <> ""

            Sht.Range("G" & CptLigne).Value = "TOTAL"
            Sht.Range("H" & CptLigne).Value = Total

Call MiseEnForme(Tableau:="AtToP2010", ShtDst:=Sht, LigneDst:=CptLigne)

            Sht.Rows(CptLigneSoustotal).NumberFormat = "# ### ###\ _€;-# ### ###\ _€"
            Sht.Rows(CptLigneSoustotal).HorizontalAlignment = xlRight
            Sht.Rows(CptLigneSoustotal).IndentLevel = 0
            Sht.Rows(CptLigneSoustotal).Font.Bold = True
            
            Sht.Rows(CptLigne).Font.Bold = True
            Sht.Rows(CptLigne).NumberFormat = "# ### ###\ _€;-# ### ###\ _€"
            Sht.Rows(CptLigne).RowHeight = 40
            Sht.Rows(CptLigne).Insert
            


            Wkb.Save
            Set Sht = Nothing
        End If
    
        Set Wkb = Nothing
    End If
End Sub

Comme vous le voyez, je souhaite créer des sous-totaux des montants de la colonne E en fonction des statuts de la colonne B (Statut 0 à 3). Puis un total global.

Les problèmes que je rencontre :
- Le dernier statut, le 3 donc, ne créé pas de sous-total. Logiquement, je comprends que cela est du à ma loop while, qui s'arrête lorsque la case d'aprés est vide, Mais j'ai beau me creuser la tête, je ne trouve pas de solution alternative (dans celles que je connaisse en tout cas !).
- Je n'arrive pas à mettre en gras les sous-totaux, bien que le Call MiseEnForme ne contienne pas de Font.Bold = True.

Il me semble que ce sont les seules difficultés pour le moment.

Merci de votre aide

Xavier

 

[JNP]

Re : Aide sur prog de Sous-totaux et Loop While

Bonjour XavierJS ,
Pas évident d'analyser un code sans le fichier qui va avec ...
Peut-être

Loop While Sht.Range("B" & CptLigne-1).Value <> ""

Pour la mise en forme, le gras est en dehors de la boucle, ceci expliquant peut-être cela .
Bon courage

 

[Softmama]

Re : Aide sur prog de Sous-totaux et Loop While

Bonjour,

alors au pif, sans trop réfléchir, t'as essayé de mettre :

Do While Sht.Range("B" & CptLigne).Value <> ""
... 'le code
Loop

au lieu de :

Do
... 'le code
Loop While Sht.Range("B" & CptLigne).Value <> ""

car à première vue, tu vérifies pas au bon moment la valeur de cptligne dans ta boucle.

 

[XavierJS]

Re : Aide sur prog de Sous-totaux et Loop While

Merci à vous,

Par contre je vais avoir du mal à envoyer le fichier car confidentiel.

Je vais essayer d'integrer le gras dans la loop avec l'esprit clair demain matin.

En revanche, je comprends pas l'histoire du comptage. Si le code était mal placé, il ne me créerais même pas les sous-totaux pour les autres statuts...?

Alors que c'est bien le cas.

Le problème est qu'a la ligne suivant le dernier statut 3, cela correspond a un "" puisque la case est vide. Ce qu'il me faudrait ce serait un While Row B+1 qui fait quand même la derniere operation avant de s'arreter.

Par traduction litterale, je pensais qu'un Until pourrait faire l'affaire mais je n'ai pas reussi a le coder...

Xav