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 :
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
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 :
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