VBA XL 2007 - récupération formule

Bonjour Congelator,

Posez votre question sur
microsoft.public.fr.excel
ça fourmie de pro sur Excel !

--
a+ Jean-Pol
Site Web : www.colovid.be
Site Web perso pour le fun : http://users.skynet.be/DAVID/
Cette page est transmise avec des électrons 100% recyclés.


"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message de
news: B004AB3F-DC1C-4042-A61F-F5A8381B2D1C@microsoft.com...

Salut à tous,
J'ai besoin de vos lumières, voilà mon blème :
je dois créer une macro en VBA. L'utilisateur choisi le nb de produits en
tout, la qté de A, le prix de A, la qté de B, le prix de B... et insérer à
la
fin le total. Jusque là ça joue, par contre, je dois insérer la formule et
non le résultat pour le total et là, je ne sais pas comment récupérer ces
infos. Info supplémentaire, c'est l'utilisateur qui choisi la cellule,
donc
pas de cell absolue... Si qqn a une idée, je suis preneur.
Merci d'avance.
Voici mon code.
Option Explicit
Sub Macro2()
Dim intNombreEnregistrements As Integer
Dim intCompteurVertical As Integer
Dim intCompteurHorizontal As Integer
Dim intCompteur As Integer

'enregistrement du nombre de lignes + écriture des titres des colonnes
intNombreEnregistrements = InputBox("veuillez entrer le nombre
d'enregistrements à effectuer", "enregistrements")
ActiveCell.FormulaR1C1 = "Nom du produit"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "quantité"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "prix à l'unité"

'écriture des valeurs données par l'utilisateur directement dans les
cellules sur X lignes
For intCompteur = 1 To intNombreEnregistrements
ActiveCell.Offset(1, -2).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("nom du produit n° " &
intCompteur, "enregistrement n° " & intCompteur) 'nom du produit
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("quantité du produit n° " &
intCompteur, "enregistrement n° " & intCompteur) 'quantité
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("prix à l'unité du produit n° " &
intCompteur, "enregistrement n° " & intCompteur) 'prix unitaire
Next

'retour à la ligne + écriture du total
ActiveCell.Offset(1, -2).Range("A1").Select
ActiveCell.FormulaR1C1 = "TOTAL"
ActiveCell.Offset(0, 2).Range("A1").Select

'formule de calcul du total à modifier pour qu'elle soit dynamique et
relative
ActiveCell.FormulaR1C1 > "=R[-3]C[-1]*R[-3]C+R[-2]C[-1]*R[-2]C+R[-1]C[-1]*R[-1]C"

'redimentionnage des colonnes automatique
ActiveCell.Offset(0, -2).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
End Sub

--
Céd / Lausanne

Merci David, c'est fait !
--
Céd / Lausanne


"David" a écrit :

Bonjour Congelator,

Posez votre question sur
microsoft.public.fr.excel
ça fourmie de pro sur Excel !

--
a+ Jean-Pol
Site Web : www.colovid.be
Site Web perso pour le fun : http://users.skynet.be/DAVID/
Cette page est transmise avec des électrons 100% recyclés.


"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message de
news: B004AB3F-DC1C-4042-A61F-F5A8381B2D1C@microsoft.com...
> Salut à tous,
> J'ai besoin de vos lumières, voilà mon blème :
> je dois créer une macro en VBA. L'utilisateur choisi le nb de produits en
> tout, la qté de A, le prix de A, la qté de B, le prix de B... et insérer à
> la
> fin le total. Jusque là ça joue, par contre, je dois insérer la formule et
> non le résultat pour le total et là, je ne sais pas comment récupérer ces
> infos. Info supplémentaire, c'est l'utilisateur qui choisi la cellule,
> donc
> pas de cell absolue... Si qqn a une idée, je suis preneur.
> Merci d'avance.
> Voici mon code.
> Option Explicit
> Sub Macro2()
> Dim intNombreEnregistrements As Integer
> Dim intCompteurVertical As Integer
> Dim intCompteurHorizontal As Integer
> Dim intCompteur As Integer
>
> 'enregistrement du nombre de lignes + écriture des titres des colonnes
> intNombreEnregistrements = InputBox("veuillez entrer le nombre
> d'enregistrements à effectuer", "enregistrements")
> ActiveCell.FormulaR1C1 = "Nom du produit"
> ActiveCell.Offset(0, 1).Range("A1").Select
> ActiveCell.FormulaR1C1 = "quantité"
> ActiveCell.Offset(0, 1).Range("A1").Select
> ActiveCell.FormulaR1C1 = "prix à l'unité"
>
> 'écriture des valeurs données par l'utilisateur directement dans les
> cellules sur X lignes
> For intCompteur = 1 To intNombreEnregistrements
> ActiveCell.Offset(1, -2).Range("A1").Select
> ActiveCell.FormulaR1C1 = InputBox("nom du produit n° " &
> intCompteur, "enregistrement n° " & intCompteur) 'nom du produit
> ActiveCell.Offset(0, 1).Range("A1").Select
> ActiveCell.FormulaR1C1 = InputBox("quantité du produit n° " &
> intCompteur, "enregistrement n° " & intCompteur) 'quantité
> ActiveCell.Offset(0, 1).Range("A1").Select
> ActiveCell.FormulaR1C1 = InputBox("prix à l'unité du produit n° " &
> intCompteur, "enregistrement n° " & intCompteur) 'prix unitaire
> Next
>
> 'retour à la ligne + écriture du total
> ActiveCell.Offset(1, -2).Range("A1").Select
> ActiveCell.FormulaR1C1 = "TOTAL"
> ActiveCell.Offset(0, 2).Range("A1").Select
>
> 'formule de calcul du total à modifier pour qu'elle soit dynamique et
> relative
> ActiveCell.FormulaR1C1 > > "=R[-3]C[-1]*R[-3]C+R[-2]C[-1]*R[-2]C+R[-1]C[-1]*R[-1]C"
>
> 'redimentionnage des colonnes automatique
> ActiveCell.Offset(0, -2).Columns("A:A").EntireColumn.EntireColumn.AutoFit
> ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.EntireColumn.AutoFit
> ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
> End Sub
>
> --
> Céd / Lausanne

Voilà le code qui fonctionne :

Option Explicit
'----------------------------------------------------------------------------------------------------
'Cette fonction vérifie que la valeur passée en paramètre est bien un nombre
'Si c'est bien un nombre, elle retourne True sinon, elle retourne False
'----------------------------------------------------------------------------------------------------
Function isValidInt(strATester) As Boolean
If IsNumeric(strATester) Then
isValidInt = True
Else
isValidInt = False
End If
End Function
'----------------------------------------------------------------------------------------------------
'Cette fonction utilise la fonction isValidInt et interagit avec
l'utilisateur en fonction
'de la valeur retournée par isValidInt
'----------------------------------------------------------------------------------------------------
Function erreurSi(strValeur) As Boolean
If isValidInt(strValeur) = True Then
erreurSi = True
Else
MsgBox "désolé, la valeur entrée n'est pas conforme", , "erreurSi"
erreurSi = False
End If
End Function

Sub Macro2()
Dim strNombreEnregistrements As String 'nombre de produits à rentrer
dans le tableau
Dim intCompteur As Integer 'variable utilisée lors de la
boucle permettant d'écrire la formule
Dim strQuantite As String 'quantité du produit enregistré
Dim strPrix As String 'prix du produit enregistré
Dim strFormule As String 'formule contenant le calcul à
poser dans la tableau excel
Dim intNombreerreurSi As Integer 'contient le nombre d'erreurSis

'déclaration et initialisation de la variable contenant l'emplacement de
la cellule active
Dim Ac As Range
Set Ac = ActiveCell

Do 'boucle tant que la valeur entrée n'est pas un nombre
strNombreEnregistrements = InputBox("veuillez entrer le nombre
d'enregistrements à effectuer", "enregistrements")
Loop Until erreurSi(strNombreEnregistrements) = True
Ac = "Nom du produit"
Ac.Offset(0, 1) = "quantité"
Ac.Offset(0, 2) = "prix à l'unité"

Set Ac = Ac.Offset(1)

'boucle permettant d'entrer toutes les données du tableau
For intCompteur = 1 To strNombreEnregistrements

'----------nom du produit--------------------
Ac.Select
Ac = InputBox("nom du produit n° " & intCompteur, "enregistrement n°
" & intCompteur)

'------------quantité------------------------
Ac.Offset(, 1).Select

Do 'boucle tant que la valeur entrée n'est pas un nombre
strQuantite = InputBox("quantité du produit n° " & intCompteur,
"enregistrement n° " & intCompteur)
Loop Until erreurSi(strQuantite) = True

Ac.Offset(, 1) = strQuantite

'----------prix unitaire---------------------
Ac.Offset(, 2).Select

Do 'boucle tant que la valeur entrée n'est pas un nombre
strPrix = InputBox("prix à l'unité du produit n° " &
intCompteur, "enregistrement n° " & intCompteur)
Loop Until erreurSi(strPrix) = True

Ac.Offset(, 2) = strPrix
Ac.Offset(, 2).NumberFormat = "$ #,##0.00" 'définition du format de
la cellule du prix en monétaire

'sélection de la cellule d'en dessous
Set Ac = Ac.Offset(1)
Next

Set Ac = Ac.Offset(1)
Ac = "TOTAL"

ActiveCell.Offset(2).Range("A1").Select

'définition du texte initial pour la formule
strFormule = "=PRODUCT(" & Ac.Offset(-strNombreEnregistrements - 1,
1).Resize(1, 2).Address(0, 0) & ")"

'définiton de la suite du texte pour la formule
For intCompteur = -strNombreEnregistrements + 1 To -1
strFormule = strFormule & " + PRODUCT(" & Ac.Offset(intCompteur - 1,
1).Resize(1, 2).Address(0, 0) & ")"
Next

Ac.Offset(, 2).Formula = strFormule 'écriture de la formule
Ac.Offset(, 2).NumberFormat = "$ #,##0.00" 'définition du format de la
cellule du total en monétaire
Ac.Resize(, 3).EntireColumn.AutoFit 'redimentionnement automatique des
colonnes
End Sub

--
Céd / Lausanne


"Congelator" wrote:

Salut à tous,
J'ai besoin de vos lumières, voilà mon blème :
je dois créer une macro en VBA. L'utilisateur choisi le nb de produits en
tout, la qté de A, le prix de A, la qté de B, le prix de B... et insérer à la
fin le total. Jusque là ça joue, par contre, je dois insérer la formule et
non le résultat pour le total et là, je ne sais pas comment récupérer ces
infos. Info supplémentaire, c'est l'utilisateur qui choisi la cellule, donc
pas de cell absolue... Si qqn a une idée, je suis preneur.
Merci d'avance.
Voici mon code.
Option Explicit
Sub Macro2()
Dim intNombreEnregistrements As Integer
Dim intCompteurVertical As Integer
Dim intCompteurHorizontal As Integer
Dim intCompteur As Integer

'enregistrement du nombre de lignes + écriture des titres des colonnes
intNombreEnregistrements = InputBox("veuillez entrer le nombre
d'enregistrements à effectuer", "enregistrements")
ActiveCell.FormulaR1C1 = "Nom du produit"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "quantité"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "prix à l'unité"

'écriture des valeurs données par l'utilisateur directement dans les
cellules sur X lignes
For intCompteur = 1 To intNombreEnregistrements
ActiveCell.Offset(1, -2).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("nom du produit n° " &
intCompteur, "enregistrement n° " & intCompteur) 'nom du produit
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("quantité du produit n° " &
intCompteur, "enregistrement n° " & intCompteur) 'quantité
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = InputBox("prix à l'unité du produit n° " &
intCompteur, "enregistrement n° " & intCompteur) 'prix unitaire
Next

'retour à la ligne + écriture du total
ActiveCell.Offset(1, -2).Range("A1").Select
ActiveCell.FormulaR1C1 = "TOTAL"
ActiveCell.Offset(0, 2).Range("A1").Select

'formule de calcul du total à modifier pour qu'elle soit dynamique et
relative
ActiveCell.FormulaR1C1 =
"=R[-3]C[-1]*R[-3]C+R[-2]C[-1]*R[-2]C+R[-1]C[-1]*R[-1]C"

'redimentionnage des colonnes automatique
ActiveCell.Offset(0, -2).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
End Sub

--
Céd / Lausanne

Congelator a écrit :

Voilà le code qui fonctionne :

Option Explicit
'----------------------------------------------------------------------------------------------------
'Cette fonction vérifie que la valeur passée en paramètre est bien un nombre
'Si c'est bien un nombre, elle retourne True sinon, elle retourne False
'----------------------------------------------------------------------------------------------------
Function isValidInt(strATester) As Boolean
If IsNumeric(strATester) Then
isValidInt = True
Else
isValidInt = False
End If
End Function

Je ne comprends pas bien l'intérêt de IsValidInt

Elle s'écrirai plus simplement

Function isValidInt(strATester) As Boolean
isValidInt = IsNumeric(strATester)
End Function

et on s'aperçoit bien là qu'elle ne fait rien.

Par contre si le but est de vérifier qu'il s'agit d'un entier, voici ce
qu'il faudrait faire

Function isValidInt(strATester) As Boolean
dim X as double
If IsNumeric(strATester) Then
XÍbl(strATester)
isValidInt = (X=Fix(X))
Else
isValidInt = False
End If
End Function