Je cherche à formater les cellules qui contiennent le résultat
des sous-totaux avec cette macro mais ca ne fonctionne pas,
merci de vos conseils
Dim c As Range
If Intersect(Range("f7:f200"), ActiveCell) Is Nothing Then
Range("f7").Activate
Set c = Range("f7:f200").Find(what:=xlFormulas, after:=ActiveCell)
If c Is Nothing Then
MsgBox ("Pas de formule sous-totaux dans la colonne F")
Else
c.Font.Name = "Arial"
c.Font.Size = 12
c.Font.ColorIndex = 3
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
michdenis
Bonjour Dante,
Voici 2 façons de faire. Il y en a d'autres. La bonne méthode dépend surtout des caractéristiques de la plage concernée.
Cette façon exige qu'il n'y ait pas d'autres formules que les formules de sous-totaux dans les colonnes visées '----------------------------------- Sub Sous_Totaux1()
Dim Rg As Range
With Worksheets("Feuil1") .Columns(1).Insert Shift:=xlToRight Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row) End With On Error Resume Next With Rg .Item(1, 1) = "Année" .Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")" Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _ Replace:=True, PageBreaks:úlse, SummaryBelowData:=True With .Offset(, 2).Resize(, Rg.Columns.Count - 2).EntireColumn _ .SpecialCells(xlCellTypeFormulas) .Font.ColorIndex = 3 .Font.Bold = True End With End With Set Rg = Nothing
End Sub '-----------------------------------
La mise en forme des lignes de sous-totaux se fait par une recherche du mot "total" dans la colonne 1 de la plage. '----------------------------------- Sub Sous_Totaux2()
Dim Rg As Range, C As Range, FirstAddress As String
With Worksheets("Feuil1") .Columns(1).Insert Shift:=xlToRight Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row) End With On Error Resume Next With Rg .Item(1, 1) = "Année" .Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")" Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _ Replace:=True, PageBreaks:úlse, SummaryBelowData:=True With .EntireColumn Set C = .Find("Total", LookIn:=xlValues, lookat:=xlPart) If Not C Is Nothing Then FirstAddress = C.Address Do With C.Resize(, 5) .Font.ColorIndex = 3 .Font.Bold = True End With Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With
End With Set Rg = Nothing: Set C = Nothing
End Sub '-----------------------------------
Salutations!
"Dante Huapaya" a écrit dans le message de news:
Bonjour à tous et toutes,
Je cherche à formater les cellules qui contiennent le résultat des sous-totaux avec cette macro mais ca ne fonctionne pas, merci de vos conseils
Dim c As Range If Intersect(Range("f7:f200"), ActiveCell) Is Nothing Then Range("f7").Activate Set c = Range("f7:f200").Find(what:=xlFormulas, after:¬tiveCell) If c Is Nothing Then MsgBox ("Pas de formule sous-totaux dans la colonne F") Else c.Font.Name = "Arial" c.Font.Size = 12 c.Font.ColorIndex = 3
End If End If
Dante Huapaya
Bonjour Dante,
Voici 2 façons de faire. Il y en a d'autres. La bonne méthode dépend
surtout des caractéristiques de la plage concernée.
Cette façon exige qu'il n'y ait pas d'autres formules que les
formules de sous-totaux dans les colonnes visées
'-----------------------------------
Sub Sous_Totaux1()
Dim Rg As Range
With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
On Error Resume Next
With Rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
With .Offset(, 2).Resize(, Rg.Columns.Count - 2).EntireColumn _
.SpecialCells(xlCellTypeFormulas)
.Font.ColorIndex = 3
.Font.Bold = True
End With
End With
Set Rg = Nothing
End Sub
'-----------------------------------
La mise en forme des lignes de sous-totaux se fait par une recherche
du mot "total" dans la colonne 1 de la plage.
'-----------------------------------
Sub Sous_Totaux2()
Dim Rg As Range, C As Range, FirstAddress As String
With Worksheets("Feuil1")
.Columns(1).Insert Shift:=xlToRight
Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row)
End With
On Error Resume Next
With Rg
.Item(1, 1) = "Année"
.Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")"
Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _
Replace:=True, PageBreaks:úlse, SummaryBelowData:=True
With .EntireColumn
Set C = .Find("Total", LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
With C.Resize(, 5)
.Font.ColorIndex = 3
.Font.Bold = True
End With
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With
End With
Set Rg = Nothing: Set C = Nothing
End Sub
'-----------------------------------
Salutations!
"Dante Huapaya" <DanteHuapaya@discussions.microsoft.com> a écrit dans le message de news:
A1245DBD-C5B4-4ECF-B934-1453D0D23F0F@microsoft.com...
Bonjour à tous et toutes,
Je cherche à formater les cellules qui contiennent le résultat
des sous-totaux avec cette macro mais ca ne fonctionne pas,
merci de vos conseils
Dim c As Range
If Intersect(Range("f7:f200"), ActiveCell) Is Nothing Then
Range("f7").Activate
Set c = Range("f7:f200").Find(what:=xlFormulas, after:¬tiveCell)
If c Is Nothing Then
MsgBox ("Pas de formule sous-totaux dans la colonne F")
Else
c.Font.Name = "Arial"
c.Font.Size = 12
c.Font.ColorIndex = 3
Voici 2 façons de faire. Il y en a d'autres. La bonne méthode dépend surtout des caractéristiques de la plage concernée.
Cette façon exige qu'il n'y ait pas d'autres formules que les formules de sous-totaux dans les colonnes visées '----------------------------------- Sub Sous_Totaux1()
Dim Rg As Range
With Worksheets("Feuil1") .Columns(1).Insert Shift:=xlToRight Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row) End With On Error Resume Next With Rg .Item(1, 1) = "Année" .Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")" Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _ Replace:=True, PageBreaks:úlse, SummaryBelowData:=True With .Offset(, 2).Resize(, Rg.Columns.Count - 2).EntireColumn _ .SpecialCells(xlCellTypeFormulas) .Font.ColorIndex = 3 .Font.Bold = True End With End With Set Rg = Nothing
End Sub '-----------------------------------
La mise en forme des lignes de sous-totaux se fait par une recherche du mot "total" dans la colonne 1 de la plage. '----------------------------------- Sub Sous_Totaux2()
Dim Rg As Range, C As Range, FirstAddress As String
With Worksheets("Feuil1") .Columns(1).Insert Shift:=xlToRight Set Rg = .Range("A1:F" & .Range("B65536").End(xlUp).Row) End With On Error Resume Next With Rg .Item(1, 1) = "Année" .Item(2, 1).FormulaLocal = "=année(" & .Item(2, 2).Address(0, 0) & ")" Range(.Item(2, 1).Cells, .Item(Rg.Rows.Count, 1).Cells).FillDown .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5), _ Replace:=True, PageBreaks:úlse, SummaryBelowData:=True With .EntireColumn Set C = .Find("Total", LookIn:=xlValues, lookat:=xlPart) If Not C Is Nothing Then FirstAddress = C.Address Do With C.Resize(, 5) .Font.ColorIndex = 3 .Font.Bold = True End With Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With
End With Set Rg = Nothing: Set C = Nothing
End Sub '-----------------------------------
Salutations!
"Dante Huapaya" a écrit dans le message de news:
Bonjour à tous et toutes,
Je cherche à formater les cellules qui contiennent le résultat des sous-totaux avec cette macro mais ca ne fonctionne pas, merci de vos conseils
Dim c As Range If Intersect(Range("f7:f200"), ActiveCell) Is Nothing Then Range("f7").Activate Set c = Range("f7:f200").Find(what:=xlFormulas, after:¬tiveCell) If c Is Nothing Then MsgBox ("Pas de formule sous-totaux dans la colonne F") Else c.Font.Name = "Arial" c.Font.Size = 12 c.Font.ColorIndex = 3
End If End If
Dante Huapaya
JB
Bonjour,
Une MFEC suffit:
http://cjoint.com/?mvuVOwbuaI
-Sélectionner le champ A1:E30 -Format/Mise en forme conditionnelle
