Sous totaux dans feuille

[Christophe]

Hello forum,

Au cas ou Denis tombe sur ce message tu vois je reitere ma quest car je m'en sort pas avec mon pb.
Dans une feuille de mon classeur j'ai des sous totaux qui somme des cellule de la colonne au dessus de la cellule somme. Le nombre de ces cellule au dessus est variable. J'aimerais faire le somme jusqu'a une case vide et ds mes recherches j'ai trouvé le code svt :

with activeCell
set plage = Range(.offset(1), .offset(1).End(xlDown))
.Formula = "SUM(" & Plage.adresse(RowAbsolute :=False, _ ColumnAbsolute:=False) &) ")"
.Copy Destination:=Range(.Cells(1), .offset(1).End(xlToRight).offset(-1))
End with

Je suis casi sur en analysant le code que c'est ce que je veu faire mais comment l'utiliser ou....???? voila mes interogation

Merci a Tous(tes) d'avance !!

 

[Denis]

Bonjour Christophe et le Forum
ne désespère pas , pour ma part je suis toujours sur ton problème
j'ai une petite idée sur la question en utilisant Function, mais je n'arrive pas encore à utiliser des plage variables
je te tiens au courant dès que j'ai du nouveau
Courage et @+ Denis
PS garde le même fil sinon on va se perdre dans tous les messages

 

[Christophe]

Super Denis OK je continue a bosser aussi de mon coté Merci.

 

[Christophe]

Ola forum et Denis mon collegue des sous totaux,
bon j'avance j'ai une sub qui marche mais pour la transformer en function it's difficult voila le code :

Sub SousTot()
With ActiveCell
Set Plage = Range(.Offset(-1), .Offset(1).End(xlUp))
.Formula = "=SUM(" & Plage.Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
End With
End Sub




Function test(celluleactive)
celluleactive.Activate
' With ActiveCell
Set Plage = Range(.Offset(-1), .Offset(1).End(xlUp))
.Formula = "=SUM(" & Plage.Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
' End With
End Function

donc la sub marche mais la fct non a mon grand regret !! !! ! !! !

 

[Christophe]

Au fait la fin du mess est merci a plus

 

[Denis]

Salut Christophe
je t'avais envoyé vendredi un super programme mais je ne sais pas ou il est passé, je ne le vois pas sur ce fil (j'ai du me tromper de fil ou il n'est pas passé
un click droit et tu as ta somme quelque soit la cellule ou tu te trouve
je recherche ca et te l'envoie au plus tard lundi midi
en attendant courage
@+ Denis

 

[Denis]

Bonjour Christophe et le forum
ci-joint le fichier
il se met en place automatiquement quand tu l'ouvres
il te suffit de recopier dans ton classeur (n'oublies pas de changer le nom de feuille)
il y a du code dans thisworkbook et dans le module
ensuite sur ta feuille, tu selectionnes une cellule sous ta colonne à additionner, et tu clique droit tu auras somme_spéciale qui s'affiche
Amuses toi bien et @+
Denis

 

[Celeda]

Re:

Bonjour,

Et si on veut se débarasser complètement ''de somme_spéciale qui s'affiche'' et qui reste dans la souris malgrè tous mes efforts pour savoir comment l'enlever (j'ai lu relu relelu relulurelu les codes sans effet), on fait comment silvouplait ?- un grand merci.

Celeda
l

 

[Pat5]

Bonjour tout le monde

Bon dimanche à tous.

Pourrait-on répondre à Celeda, SVP, car elle a l'air d'être embété et je ne

voudrais pas l'être moi aussi.

Donc j'attends avant d'essayer car ça a l'air bien ce petit fichier.

Désolé Celeda mais tu sers de testeuse Béta (lol)

A++

Pat5 ;o)

 

[Celeda]

Bonjur,

Hé je t'adore Pat5 : c'est bon de ne ne pas se sentir isolée sur son ile car n'oublie pas que moi aussi je suis sur une île !!!

alors entre gens d'île (gentil ...bon y a mieux mais j'ai trouvé cela rigolo...lol!) on partage les mêmes soucis : traverser des ponts pour se rapprocher des autres - prendre un avion pour aller plus vite - lire XLD et essayer de répondre aux autres...ect......

Oui il est bien son petit truc pour faire les totaux sauf que Somme Speciale reste dans le menu. Et la procédure est telle que je ne comprends pas bien comment l'enlever. Car la question :

- si le menu Somme Speciale reste dans la souris c'est qu'il est collé un peu comme une xla ? non ? sauf que quand j'ai sauvegardé le fichier je l'ai pas sauvegardé en tant xla ?? alors je comprends pas. Je pensais simplement que SommeSpeciale serait là que pour ce fichier. Quant à la fonction elle est bien placée dans Personnaliser ...à moins que si je vire la Fonction....?
I do not know.

Merci pour l'aide à la compréhension.

Voici la procédue dans le ThisWorkbook :

Private HostApp As Object
Private Sub workbook_open()
CréeLaCommande
End Sub

Sub CréeLaCommande()
Dim iIndex As Integer
Dim iCount As Integer
Dim fBtnExists As Boolean

Dim obCmdBtn As Object

On Error GoTo fin

Set HostApp = Application

Dim barHelp As Office.CommandBar
Set barHelp = Application.CommandBars("Cell")
fBtnExists = False
iCount = barHelp.Controls.Count
For iIndex = 1 To iCount
If barHelp.Controls(iIndex).Caption = "Somme_Spéciale" Then fBtnExists = True

Next
Dim Somme_Spéciale As Office.CommandBarButton
If fBtnExists Then
Set Somme_Spéciale = barHelp.Controls("Somme_Spéciale")
Else
Set Somme_Spéciale = barHelp.Controls.Add(msoControlButton)
Somme_Spéciale.Caption = "Somme_Spéciale"
End If

Somme_Spéciale.Tag = "Somme_Spéciale"
Somme_Spéciale.OnAction = "SommeChristophe"
Somme_SpécialeHandler.SyncButton Somme_Spéciale
fin:
End Sub

et dans le module2

Function SommeChristophe()
Application.Volatile
'donne la lettre de la colonne de la cell active
colonne = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2)
Dim First As Integer, Last As Integer
'dans le cas ou la deuxième ligne est remple
If Range(colonne & "1") > 0 Then
First = 1
Else
'termine la fonction si la colonne est vide
If Range(colonne & "1").End(xlDown).Row = 65536 Then Exit Function
'deuxième ligne avec une valeur
First = Range(colonne & "1").End(xlDown).Row
End If
'dernière ligne avec une valeur
Last = Range(colonne & First).End(xlDown).Row

SommeChristo = Application.WorksheetFunction.sum(Range(colonne & First & ":" & colonne & Last))

Range(colonne & ActiveCell.Row) = SommeChristo
End Function



Celeda

 

[Zon]

Re:

Salut,

Pour réinitiliasier le clic droit

application.commandbars("cell").reset

Denis sinon à rajouter dans une procédure effacer
on error resume next
application.commandbars("cell").controls.item("Somme_Spéciale").delete

plus b esoin de tester l'existence

A+++

 

[Celeda]

Bonsoir,

Bon, ouf!!!!!!!

un gros poutoune pour te remercier

 

[Denis]

Bonjour à tous
désolé Celeda de ne pas avoir répondu plus tôt, mais, avec le décalage horaire, j'étais déjà en week-end (moi aussi sur une ile)
merci à Zon d'avoir donné la solution pour t'enlever l'étiquette dans la barre de menu, j'avais oublié de le rajouter et même d'en parler
encore toutes mes excuses pour ce désagrément
@+ Denis