Ajout d'une colonne dans un ficher excel avecc code

mimilamy2000 Messages postés 4 Statut Membre -  
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   -
j'ai voulu rajouter une autre catégorie de contrat et j'ai fait les modif suivante:

ci joint le fichier d'orignie
http://cjoint.com/12dc/BLBoBW9mfYr.htm

code source originale:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dla As Integer, Plage As Range, cel As Range
Dim Contrats_Rouge, Contrats_Noir
Dim CntRouge(8), CntNoir(6)

'pour la dernière ligne de la colonne A
dla = [A:A].Cells(Rows.Count, 1).End(xlUp).Row

<gras>Set Plage = Range("B2:H" & dla)
Erase CntRouge, CntNoir

For Each cel In Plage
If cel <> "" Then
Nb_Cnt = cel
If cel.Font.Color = vbRed Then
Contrats_Rouge = Contrats_Rouge + Nb_Cnt
'Auto Incendie GAV Acc Vie PJ Santé Autre
Select Case Cells(1, cel.Column)
Case "Auto"
CntRouge(0) = CntRouge(0) + Nb_Cnt
Case "Incendie"
CntRouge(1) = CntRouge(1) + Nb_Cnt
Case "GAV"
CntRouge(2) = CntRouge(2) + Nb_Cnt
Case "Vie"
CntRouge(3) = CntRouge(3) + Nb_Cnt
Case "PJ"
CntRouge(4) = CntRouge(4) + Nb_Cnt
Case "Santé"
CntRouge(5) = CntRouge(5) + Nb_Cnt
Case "Autre"
CntRouge(6) = CntRouge(6) + Nb_Cnt
End Select
ElseIf cel.Font.Color = vbBlack Then
Contrats_Noir = Contrats_Noir + Nb_Cnt
'Auto Incendie GAV Acc Vie PJ Santé Autre
Select Case Cells(1, cel.Column)
Case "Auto"
CntNoir(0) = CntNoir(0) + Nb_Cnt
Case "Incendie"
CntNoir(1) = CntNoir(1) + Nb_Cnt
Case "GAV"
CntNoir(2) = CntNoir(2) + Nb_Cnt
Case "Vie"
CntNoir(3) = CntNoir(3) + Nb_Cnt
Case "PJ"
CntNoir(4) = CntNoir(4) + Nb_Cnt
Case "Santé"
CntNoir(5) = CntNoir(5) + Nb_Cnt
Case "Autre"
CntNoir(6) = CntNoir(6) + Nb_Cnt
End Select
Else
End If
End If
Next cel
'Totaux
Range("K9") = Contrats_Rouge
Range("K10") = Contrats_Noir
Range("K7") = Contrats_Rouge + Contrats_Noir
'Details par rubriques
For x = 0 To 6
Cells(4, x + 10) = CntRouge(x)
Cells(5, x + 10) = CntNoir(x)
Next x
End Sub

code source modifié par mes soins

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dla As Integer, Plage As Range, cel As Range
Dim Contrats_Rouge, Contrats_Noir
Dim CntRouge(8), CntNoir(6)

'pour la dernière ligne de la colonne A
dla = [A:A].Cells(Rows.Count, 1).End(xlUp).Row

<gras>Set Plage = Range("B2:I" & dla)
Erase CntRouge, CntNoir

For Each cel In Plage
If cel <> "" Then
Nb_Cnt = cel
If cel.Font.Color = vbRed Then
Contrats_Rouge = Contrats_Rouge + Nb_Cnt
'Auto Incendie GAV Acc Vie PJ Santé Autre Prev
Select Case Cells(1, cel.Column)
Case "Auto"
CntRouge(0) = CntRouge(0) + Nb_Cnt
Case "Incendie"
CntRouge(1) = CntRouge(1) + Nb_Cnt
Case "GAV"
CntRouge(2) = CntRouge(2) + Nb_Cnt
Case "Vie"
CntRouge(3) = CntRouge(3) + Nb_Cnt
Case "PJ"
CntRouge(4) = CntRouge(4) + Nb_Cnt
Case "Santé"
CntRouge(5) = CntRouge(5) + Nb_Cnt
Case "Autre"
CntRouge(6) = CntRouge(6) + Nb_Cnt
Case "Prev"
CntRouge(6) = CntRouge(6) + Nb_Cnt
End Select
ElseIf cel.Font.Color = vbBlack Then
Contrats_Noir = Contrats_Noir + Nb_Cnt
'Auto Incendie GAV Acc Vie PJ Santé Autre Prev
Select Case Cells(1, cel.Column)
Case "Auto"
CntNoir(0) = CntNoir(0) + Nb_Cnt
Case "Incendie"
CntNoir(1) = CntNoir(1) + Nb_Cnt
Case "GAV"
CntNoir(2) = CntNoir(2) + Nb_Cnt
Case "Vie"
CntNoir(3) = CntNoir(3) + Nb_Cnt
Case "PJ"
CntNoir(4) = CntNoir(4) + Nb_Cnt
Case "Santé"
CntNoir(5) = CntNoir(5) + Nb_Cnt
Case "Autre"
CntNoir(6) = CntNoir(6) + Nb_Cnt
Case "Prev"
CntNoir(7) = CntNoir(7) + Nb_Cnt
End Select
Else
End If
End If
Next cel
'Totaux
Range("L9") = Contrats_Rouge
Range("L10") = Contrats_Noir
Range("L7") = Contrats_Rouge + Contrats_Noir
'Details par rubriques
For x = 0 To 7
Cells(4, x + 11) = CntRouge(x)
Cells(5, x + 11) = CntNoir(x)
Next x
End Sub

cependant j'ai une erreur dans le code et un debugage à faire mais je ne comprend pas pourquoi .
je vous met en lien le fichier modifié.

https://www.cjoint.com/?0BvllvtWRVF

A voir également:

2 réponses

gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   4 730
 
Bonjour,

Si tu ajoutes une colonne, il faut aussi agrandir les compteurs :
Dim CntRouge(8), CntNoir(6) 
1
mimilamy2000 Messages postés 4 Statut Membre
 
Bonjour Merci pour votre réponse qui fonctionne
j'ai modifié par
Dim CntRouge(9), CntNoir(7) au lieu de Dim CntRouge(8), CntNoir(6)
Par contre pourqu'oi ce n'est pas Dim CntRouge(9), CntNoir(9)
j'avoue ne pas comprendre

merci d'avacne
0
gbinforme Messages postés 15481 Date d'inscription   Statut Contributeur Dernière intervention   4 730
 
Bonjour,

Tu as raison de te poser la question mais je crois que la bonne solution était d'utiliser ton nombre de colonnes représentant les types de contrats 7 :

Dim CntRouge(7), CntNoir(7) 

Sans doute que le doigt de Michel avait fait une erreur de touche qui ne prêtait pas à conséquence car elle réservait 2 postes inutilisés, par contre, dans ta modif tu as oublié de corriger un 6 en 7 après la copie et là, l'erreur se fera dans tes rouges :

              CntRouge(6) = CntRouge(6) + Nb_Cnt  
            Case "Prev"  
              CntRouge(6) = CntRouge(6) + Nb_Cnt  
0