VBA: Etendre la plage dans la formule lors de l'insertion de la ligne

klin89

XLDnaute Accro
Bonsoir le forum,

J'ai 2 petits problèmes à vous soumettre.
Dans mon tableau, j'insère une ligne avec cette macro.
VB:
Sub Inserer_une_ligne()
  Dim Dli As Long
  Dli = Cells(Rows.Count, 1).End(xlUp).Row - 3
  Rows(Dli + 1).Insert Shift:=xlDown
  Range("A" & Dli & ":N" & Dli).Copy Range("A" & Dli + 1)
  Range("A" & Dli + 1 & ":M" & Dli + 1).ClearContents
End Sub

En B12, est retranscrite cette fonction personnalisée.
=rouge(B3:B11)
dont la plage ne s'étend pas lors de l'insertion d'une ligne
je devrai obtenir =rouge(B3:B12)
Idem pour les formules de B13, B14 et cellules contiguës
Comment y remédier ?
D'autre part, cette macro déclenche l'entrée dans mes 2 fonctions personnalisées (somme des cellules dont la Font est coloriée).
Comment l'éviter :confused:.

Pouvez-vous me venir en aide ?

Bonne soirée Klin89
 

Pièces jointes

  • test compte guillaume.xls
    44 KB · Affichages: 62
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : VBA: Etendre la plage dans la formule lors de l'insertion de la ligne

Bonsoir,

Un essai
1) en modifiant les formules du tableau.
2) et en modifiant légèrement la macro d'insertion de ligne.

Les références d'une formule sont adaptées, me semble-t il, que si on insère des lignes au sein de l'intervalle. Je pense qu'Excel considère qu'insérer une ligne avant la ligne 12 c'est insérer une ligne après la ligne 11 donc en dehors de l'intervalle.
 

Pièces jointes

  • test compte guillaume v01.xls
    51 KB · Affichages: 65
Dernière édition:

klin89

XLDnaute Accro
Re : VBA: Etendre la plage dans la formule lors de l'insertion de la ligne

Bonsoir mapomme,

Bien vu le Decaler dans les formules :)

Reste le dernier point à résoudre : comment éviter l'entrée dans les 2 fonctions personnalisées lors de l'exécution de la macro, au niveau de la ligne surlignée en rouge.

Sub Inserer_une_ligne()
Dim Dli As Long
Application.EnableEvents = False
Dli = Cells(Rows.Count, 1).End(xlUp).Row - 3
Rows(Dli + 1).Insert Shift:=xlDown
Range("A" & Dli & ":N" & Dli).Copy Range("A" & Dli + 1)
Range("A" & Dli + 1 & ":M" & Dli + 1).ClearContents
Application.EnableEvents = True
ActiveSheet.Calculate
End Sub

Klin89
 

klin89

XLDnaute Accro
Re : VBA: Etendre la plage dans la formule lors de l'insertion de la ligne

Bonsoir à tous,
Bonsoir mapomme,

En fait, chacune des 3 instructions ci-dessous entrainaient un appel répété des 2 fonctions personnalisées et donc un recalcul dans la feuille.

VB:
Sub Inserer_une_ligne()
.../...
  Rows(Dli + 1).Insert Shift:=xlDown
  Range("A" & Dli & ":N" & Dli).Copy Range("A" & Dli + 1)
  Range("A" & Dli + 1 & ":M" & Dli + 1).ClearContents
..../...
End Sub

J'ai donc introduit un booléen pour éviter ce recalcul intempestif.
Désormais le recalcul ne s'effecue qu'avec la ligne :
VB:
Sub Inserer_une_ligne()
.../...
Flag = False
ActiveSheet.Calculate
End Sub

Voici le code dans sa totalité à placer dans le module1

VB:
Public Flag As Boolean

Function En_Compte(Plage As Range)
Dim cell As Range
If Flag = True Then Exit Function
Application.Volatile
For Each cell In Plage
  If cell.Font.ColorIndex = 5 Then Somme = Somme + cell.Value
Next
En_Compte = Somme
End Function

Function rouge(Plage As Range)
Dim cell As Range
If Flag = True Then Exit Function
Application.Volatile
For Each cell In Plage
  If cell.Font.ColorIndex = 3 Then Somme = Somme + cell.Value
Next
rouge = Somme
End Function

Sub Inserer_une_ligne()
  Dim Dli As Long
  Flag = True
  Application.EnableEvents = False
  Dli = Cells(Rows.Count, 1).End(xlUp).Row - 3
  Rows(Dli + 1).Insert Shift:=xlDown
  Range("A" & Dli & ":N" & Dli).Copy Range("A" & Dli + 1)
  Range("A" & Dli + 1 & ":M" & Dli + 1).ClearContents
  Application.EnableEvents = True
  Flag = False
  ActiveSheet.Calculate
End Sub

Si vous avez mieux à me préposer, n'hésitez pas :)

Klin89
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : VBA: Etendre la plage dans la formule lors de l'insertion de la ligne

Bonjour klin89,

Pour éviter de gérer des variables globales dans chaque fonction
spécialisée, on peut passer (dans le ss-pgme 'Inserer_une_ligne') en
calcul manuel, effectuer l'insertion, rétablir le mode de calcul initial
puis recalculer la feuille si besoin:

Code:
Sub Inserer_une_ligne()
Dim Dli As Long, EtatInitCalcul
  EtatInitCalcul = Application.Calculation
  Application.Calculation = xlCalculationManual
  Dli = Cells(Rows.Count, 1).End(xlUp).Row - 3
  Rows(Dli + 1).Insert Shift:=xlDown
  Range("A" & Dli & ":N" & Dli).Copy Range("A" & Dli + 1)
  Range("A" & Dli + 1 & ":M" & Dli + 1).ClearContents
  Application.Calculation = EtatInitCalcul
  If EtatInitCalcul = xlCalculationManual Then ActiveSheet.Calculate
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 361
Messages
2 087 602
Membres
103 604
dernier inscrit
CAROETALEX59