Plusieurs demandes merci

[altinea]

1- j'aimerai pouvoir coloriser des colonnes en cliquant dans les cellules la formule je l'ai, par contre ce que je souhaite c'est le faire dans une zone délimité afin de ne pas reproduire la formule pour toutes les colonnes

formule pour 1 colonne

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Select Case Target.Interior.ColorIndex
Case 2, xlNone: Target.Interior.ColorIndex = 5
Case Is = 5: Target.Interior.ColorIndex = 4
Case Is = 4: Target.Interior.ColorIndex = 3
Case Is = 3: Target.Interior.ColorIndex = xlNone
End Select
End Sub

donc je souhaite appliquer cette formule par exemple sur 10 colonnes


2 - comment faire pourque la couleur de la cellules change trois mois avant l'echeance.
Exemple formation cariste initiale le 01012002 recyclage tous les 5 ans donc j'aimerai trois mois avant c a dire octobre 2006 que la cellule change de couleur pour identifier le personnel a recycler.

utilise 2 cellules, cellule 1 avec date de l'examen cariste et cellule 2 date du recyclage, ou juste sur la cellule initiale qui change de couleur 3 mois avant l'echeance


3 - comment extraire a partir du fichieer general des infos vers un autre fichier, a savoir dans la colonne cariste extraire tous les salariés titulaires du permis, vers une autre feuille que je met en forme pour n'avoir que les cariste et idem pour les autres fonctions dans l'entreprise,
merci de votre aide

 

[Pierrot93]

Re : Plusieurs demandes merci

bonjour Altinea

pour ta première question, peut être comme ci dessous :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A,C:C")) Is Nothing Then 'Range("A:K")
Select Case Target.Interior.ColorIndex
Case 2, xlNone: Target.Interior.ColorIndex = 5
Case Is = 5: Target.Interior.ColorIndex = 4
Case Is = 4: Target.Interior.ColorIndex = 3
Case Is = 3: Target.Interior.ColorIndex = xlNone
End Select
Cancel = True
End If
End Sub

Pour les 2 autres mets peut être un fichier exemple sans données confidentielles, ca nous aidera à t'aider...

bon après midi
@+

 

[altinea]

Re : Plusieurs demandes merci

merci pour la première je vais l'essayer dès ce soir
par contre pour le fichier il faudrait que je te l'envoi mais il est trop volumineux il serait preferable que je puisse te l'envoyer sur une adresse autre si tu veux bien merci

 

[Pierrot93]

Re : Plusieurs demandes merci

Re Altina

le but du forum est que tout le monde puisse profiter et s'enrichir donc si tu me l'envoie en privé....

En plus je ne suis pas du tout sur de pouvoir répondre ou d'avoir le temps...

mais essaie tout de même d'épurer un maximum ton fichier et le mettre ici afin que d'autres puisse également t'aider. Souvent un problème débouche sur plusieurs solutions.

A te lire, bonne soirée

@+

 

[altinea]

Re : Plusieurs demandes merci

ok je vais essayer de suivre ton conseil il est vrai que c'est comme cela que ca dois se faire, dommage que l'on ne puisse pas tranferer un peu plus d'octets

 

[altinea]

Re : Plusieurs demandes merci

pour en revenir a la première question est 'il possible outre le fait de declarer les colonnes de faire de meme avec les lignes
par exemple je veux que la formule s'applique de la colonne 1 à 3 et a partir de la ligne 10 à 30


merci

 

[Pierrot93]

Re : Plusieurs demandes merci

Re Altinea

si je traduis bien, ca devrait donner ceci :

If Not Intersect(Target, Range("A10:C30")) Is Nothing Then

@+

 

[altinea]

Re : Plusieurs demandes merci

merci c'est parfait, concernant ma seconde demande il s'agit en fait :

cellule 1 contient la date de l'obtention du permis cariste
la cellule 2 contient la date du recyclage (ex 5 ans plus tard)

ce que je souhaiterai c'est que 3 mois avant la date d'échéance celle ci change de couleur et arrivée à echeance redevienne blanche

je sais pas si je suis assez clair

 

[Pierrot93]

Re : Plusieurs demandes merci

Bonjour Altinéa

pour ton problème de date, peut être comme ci dessous, code à mettre dans ThisWorkbook, se déclanche à l'ouverture, boucle sur la colonne B à partir de la ligne 2, je pense qu'en 1 tu as le titre de la colonne.

Teste et dis moi si cela te conviens.

Option Explicit
Private Sub Workbook_Open()
Dim l As Integer
For l = 2 To Range("B65536").End(xlUp).Row
    If CDate(Range("B" & l).Value) > Date And CDate(Range("B" & l)) < DateSerial(Year(Date), Month(Date) + 3, Day(Date)) Then
        Range("B" & l).Interior.ColorIndex = 3
        ElseIf CDate(Range("B" & l).Value) <= Date Then Range("B" & l).Interior.ColorIndex = xlNone
    End If
Next l
End Sub

Bon après midi
@+

 

[nat54]

Re : Plusieurs demandes merci

3 - comment extraire a partir du fichieer general des infos vers un autre fichier, a savoir dans la colonne cariste extraire tous les salariés titulaires du permis, vers une autre feuille que je met en forme pour n'avoir que les cariste et idem pour les autres fonctions dans l'entreprise,
merci de votre aide

Bonjour,

Brut de fonderie à adapter...

§ Macro 1 : créer les onglets d’un fichier à partir d’un filtre automatique

Sub Créer_objectifs_CC()

Application.ScreenUpdating = False 'ne pas voir ce qui se passe à l'écran, diminue besoin mémoire

For lgn = 2 To 24 'pour boucler sur les lignes 2 à 24

Sheets("Ref").Select 'on se place sur la feuille de référence où sont indiquées en colonne A la liste des fonctions
indic = Cells(lgn, 1).Value 'on variabilise, indic = cellule ligne de la boucle, colonne 1
Sheets("Recap Objectif CC").Select ''on se place sur la feuille où se trouve la BD

Range("e1").Select 'on choisit un indicateur dans filtre automatique
Selection.AutoFilter
Selection.AutoFilter Field:=5, Criteria1:=indic ‘ l’indicateur se trouve en colonne 5

Range("A1:R1500").Select
Range("R1500").Activate
Selection.Copy


Sheets.Add After:=Worksheets(Worksheets.Count) 'on ajoute un onglet après les 2 premières feuilles
ActiveSheet.Name = indic 'on nomme l'onglet comme nom indicateur

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False ' on colle



Next lgn ' on continue sur 2nd, 3èm.. indicateur (boucle)

Application.ScreenUpdating = True

End Sub

 

[altinea]

Re : Plusieurs demandes merci

bonsoir, pour Pierrot peux tu me dire comment faire fonctionner ta formule car je sais pas ou la mettre dans la feuille merci