Problème mise à jour

[benjisan]

Bonjour à tous,

J'ai un petit problème j'ai un classeur excel dans celui-ci j'ai une sheet bon de commande vierge (nommée : Com Ini) avec un bouton qui me permet de créer autant de sheet que de bon de commande.

Maintenant je voudrais qu'il totalise la somme des bon de commande dans une sheet (nommée : Total Com)

Exemple : 3 bons de commande (Com003, Com002, Com001)
Dans la cellule C18 de Com003 = 3
Dans la cellule C18 de Com002 = 2
Dans la cellule C18 de Com002 = 1

Et je voudrais donc que dans la cellule C18 de ma sheet Total Com il indique 6 et que celle valeur soit mise à jour automatiquement si on touche à un des autres valeurs.

J'ai essayé via une formule de somme en vba mais cela ne fonctionne malheureusement pas

Pourriez-vous m'aider

Je vous joint mon fichier excel

D'avance merci

 

[benjisan]

Re : Problème mise à jour

OK, j'ai bien trouvé la solution, mais j'ai toujours un petit problème.
Je voudrais qu'il repasse dans ma fonction calcul pour calculer la somme même si on supprime une des sheets

Encore merci à tous

 

[Bigfish]

Re : Problème mise à jour

Salut,

Dans un module tu ajoutes ce code:

Sub MiseAJour()
    Application.EnableEvents = False
   With Sheets("Total Com").Range("C18"). ClearContents
    For i = 1 To Worksheets.Count
        If Not Sheets(i).Name = "Total Com" Then
            With Sheets("Total Com").Range("C18")
                .Value = .Value + Sheets(i).Range("C18").Value
            End With
        End If
    Next
    Application.EnableEvents = True
End Sub

Dans le code du ThisWorkBook de ton projet:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Sh.Name = "Total Com" Then
        If Target.Address = "$C$18" Then
            MiseAJour
        End If
    End If
End Sub

Tu peux aussi essayer d'utiliser ce code a la place du precedent qui a l'avantage d'etre plus rapide car il ne contient pas de boucle

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim NewValue As Variant
    If Not Sh.Name = "Total Com" Then
        If Target.Address = "$C$18" Then
            'on met de coté la nouvelle valeur
            NewValue = Target.Value
            Application.EnableEvents = False
            'on retourne a la valeur precedente
            Application.Undo
            With Sheets("Total Com").Range("C18")
                'on soustrait la precedente valeur et ajoute la nouvelle
                .Value = (.Value - Target.Value) + NewValue
            End With
            'on remet en place la nouvelle valeur
            Target.Value = NewValue
            Application.EnableEvents = True
        End If
    End If
End Sub

Par contre avec ce code l'addition en C18 de la feuille Total Com doit avoir été mis à jour au moins une fois à l'aide de la macro MiseAJour.

Dans tout les cas je te conseil d'avoir sur la feuille Total Com un bouton qui lance la macro MiseAJour pour te permetre d'etre sur de la valeur en C18. Car il est toujours possible qu'une des autres feuilles ai changer alors que les macros etaient desactivées.

A+ 🙂

 

[Bigfish]

Re : Problème mise à jour

Salut,

désolé nos postes ce sont croisés.

le code MiseAJour que je t'ai donné contenait une erreur que j'ai corrigé.

je te redonne quand meme ce code ici :

Sub MiseAJour()
    Application.EnableEvents = False
    Sheets("Total Com").Range("C18"). ClearContents
    For i = 1 To Worksheets.Count
        If Not Sheets(i).Name = "Total Com" Then
            With Sheets("Total Com").Range("C18")
                .Value = .Value + Sheets(i).Range("C18").Value
            End With
        End If
    Next
    Application.EnableEvents = True
End Sub

Pour l'histoire de la mise à jour si une feuille est supprimée le mieux est de de compter le nombre de feuille à l'ouverture de ton fichier et de mettre le resultat quelque par dans ton fichier par exemple la feuille "Total Com" comme ceci

Private Sub Workbook_Open()
    Worksheets("Total Com").[A1].Value = Sheets.Count
End Sub

puis de verifier à chaque activation de feuille si le nombre de feuille courant est plus petit que le nombre de feuille enregistré.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Worksheets("Total Com").[A1].Value > Sheets.Count Then
        Worksheets("Total Com").[A1].Value = Sheets.Count
        MiseAJour
    End If
End Sub

Pourquoi l'evenement Workbook_SheetActivate ? et bien a chaque fois qu'une feuille est supprimée une autre feuille sera automatiquement activée d'ou l'interet de l'utilisation de cet evenement.

A+ 🙂

 

[Gael]

Re : Problème mise à jour

Bonsoir Benjisan, bonsoir Bigfish,

Une solution possible en rajoutant 2 feuilles "Debut" et "Fin" qui seront masquées et en utilisant en C18 de "Total Com" une formule 3D:

=SOMME(Debut:Fin!C18)

Modifs à faire dans la macro:

Private Sub cmd_onglet_Click()
Dim nbonglet, ind_onglet As Integer
Dim nom_onglet As String
Dim nb_nouv_onglet, val_prec_onglet
[COLOR=navy]Sheets("fin").Visible = True[/COLOR]
    nbonglet = Sheets.Count
    'nom_onglet = Sheets(nbonglet).Name
    ind_onglet = Sheets("Com ini").Index
    
    [COLOR=navy]nb_nouv_onglet = (nbonglet - ind_onglet) - 1[/COLOR]
    
    If nb_nouv_onglet = 1 Then
    
        nb_nouv_onglet = Format(nb_nouv_onglet, "000")
        
    Else
        [COLOR=navy]nom_onglet = Sheets(ind_onglet + 2).Name[/COLOR]
        val_prec_onglet = Right(nom_onglet, 3) + 1
        nb_nouv_onglet = Format(val_prec_onglet, "000")
    End If
    
    [COLOR=navy]Sheets("Com Ini").Copy Before:=Sheets("Fin")
[/COLOR]    ActiveSheet.Name = "Com" & nb_nouv_onglet
    Sheets("Com" & nb_nouv_onglet).Tab.ColorIndex = 4
        
    Sheets("Com" & nb_nouv_onglet).cmd_onglet.Visible = False
    [COLOR=navy]Sheets("fin").Visible = False[/COLOR]
        
End Sub

De cette façon, les nouvelles feuilles seront toujours entre "Debut" et "Fin" et la formule restera correcte quelles que soient les feuilles supprimées.

@+

Gael

 

[benjisan]

Re : Problème mise à jour

Merci à tous pour vos réponses.

J'ai également trouvé une solution

Bonne journée à tous
A très bientôt sur le forum