Les procédures & fonctions

ol) ActiveCell.Offset(lig, col).Select End Sub Autre syntaxe : Call nom_procédure(param1,param2,…): Sub essai() Range("a1").Select ActiveCell.Value = "Début" Call decale(3, 1) ' 3lignes, 1 colonne ActiveCell.Value = "Essai" End Sub

Perso Synthè Différence 2 cham Multi Champs Fonction autre cla Fonction langue Affiche formule Prime tranche

http://boisgontierjacques.free.fr/pages_site/procedures.htm

22/06/2011

Les procédures & fonctions

Appel d’une procédure dans un autre classeur

Sub essai() Application.Run "MesProcédures.xls!proc1" End Sub

Page 2 sur 13

' appel procédure

Byref Byval

L’options Byref et Byval permettent de spécifier si le passage se fait par valeur ou par adresse. L’option par défaut est ByRef. Sur l’exemple, p=456 modifie la valeur de la variable a. Sub essai(ByRef p) p = 456 End Sub Sub essai1() Dim a a = 123 Call essai(a) Msgbox a End Sub

Les fonctions

Contrairement à une procédure, une fonction retourne un résultat. L'option As type permet de spécifier le type de la valeur retournée. La syntaxe est la suivante : Function nom_fonction(paramètre1, paramètre2,,....) AS type instruction1 instruction2 ............ nom_fonction=valeur_retour End Function Sur l'exemple, Lors de l'appel de la fonction, le paramètre DateNaissance de la fonction Age(DateNaissance) est remplacé par la valeur 13/12/1960. Le résultat doit être retourné dans Age, c'est à dire le nom de la fonction. Function Age(DateNaissance) Age=Year(Date)-Year(DateNaissance) End Function Dans le tableur: =Age(A1) ' A1 contient la date de naissance

On peut utiliser Insertion/Fonction/personnalisées pour créer la formule. En VBA: Sub Essai() d = #10/12/1980# MsgBox Age(d) End Sub Une fonction écrite dans un module est utilisable dans tout le classeur.

Appel d’une procédure ou fonction dans un autre classeur

Appel d'une fonction à partir du tableur

http://boisgontierjacques.free.fr/pages_site/procedures.htm

22/06/2011

Les procédures & fonctions

=XX.XLS!age(A1)

Page 3 sur 13

Appel d'une procédure ou fonction à partir de VBA

Une procédure ou fonction d'un autre classeur se fait avec: Run Procédure,param1,param2,.. résult=Run(fonction,param1,param2,..) Run "MesProc.xls!proc1", 11 result = Run("MesFonctions.xls!age", #1/1/1980#) L'opérateur saisit 1,2,3,4 dans la cellule A1 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then Run Array("macro1", "macro2", "macro3", "macro4")(Target - 1) End If End Sub ou Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then Run "macro" & Target End Sub ' appel procédure ' appel fonction

Xlstart

Si un classeur est placé dans le répertoire XLStart, il est ouvert automatiquement. C:\Documents and Settings\jboisgon\Application Data\Microsoft\Excel\XLSTART (Ce classeur peut être Perso.xls) -Insertion/Fonctions/Catégorie personnalisées donne accés aux fonctions persos - Si la propriété Isaddin de ThisWorkBook a été cochée, l’appel des fonctions se fait alors sans le nom du classeur devant le nom de la fonction: =Age(A1) au lieu de =XX.XLS!age(A1).

Macro complémentaire

En enregistrant MesFonctions.Xls sous forme de Macro complémentaire, on obtient un fichier MesFonctions.Xla (dans le répertoire MacroComplémentaires). En cochant Outils/Macros complémentaires/Mesfonctions.xla, on a alors accés (sur son poste et dans le tableur) aux fonctions à partir de tous les classeurs. Mais, pour un autre poste, il faut installer la macro complémentaire et la cocher avec Outils/Macro complémentaire.

Appel d'une fonction d'une macro complémentaire

Function age(dn) age = Year(Date) - Year(dn) End Function Sub essai() dateNaiss = #1/1/2000# mAge = Application.Run("age", dateNaiss) ' appel MsgBox mAge End Sub

Appel d'une procédure d'une macro complémentaire

Sub affiche(m) MsgBox m End Sub Sub essai2() Application.Run "affiche", "essai" ' appel End Sub

http://boisgontierjacques.free.fr/pages_site/procedures.htm

22/06/2011

Les procédures & fonctions

Descriptif de fonction personnalisée

L'utilisation de Fx donne un descriptif des fonctions personnalisées Private Sub auto_Open() Application.MacroOptions Macro:="SommeCouleurFond", _ Description:="Donne la somme des nombres des cellules ayant la couleur spécifiée", Category:=14 End Sub

Page 4 sur 13

Exemples de fonctions

Suppression d’accents

Function sansAccent(chaine) codeA = "éèêëàçùôûïî" codeB = "eeeeacuouii" temp = chaine For i = 1 To Len(temp) p = InStr(codeA, Mid(temp, i, 1)) If p > 0 Then Mid(temp, i, 1) = Mid(codeB, p, 1) Next sansAccent = temp End Function

Extraction du nom et du prénom

Function Nom(chaine) Application.Volatile a = Split(chaine, " ") i = UBound(a) Do While UCase(a(i)) = a(i) And i > LBound(a): i = i - 1: Loop For k = i + 1 To UBound(a): temp = temp & a(k) & " ": Next Nom = Trim(temp) End Function Function PreNom(chaine) Application.Volatile a = Split(chaine, " ") i = UBound(a) Do While UCase(a(i)) = a(i) And i > LBound(a): i = i - 1: Loop For k = LBound(a) To i: temp = temp & a(k) & " ": Next PreNom = Trim(temp) End Function

Inversion du nom et du prénom

http://boisgontierjacques.free.fr/pages_site/procedures.htm

22/06/2011

Les procédures & fonctions

Page 5 sur 13

Function InverseNP(chaine) Application.Volatile a = Split(chaine, " ") i=1 Do While UCase(a(i)) = a(i) And i < UBound(a): i = i + 1: Loop For k = i To UBound(a): temp = temp & a(k) & " ": Next For k = LBound(a) To i - 1: temp = temp & a(k) & " ": Next InverseNP = Trim(temp) End Function

Nom du classeur actif

Function NomClasseur() As String Application.Volatile NomClasseur = ActiveWorkbook.Name End Function

Traduction formule en anglais

Function anglais(f) anglais = f.Formula End Function

Somme des cellules visibles

Calcule la somme des cellules visibles. Function SommeVisibles(champ As Range) Application.Volatile t=0 For Each c In champ If Not c.EntireRow.Hidden And Not c.EntireColumn.Hidden Then t = t + c.Value End If Next c SommeVisibles = t End Function Private Sub Worksheet_SelectionChange(ByVal Target As Range) calcultate End Sub

Extraction d’un nombre d’une chaîne

Function NumChaine(chaine) temp = "" For i = 1 To Len(chaine) c = Mid(chaine, i, 1) If c >= "0" And c n Then t = t + 1 Case 1 If c < n Then t = t + 1 End Select Next c RangSansDoublons = t + 1 End Function

Caller

Caller permet d'accéder à l'adresse de la cellule où la fonction est écrite -Caller Couleur -

Donne la couleur de fond de la cellule appelante

Function couleurFond() Application.Volatile couleurFond = Range(Application.Caller.Address).Interior.ColorIndex End Function

http://boisgontierjacques.free.fr/pages_site/procedures.htm

22/06/2011

Les procédures & fonctions

Page 10 sur 13

Modifie le texte de la cellule appelante en fonction de sa couleur

Function couleurFondTexte() Application.Volatile Select Case Range(Application.Caller.Address).Interior.ColorIndex Case 3 couleurFondTexte = "Rouge" Case 4 couleurFondTexte = "Vert" Case 6 couleurFondTexte = "Jaune" Case Else couleurFondTexte = "JeSaisPas" End Select End Function Pour Maj si modification