Microsoft 365 Réccupérer la valeur d'une fonction personalisée en écrasant la formule

[Cyf]

Bonjour,

J'ai créé des formules personnalisées et souhaite faire une macro qui, pour chaque cellule du classeur où une fonction personnalisée existe, ne conserve que la valeur de ces formules.

Je suis passé par une boucle utilisant CTRL+F, sélection, puis copier-coller en valeur sur la même cellule sélectionnée. Cependant, cette méthode est vraiment peu élégante et demande un temps d'exécution considérable pour les fichiers où ces fonctions personnalisées sont nombreuses.

Auriez-vous une autre piste que mon système D ?


Bien cordialement,

 

[Rouge]

Bonjour,

Auriez-vous une autre piste que mon système D ? Sûrement, mais sans voir ce que vous avez fait, ni un bout de fichier pour essayer de vous aider, ça sera difficile.

Cdlt

 

[Cyf]

Bonjour,
Voici un exemple d'une situation équivalente à celle de mon fichier, avec le principe de la macro qui sélectionne et copie colle. L'idée étant de supprimer toute mention des formules personnalisées pour n'en garder que le résultat.

Public Function TOTAL(A, B)
TOTAL = A + B
End Function

Sub Ecraser()

Dim t As Long

    t = 0
    
    On Error Resume Next
    t = Cells.Find(What:="=TOTAL", After:=ActiveCell, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
    On Error GoTo 0
  
    Do While t > 0
    
    Cells.Find(What:="=TOTAL", After:=ActiveCell, LookIn:=xlFormulas2, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Select
    
    ActiveCell.Copy
    ActiveCell.PasteSpecial Paste:=xlPasteValues
    
    t = 0
    On Error Resume Next
    t = Cells.Find(What:="=TOTAL", After:=ActiveCell, LookIn:=xlFormulas2, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Row
    On Error GoTo 0
    
    Loop
    

End Sub

Bien cordialement,

 

[Staple1600]

Bonsoir le fil, Cyf

=>Cyf
Une solution possible

Sub Ecraser()
ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
End Sub

Et la version pour traiter toutes les feuilles du classeur actif

Sub Ecraser_WBK()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
ws.UsedRange = ws.UsedRange.Value
Next
End Sub

 

[Cyf]

Bonjour et merci Staple 1600 pour cette méthode.
Elle convient à ma situation, mais si d'aventure il était possible de :

• n'opérer cette méthode que pour des formules bien précises (comme =TOTAL() dans l'exemple illustratif ci-dessus) ;
• éviter un recalcul de la formule au cours de la macro (ce qui n'a pas l'air de se faire systématiquement en passant en mode de calcul manuel).

Ce serait l'idéal. Si ce n'est pas possible, je resterai sur un "figeage" de toute la feuille.


Merci à vous,

 

[Staple1600]

Bonsoir

L'idée étant de supprimer toute mention des formules personnalisées pour n'en garder que le résultat.

Question:
Pourquoi faut-il préserver les autres formules?
Si le but est de diffuser le classeur à un tiers sans que celui puisse prendre connaissance des formules utilisées alors autant passer toute la feuille en valeurs seules, non ?
(ou plus simple envoyer une copie de la feuille en PDF)

 

[Cyf]

C'est que les formules personnalisées appellent une API et sont payantes. J'aurai souhaité (mais je peux revoir à la baisse mes "prétentions") que l'utilisateur puisse néanmoins garder les formules classiques d'Excel qui auraient déjà été utilisées, avant export de la feuille.

 

[Staple1600]

Re

Ceci semble fonctionner

Sub test_OK()
Dim persofunc$, c As Range
persofunc = "=TOTAL"
For Each c In ActiveSheet.UsedRange
If InStr(c.Formula, persofunc) > 0 Then
c = c.Value
End If
Next
End Sub

A tester en situation réelle, avec le vrai nom des fonctions.

 

[Cyf]

Formidable ! Merci pour ces prompts retours à une heure tardive !

Pour comprendre le code, comment sont déterminés par VBA les "c" ? Ce ne sont que les cellules non vides ?
Que signifie le $ dans la partie Dim ?

Merci encore !

 

[Staple1600]

Re

Dim persofunc$ équivaut à Dim persofunc As String

Avec cette ligne, on boucle sur chaque cellule de la "zone en cours" de la feuille active
For Each c In ActiveSheet.UsedRange

Donc, le code fonctionne sur ton vrai classeur?

 

[Cyf]

Bonjour,

Merci pour ces précisons, et merci à nouveau pour cette précieuse aide : je confirme bien que cette macro fonctionne parfaitement, tant au niveau du rendu qu'au niveau de la durée dans mon "vrai" classeur.

 

[Staple1600]

Bonsoir le fil, Cyf

=>Cyf
Puisque tu parles durée
Est-ce que ce petit ajout change quelque chose?

Sub test_OK()
Dim persofunc$, c As Range
persofunc = "=TOTAL"
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
If InStr(c.Formula, persofunc) > 0 Then
c = c.Value
End If
Next
End Sub

 

[Cyf]

Bonsoir,

Je l'avais déjà ajouté à votre code.
Votre retour m'aura permis d'apprendre que la phrase que l'on rajoute à la fin "Application.ScreenUpdating = True" n'est pas nécessaire.

Bien cordialement,

 

[Staple1600]

Re

On peut aussi ajouter des endives

Sub test_OK_B()
Dim persofunc$, c As Range
persofunc = "=TOTAL"
With Application
    .ScreenUpdating = 0
    .Calculation = -4135
        For Each c In ActiveSheet.UsedRange
            If InStr(c.Formula, persofunc) > 0 Then
            c = c.Value
            End If
        Next
    .Calculation = -4105
End With
End Sub

NB: En théorie, là... tu devrais me poser des questions sur ce code si tu es curieux

 

[Cyf]

Déjà fait aussi, mais j’apprends encore de la syntaxe et du vocabulaire VBA !
J'imagine que le -4135 vaut xlCalculationManual et le -4105 vaut xlCalculationAutomatic ?