Double clic pour mettre mots et formules...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais, à nouveau, votre aide pour ce problème de double clic…

voir fichier joint…difficiles à expliquer ici.

Je vous remercie pour le temps que vous voudrez bien vouloir m'accorder.

Bien amicalement,
Christian

 

[job75]

Bonjour Christian,

La formule entrée en colonne C permet l'insertion de lignes :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Range, a, i As Variant
Set r = [B10:B30] 'à adapter
If Intersect(r, Target) Is Nothing Then Exit Sub
Cancel = True
a = Array("Total prestation(s)", "Total matériaux", "")
i = Application.Match(Target, a, 0)
If IsError(i) Then i = 0
If i = 3 Then i = 0
Target = a(i)
Target(1, 2) = IIf(i = 2, "", "=SUM(" & r(0, 2).Address(1, 0) & ":OFFSET(" & Target(1, 2).Address(0, 0) & ",-1,))")
End Sub

A+

 

[Christian0258]

Re, le forum, job75

Merci, job75, pour cette macro très technique qui fonctionne parfaitement.

J'ai dans le fichier joint V02, une amélioration à vous demander…

Merci pour votre aide si précieuse.

Bien à vous,
Christian

 

[job75]

Re,

Il faut insérer un SOMME.SI dans la formule en colonne C :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Range, a, i As Variant, f1$, f2$
Set r = [B10:B30] 'à adapter
If Intersect(r, Target) Is Nothing Then Exit Sub
Cancel = True
a = Array("Total prestation(s)", "Total matériaux", "")
i = Application.Match(Target, a, 0)
If IsError(i) Then i = 0
If i = 3 Then i = 0
Target = a(i)
f1 = r(0, 2).Address(1, 0) & ":OFFSET(" & Target(1, 2).Address(0, 0) & ",-1,)"
f2 = r(0).Address(1, 0) & ":OFFSET(" & Target.Address(0, 0) & ",-1,)"
Target(1, 2) = IIf(i = 2, "", "=SUM(" & f1 & ") -2*SUMIF(" & f2 & ",""Total*""," & f1 & ")")
End Sub

C'est technique...

A+

 

[Christian0258]

Re, le forum, job75,

Merci beaucoup, job75, oui je trouve que c'est très technique ce que tu m'as fait, chapeau.

Encore merci l'artiste.

Bien à toi,
Christian

 

[Christian0258]

Re, le forum, job75,

Je reviens vers vous pour un petit problème…

voir fichier V03
Merci à job75.

Merci, à nouveau, pour votre aide.
Bien à vous,
Christian

 

[job75]

Re,

Il suffit d'utiliser 2 Areas :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Range, a, i As Variant, f1$, f2$
Set r = [B10:B30,B35:B55] 'à adapter, 2 Areas
If Intersect(r, Target) Is Nothing Then Exit Sub
Set r = r.Areas(IIf(Intersect(Target, r.Areas(2)) Is Nothing, 1, 2)) 'redéfinition de la zone
Cancel = True
a = Array("Total prestation(s)", "Total matériaux", "")
i = Application.Match(Target, a, 0)
If IsError(i) Then i = 0
If i = 3 Then i = 0
Target = a(i)
f1 = r(0, 2).Address(1, 0) & ":OFFSET(" & Target(1, 2).Address(0, 0) & ",-1,)"
f2 = r(0).Address(1, 0) & ":OFFSET(" & Target.Address(0, 0) & ",-1,)"
Target(1, 2) = IIf(i = 2, "", "=SUM(" & f1 & ") -2*SUMIF(" & f2 & ",""Total*""," & f1 & ")")
End Sub

A+

 

[Christian0258]

Re, le forum, job75

Je te remercie infiniment pour tout le boulot...

Bien à toi,
Christian

 

[job75]

Re,

Si l'on veut pouvoir insérer ou supprimer des lignes il suffit de nommer les 2 zones :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Range, a, i As Variant, f1$, f2$
Set r = [Zone1,Zone2] 'à adapter, 2 Areas nommées
If Intersect(r, Target) Is Nothing Then Exit Sub
Set r = r.Areas(IIf(Intersect(Target, r.Areas(2)) Is Nothing, 1, 2))
Cancel = True
a = Array("Total prestation(s)", "Total matériaux", "")
i = Application.Match(Target, a, 0)
If IsError(i) Then i = 0
If i = 3 Then i = 0
Target = a(i)
f1 = r(0, 2).Address(1, 0) & ":OFFSET(" & Target(1, 2).Address(0, 0) & ",-1,)"
f2 = r(0).Address(1, 0) & ":OFFSET(" & Target.Address(0, 0) & ",-1,)"
Target(1, 2) = IIf(i = 2, "", "=SUM(" & f1 & ") -2*SUMIF(" & f2 & ",""Total*""," & f1 & ")")
End Sub

Fichier joint, il sera utile pour l'autre fil :

https://www.excel-downloads.com/threads/ajouter-une-page-sur-un-formulaire.20025389/

A+

 

[job75]

Bonjour Christian, le forum,

Nommer les tableaux est une fausse bonne idée s'il y en a plusieurs.

Il vaut mieux rechercher les titres "DÉTAIL" et "TOTAL T.T.C" :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim col%, deb$, fin$, i As Variant, r As Range, a, f1$, f2$
col = 2 'colonne B
deb = "DÉTAIL": fin = "TOTAL T.T.C" 'titres à rechercher
If Target.Column <> col Or Target.Row = 1 Then Exit Sub
If Target = deb Or Application.CountIf(Cells(1, col).Resize(Target.Row - 1), deb) = 0 Then Exit Sub
If Target = fin Or Application.CountIf(Cells(Target.Row + 1, col).Resize(Rows.Count - Target.Row), fin) = 0 Then Exit Sub
For i = Target.Row - 1 To 1 Step -1
    If Cells(i, col) = fin Then Exit Sub
    If Cells(i, col) = deb Then Set r = Cells(i, col): Exit For
Next
Cancel = True
a = Array("Total prestation(s)", "Total matériaux", "")
i = Application.Match(Target, a, 0)
If IsError(i) Then i = 0
If i = 3 Then i = 0
Target = a(i)
f1 = r(1, 2).Address(1, 0) & ":OFFSET(" & Target(1, 2).Address(0, 0) & ",-1,)"
f2 = r.Address(1, 0) & ":OFFSET(" & Target.Address(0, 0) & ",-1,)"
Target(1, 2) = IIf(i = 2, "", "=SUM(" & f1 & ") -2*SUMIF(" & f2 & ",""Total*""," & f1 & ")")
End Sub

Fichier V04.

A+

 

[Christian0258]

Re, le forum job75

Oups, pas vu ton dernier post…

Je prends, merci infiniment.

Bien à toi.

Christian

 

[Christian0258]

Re, le forum, job75,

Je reviens vers vous, pour une petite question ;

je souhaiterais centrer (col B) le résultat du double clic (Total prestations ou Total matériaux), quelle ligne de commande faut-il rajouter ?

Merci pour votre aide.

Bien à vous,
Christian

 

[job75]

Bonjour Christian,

Target.HorizontalAlignment = IIf(i = 2, xlLeft, xlCenter) 'alignement

Bon dimanche.

 

[Christian0258]

Re, le forum, job75

Merci, job75 ,c'est parfait…
Bon dimanche.

Bien à toi,
Christian