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

Arch974 · 13 Juillet 2021

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 · 13 Juillet 2021

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

M12 · 13 Juillet 2021

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 · 13 Juillet 2021

M12 à dit:
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 · 13 Juillet 2021

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 · 13 Juillet 2021

M12 à dit:
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 · 13 Juillet 2021

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 :

VB:

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 · 13 Juillet 2021

Dranreb à dit:
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 :

VB:

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 · 13 Juillet 2021

À 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 · 13 Juillet 2021

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

Dranreb · 13 Juillet 2021

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 · 13 Juillet 2021

Dranreb à dit:
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 · 13 Juillet 2021

Testez ceci :

VB:

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 · 13 Juillet 2021

Dranreb à dit:

Testez ceci :

VB:

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 · 13 Juillet 2021

Dranreb à dit:

Testez ceci :

VB:

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 · 13 Juillet 2021

Par exemple :

VB:

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

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

Arch974

XLDnaute Junior

Pièces jointes

M12

M12

XLDnaute Accro

Pièces jointes

Arch974

XLDnaute Junior

M12

XLDnaute Accro

Arch974

XLDnaute Junior

Pièces jointes

Dranreb

XLDnaute Barbatruc

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

Arch974

XLDnaute Junior

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

Dranreb

XLDnaute Barbatruc

Arch974

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Arch974

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Arch974

XLDnaute Junior

Arch974

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Discussions similaires