problème en recopiant une fonction VBA dans les cellules adjacentes

Version imprimable

Bonjour,
Après les très bons conseils de USER, jurassic pork et loufab, j'ai une autre demande.
Le programme suivant ne fonctionne pas pour les couleurs (en le recopiant) :
Code:

1 2 3 4 5 6 7 8 9 10 11 Public Function EssaiGJ(xdate As Range) Dim jour As Integer, Mois As Integer, An As Integer jour = Day(xdate.Text): Mois = Month(xdate.Text): An = Year(xdate.Text) If An + Mois / 100 + jour / 10000 < 1582.1015 Then ActiveCell.Font.ColorIndex = 10 EssaiGJ = "Julien" Else ActiveCell.Font.ColorIndex = 3 EssaiGJ = "Grégorien" End If End Function
Je pense que cela vient du fait que l'adresse de la cellule active est absolue (elle reste la même en la recopiant). Si oui comment la transformer en adresse relative ?
Merci
jp Moniatte

09/09/2023, 21h40
loufab

tu as le bouton "Modifier le message" c'est bien aussi.

oups !!!

Je ne pense pas que ça puisse marcher en faisant un activecell, utilise la mise en forme conditionnelle c'est fait pour ça.
10/09/2023, 11h13
jpmoniatte

Bonjour,
Je me suis mal exprimé.
Je place dans la colonne A des dates des 2 calendriers (grégorien, l'actuel, et julien)
Exemples : A1 = 23/09/2023 (grégorien), A2 = 5/4/1500 (julien), etc...
En B1 = EssaiGJ (A1) = Grégorien en rouge
En B2 = EssaiGJ (A2) = julien en vert, etc...
Pas de problème.
Afin d'éviter cette répétition :
En B1 toujours EssaiGJ(A1); je sélectionne B1 et les cellules en dessous, puis "copier vers le bas"
Tous les "grégorien" et "julien" seront en rouge.
Cela est dû au fait que la cellule active reste toujours B1 (par modification du programme son adresse est toujours $B$1)
Quelle solution ?
Merci
10/09/2023, 12h36
loufab

J'ai bien compris ton problème.

Je ne vois pas de solution applicable dans la fonction elle-même.

La mise en forme conditionnelle est là pour ça.
10/09/2023, 17h00
jpmoniatte

Merci

La SOLUTION

Bonjour,
La solution :

Code:

1
2
3
4
5
6
7
8
9
10
Public Function EssaiGJ(xdate As Range)
    Dim jour As Integer, Mois As Integer, An As Integer, CelluleSource As Range
    Set CelluleSource = Application.Caller
    jour = Day(xdate.Text): Mois = Month(xdate.Text): An = Year(xdate.Text)
        If An + Mois / 100 + jour / 10000 < 1582.1015 Then
            CelluleSource.Font.ColorIndex = 10: EssaiGJ = "Julien"
        Else
            CelluleSource.Font.ColorIndex = 3: EssaiGJ = "Grégorien"
        End If
End Function

Grâce à Tiago DA-SILVA d'ATHEOS Ingenierie Strasbourg
JP Moniatte