Microsoft 365 Copier un Userform dans toutes les feuilles de mon fichier

[Arch974]

Bonjour,

J'ai un userform dans ma feuille 'Detail-Revetement" qui se lance en cliquant sur le bouton "USF" et réalise des calculs. Je dois réaliser le même userform dans les autres feuilles de mon fichier il y en a plus de 20 ! Est-ce qu'il y a un moyen pour que je copier colle ce userform dans les autres feuilles ? Ou bien de rajouter un ligne de code dans l'userform1 pour que je n'ai qu'a rajouter un bouton dans les autres feuilles qui quand je clique dessus m'affiche l'userform et fait le même calcul ?

Merci d'avance.

 

[M12]

Bonjour,
Regarde avec les modifs dans l'initialize de l'USF
il faut que les onglets soient de même concept en ce qui concerne les colonnes

 

[Arch974]

Bonjour,
Regarde avec les modifs dans l'initialize de l'USF
il faut que les onglets soient de même concept en ce qui concerne les colonnes

Merci beaucoup ça fonctionne très bien ! Comment est-ce qu'on fait pour copier coller le bouton USF?

 

[M12]

Développeur --> Mode création
clic droit copier et coller dans l'autre feuille
Il ne reste plus qu'à affecter à ce bouton le lancement de l'USF
Regarde dans les feuilles, tu as déjà cette macro, que tu peut copier coller dans l'autre feuille

 

[Arch974]

Développeur --> Mode création
clic droit copier et coller dans l'autre feuille
Il ne reste plus qu'à affecter à ce bouton le lancement de l'USF
Regarde dans les feuilles, tu as déjà cette macro, que tu peut copier coller dans l'autre feuille

D'accord merci. J'ai une autre question stp, d'abord excuse moi de te déranger. Mais je dois créer un autre Userform comme le premier mais la manière qu'il doit calculer est différente, en effet il doit sélectionner le bon ratio qui se trouve dans un tableau d'intervalle (le tableau en fond jaune). L'userform2 est déjà créer il est fait pour la feuille "calcul-revetement".

 

[Dranreb]

Bonjour.
@M12, @Arch974 m'a déjà soumis le problème du calcul, or il n'en parle pas. Alors pour éviter qu'il ne vienne après coup vous demander de trouver une solution pour éviter que le prix d'une surface relevant d'un certain ratio soit inférieur à celui d'une surface inférieure mais relevant d'un ratio supérieur :

Function Prix(ByVal Qté As Double, ByVal RngTarifs As Range, ByVal LR As Byte) As Currency
Rem. Arguments :
' Qté: La quantité
' RngTarifs: Plage des ratio partiels avec en 1ère ligne les quantités minimales
' LR: Numéro de ligne de ratio à appliquer. 1: le 1er donc la 2 de RngTarifs
   Dim TQtMin(), TRatio(), C As Byte, Ratio As Double, QtMin As Double
   TQtMin = RngTarifs.Rows(1).Value
   TRatio = RngTarifs.Rows(LR + 1).Value
   Ratio = TRatio(1, 1)
   For C = 2 To UBound(TQtMin, 2)
      QtMin = TQtMin(1, C)
      If Qté < QtMin Then Exit For
      Prix = Prix + QtMin * Ratio
      Qté = Qté - QtMin
      Ratio = TRatio(1, C): Next C
   Prix = Prix + Qté * Ratio
   End Function

Microsoft 365 - calcul avec un userform qui prend en compte l'économie d'échelle

Bonjour, J'ai déjà un userform1 dans mon fichier qui se trouve dans la feuille "Detail" qui calcule le prix en fonction de la tâche choisit et qui multiplie le ratio correspondant avec la quantité que j'ai rentrée. J'ai créé une deuxième feuille "Calcul" qui cette fois-ci prend en compte...

www.excel-downloads.com

 

[Arch974]

Bonjour.
@M12, @Arch974 m'a déjà soumis le problème du calcul, or il n'en parle pas. Alors pour éviter qu'il ne vienne après coup vous demander de trouver une solution pour éviter que le prix d'une surface relevant d'un certain ratio soit inférieur à celui d'une surface inférieure mais relevant d'un ratio supérieur :

Function Prix(ByVal Qté As Double, ByVal RngTarifs As Range, ByVal LR As Byte) As Currency
Rem. Arguments :
' Qté: La quantité
' RngTarifs: Plage des ratio partiels avec en 1ère ligne les quantités minimales
' LR: Numéro de ligne de ratio à appliquer. 1: le 1er donc la 2 de RngTarifs
   Dim TQtMin(), TRatio(), C As Byte, Ratio As Double, QtMin As Double
   TQtMin = RngTarifs.Rows(1).Value
   TRatio = RngTarifs.Rows(LR + 1).Value
   Ratio = TRatio(1, 1)
   For C = 2 To UBound(TQtMin, 2)
      QtMin = TQtMin(1, C)
      If Qté < QtMin Then Exit For
      Prix = Prix + QtMin * Ratio
      Qté = Qté - QtMin
      Ratio = TRatio(1, C): Next C
   Prix = Prix + Qté * Ratio
   End Function

Microsoft 365 - calcul avec un userform qui prend en compte l'économie d'échelle

Bonjour, J'ai déjà un userform1 dans mon fichier qui se trouve dans la feuille "Detail" qui calcule le prix en fonction de la tâche choisit et qui multiplie le ratio correspondant avec la quantité que j'ai rentrée. J'ai créé une deuxième feuille "Calcul" qui cette fois-ci prend en compte...

www.excel-downloads.com

Oui c'est vrai, j'ai demandé au cas où si une autre personne avait une autre solution.

 

[Dranreb]

À noter, @Arch974, qu'il serait aussi possible d'appliquer les ratio globalement, si vous préfériez, mais seulement aux quantités indiquées aux bornes, quitte à ce qu'un prix, lui, soit calculé par interpolation linéaire entre les prix des deux bornes délimitant l'intervalle où se situe la quantité donnée. Mais ça reviendrait cette fois à appliquer à chaque accroissement de quantité un ratio n'étant indiqué nulle part.

 

[Arch974]

Cette idée me va, mais ça sera une fonction ou on pourra l'appliquer avec l'userform ?

 

[Dranreb]

L'un n'empêche pas l'autre. Une Function peut être aussi bien invoquée dans du code VBA que dans une formule de cellule.

 

[Arch974]

L'un n'empêche pas l'autre. Une Function peut être aussi bien invoquée dans du code VBA que dans une formule de cellule.

Vous pouvez essayer s'il vous plaît ?

 

[Dranreb]

Testez ceci :

Function PrixILn(ByVal Qté As Double, ByVal RngTarifs As Range, ByVal LR As Byte) As Currency
   Dim TQté(), TRat(), C As Byte, Qté0 As Double, Qté1 As Double
   TQté = RngTarifs.Rows(1).Value
   On Error Resume Next
   C = WorksheetFunction.Match(Qté, TQté, 0)
   On Error GoTo E
   TRat = RngTarifs.Rows(LR + 1).Value
   If C = 0 Then
      PrixILn = Int(TRat(1, 1) * Qté * 100 + 0.5) / 100
   ElseIf C = UBound(TRat, 2) Then
      PrixILn = Int(TRat(1, C) * Qté * 100 + 0.5) / 100
   Else
      Qté0 = TQté(1, C): Qté1 = TQté(1, C + 1)
      PrixILn = Int(IntpoLin(Qté, Qté0, TRat(1, C) * Qté0, _
         Qté1, TRat(1, C + 1) * Qté1) * 100 + 0.5) / 100
      End If
   Exit Function
E: MsgBox Err.Description: Resume
   End Function
Function IntpoLin(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _
                                     ByVal X2 As Double, ByVal Y2 As Double) As Double
   IntpoLin = Y1 + (Y2 - Y1) * (X - X1) / (X2 - X1)
   End Function

Édition: Zut j'ai oublié le * 100 dans les cas extrêmes. Ci dessus le code corrigé.

 

[Arch974]

Testez ceci :

Function PrixILn(ByVal Qté As Double, ByVal RngTarifs As Range, ByVal LR As Byte) As Currency
   Dim TQté(), TRat(), C As Byte, Qté0 As Double, Qté1 As Double
   TQté = RngTarifs.Rows(1).Value
   On Error Resume Next
   C = WorksheetFunction.Match(Qté, TQté, 0)
   On Error GoTo E
   TRat = RngTarifs.Rows(LR + 1).Value
   If C = 0 Then
      PrixILn = Int(TRat(1, 1) * Qté + 0.5) / 100
   ElseIf C = UBound(TRat, 2) Then
      PrixILn = Int(TRat(1, C) * Qté + 0.5) / 100
   Else
      Qté0 = TQté(1, C): Qté1 = TQté(1, C + 1)
      PrixILn = Int(IntpoLin(Qté, Qté0, TRat(1, C) * Qté0, _
         Qté1, TRat(1, C + 1) * Qté1) * 100 + 0.5) / 100
      End If
   Exit Function
E: MsgBox Err.Description: Resume
   End Function
Function IntpoLin(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _
                                     ByVal X2 As Double, ByVal Y2 As Double) As Double
   IntpoLin = Y1 + (Y2 - Y1) * (X - X1) / (X2 - X1)
   End Function

Merci

 

[Arch974]

Testez ceci :

Function PrixILn(ByVal Qté As Double, ByVal RngTarifs As Range, ByVal LR As Byte) As Currency
   Dim TQté(), TRat(), C As Byte, Qté0 As Double, Qté1 As Double
   TQté = RngTarifs.Rows(1).Value
   On Error Resume Next
   C = WorksheetFunction.Match(Qté, TQté, 0)
   On Error GoTo E
   TRat = RngTarifs.Rows(LR + 1).Value
   If C = 0 Then
      PrixILn = Int(TRat(1, 1) * Qté + 0.5) / 100
   ElseIf C = UBound(TRat, 2) Then
      PrixILn = Int(TRat(1, C) * Qté + 0.5) / 100
   Else
      Qté0 = TQté(1, C): Qté1 = TQté(1, C + 1)
      PrixILn = Int(IntpoLin(Qté, Qté0, TRat(1, C) * Qté0, _
         Qté1, TRat(1, C + 1) * Qté1) * 100 + 0.5) / 100
      End If
   Exit Function
E: MsgBox Err.Description: Resume
   End Function
Function IntpoLin(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _
                                     ByVal X2 As Double, ByVal Y2 As Double) As Double
   IntpoLin = Y1 + (Y2 - Y1) * (X - X1) / (X2 - X1)
   End Function

est-ce que vous pouvez faire un exemple parce que je ne comprends pas comment fonctionne la fonction s'il vous plaît.

 

[Dranreb]

Par exemple :

Dim Prix As Currency, Qté As Double, RngTarif As Range, LR As Byte
 …
Prix = PrixILn(Qté, RngTarif, LR)