cherche personne pouvant me modifier une macro.

Bonjour.
Pour qu'on puisse la modifier, il faudrait que la mette à disposition...
Poste-la ici en retour.
Cordialement.
Daniel
<lct964@hotmail.fr> a écrit dans le message de news:
9ef7686c-6c09-4b35-921b-5487ea99649b@s19g2000prg.googlegroups.com...
bonjour à tous,
Une amie m'a écrit une macro afin de pouvoir rechercher dans un
classeur excel UNE cellule que j'ai coloriée.
je voudrais pouvoir demander à cette macro de pouvoir m'en reperer
plusieurs à la fois (trois serait super).
Quelqu'un parmi vous saurait il réaliser ceci.
Merci de votre aide. LCT

Cette macro recherche au maximum 3 cellules (les 3 premières
de la plage désignée) ayant le même format de cellule sans
égard à leur contenu... elles peuvent être vide aussi !

Tu dois déterminer dans la procédure le format des cellules
que tu désires rechercher là

à titre d'exemple :

With LeCellFormat
.Clear 'S'assurer d'effacer les critères
'des anciennes recherches
.Interior.ColorIndex = 3
.Font.Size = 14
.Font.Bold = True
'etc ...
'La liste pourrait être plus longue ...
End With

Et tu peux limiter l'étendue de la recherche dans
une plage de cellule bien précises :

With Worksheets("Feuil1")
Set Rg = .UsedRange ' OU .Range("A1:A50") ....
End With



'----------------------------------------
Sub TrouverFormat()

Dim Rg As Range, Sel As Range
Dim LeCellFormat As CellFormat
Dim Nb As Integer

Set LeCellFormat = Application.FindFormat
'Détermine les caractéristiques
'du format de cellule recherché.
With LeCellFormat
.Clear 'S'assurer d'effacer les critères
'des anciennes recherches
.Interior.ColorIndex = 3
'La liste pourrait être plus longue ...
End With

'Détermine la plage de cellules où s'effectue
'la recherche
With Worksheets("Feuil1")
Set Rg = .UsedRange
End With

'Trouve la cellule ayant le bon format pour
'y effectuer une ou des opérations quelconques...
With Rg
Set c = .Find(What:="", SearchFormat:=True)
If Not c Is Nothing Then
adr = c.Address
Do
'Le code que tu veux exécuter avec la cellule trouvée
If Sel Is Nothing Then
Set Sel = c
c.Select
Else
Set Sel = Union(Sel, c)
c.Select
End If
Nb = Nb + 1
'Lorsque la macro a repéré 3 cellules, arrêt
If Nb = 3 Then Exit Do
'pour passer à la cellule suivante ...
Set c = .Find(What:="", after:¬tiveCell, SearchFormat:=True)
Loop Until c.Address = adr
End If
End With
'sélection des 3 cellules
If Not Sel Is Nothing Then Sel.Select


End Sub
'----------------------------------------






<lct964@hotmail.fr> a écrit dans le message de news:
9ef7686c-6c09-4b35-921b-5487ea99649b@s19g2000prg.googlegroups.com...
bonjour à tous,
Une amie m'a écrit une macro afin de pouvoir rechercher dans un
classeur excel UNE cellule que j'ai coloriée.
je voudrais pouvoir demander à cette macro de pouvoir m'en reperer
plusieurs à la fois (trois serait super).
Quelqu'un parmi vous saurait il réaliser ceci.
Merci de votre aide. LCT

C'est la même procédure mois 2 lignes de code en moins
sélectionnant les cellules : c.Select


'----------------------------------
Sub TrouverFormat()

Dim Rg As Range, Sel As Range
Dim LeCellFormat As CellFormat
Dim Nb As Integer

Set LeCellFormat = Application.FindFormat
'Détermine les caractéristiques
'du format de cellule recherché.
With LeCellFormat
.Clear 'S'assurer d'effacer les critères
'des anciennes recherches
.Interior.ColorIndex = 3
'La liste pourrait être plus longue ...
End With

'Détermine la plage de cellules où s'effectue
'la recherche
With Worksheets("Feuil1")
Set Rg = .UsedRange
End With

'Trouve la cellule ayant le bon format pour
'y effectuer une ou des opérations quelconques...
With Rg
Set c = .Find(What:="", SearchFormat:=True)
If Not c Is Nothing Then
adr = c.Address
Do
'Le code que tu veux exécuter avec la cellule trouvée
If Sel Is Nothing Then
Set Sel = c
Else
Set Sel = Union(Sel, c)
End If
Nb = Nb + 1
'Lorsque la macro a repéré 3 cellules, arrêt
If Nb = 3 Then Exit Do
'pour passer à la cellule suivante ...
Set c = .Find(What:="", after:=c, SearchFormat:=True)
Loop Until c.Address = adr
End If
End With
'sélection des 3 cellules
If Not Sel Is Nothing Then Sel.Select

End Sub
'----------------------------------