L'approche suivante utilise une solution de contournement décrite ici et ici pour permettre à une fonction de feuille de calcul définie en VBA de fixer la valeur d'une autre cellule.
La fonction personnalisée stocke dans des variables globales l'adresse de la cellule cible et la valeur à laquelle cette cellule doit être définie. Ensuite, une macro qui est déclenchée lorsque la feuille de calcul recalcule lit les variables globales et fixe la cellule cible à la valeur spécifiée.
L'utilisation de la fonction personnalisée est simple :
=SetCellValue(target_cell, value)
où target_cell est une chaîne de référence à une cellule de la feuille de calcul (par exemple, “A1”) ou une expression qui évalue une telle référence. Cela inclut une expression telle que =B14 où la valeur de B14 est “A1”. La fonction peut être utilisée dans n'importe quelle expression valide.
SetCellValue renvoie 1 si la valeur est écrite avec succès dans la cellule cible, et 0 sinon. Tout contenu précédent de la cellule cible est écrasé.
Trois morceaux de code sont nécessaires :
- le code définissant
SetCellValue lui-même
- la macro qui est déclenchée par l'événement de calcul de la feuille de calcul ; et
- une fonction utilitaire
IsCellAddress pour garantir que target_cell est une adresse de cellule valide.
Code pour la fonction SetCellValue
Ce code doit être collé dans un module standard inséré dans le classeur. Le module peut être inséré via le menu de l'éditeur Visual Basic, auquel on accède en sélectionnant Visual Basic dans l'onglet Developer du ruban.
Option Explicit
Public triggerIt As Boolean
Public theTarget As String
Public theValue As Variant
Function SetCellValue(aCellAddress As String, aValue As Variant) As Long
If (IsCellAddress(aCellAddress)) And _
(Replace(Application.Caller.Address, "$", "") <> _
Replace(UCase(aCellAddress), "$", "")) Then
triggerIt = True
theTarget = aCellAddress
theValue = aValue
SetCellValue = 1
Else
triggerIt = False
SetCellValue = 0
End If
End Function
Feuille de travail_Calculer le code macro
Ce code doit être inclus dans le code spécifique à la feuille de travail dans laquelle vous utiliserez SetCellValue. Le plus simple est de cliquer avec le bouton droit de la souris sur l'onglet de la feuille de calcul dans la vue Home, de sélectionner View Code, puis de coller le code dans le volet de l'éditeur qui apparaît.
Private Sub Worksheet_Calculate()
If Not triggerIt Then
Exit Sub
End If
triggerIt = False
On Error GoTo CleanUp
Application.EnableEvents = False
Range(theTarget).Value = theValue
CleanUp:
Application.EnableEvents = True
Application.Calculate
End Sub
Code pour la fonction IsCellAddress
Ce code peut être collé dans le même module que le code SetCellValue.
Function IsCellAddress(aValue As Variant) As Boolean
IsCellAddress = False
Dim rng As Range ' Input is valid cell reference if it can be
On Error GoTo GetOut ' assigned to range variable
Set rng = Range(aValue)
On Error GoTo 0
Dim colonPos As Long 'convert single cell "range" address to
colonPos = InStr(aValue, ":") 'single cell reference ("A1:A1" -> "A1")
If (colonPos <> 0) Then
If (Left(aValue, colonPos - 1) = _
Right(aValue, Len(aValue) - colonPos)) Then
aValue = Left(aValue, colonPos - 1)
End If
End If
If (rng.Rows.Count = 1) And _
(rng.Columns.Count = 1) And _
(InStr(aValue, "!") = 0) And _
(InStr(aValue, ":") = 0) Then
IsCellAddress = True
End If 'must be single cell address in this worksheet
Exit Function
GetOut:
End Function
``` ### Code pour la fonction IsCellAddress