Soutraire textbox

[apdf1]

Bonjour

Je recherche a simplifier mon code, je voudrais soustraire les textbox en mettant le format "€" mais je trouve mon code un peu lourd.

Si quelqu'un peut m'aider a simplifier mon code je le remercie d'avance.

Cordialement

Max

 

[laetitia90]

Re : Soutraire textbox

bonjour apdf1, Bebere, Fo_rum🙂🙂
c'est la textbox11 mal renommée en T11
quand tu utilise une combobox il faut exploiter au max "ListIndex" cela simplifie beaucoup le code !!!!
ma combobox se nomme C1

ps attention dans le bouton "btncreer" j'ai oublie de mettre feuil2 corrige

Private Sub btncreer_Click()
t = Feuil2.Cells(Rows.Count, 1).End(xlUp)(2).Row
For y = 1 To 29: Feuil2.Cells(t, y) = Controls("T" & y).Value: Next y: Beep
Unload Me: User.Show
End Sub

 

[apdf1]

Re : Soutraire textbox

Bonjour Laetitia

Je te remercie infiniment d'avoir passé autant de temps a mon problème.

Cela correspond trés bien à ma demande. J'ose abuser de ta gentillesse et de ton temps pour te demander une dernière chose pour finaliser mon formulaire, dans la T17 elle est réserver à l'adresse émail et j'aimerais que sur la feuil2 est sois actif "cliquable";

Je te remercie pour tous et te souhaite une très bonne journée
Max

 

[laetitia90]

Re : Soutraire textbox

re, je vais regarder assez "chiant" a gérer sans revoir tous le code

 

[apdf1]

Re : Soutraire textbox

Re

OK je te remercie

@+

Max

 

[laetitia90]

Re : Soutraire textbox

re , quoi que ??? tu fais un double clic sur le lien Hyperlinks aprés il sont actif & le reste si tu fermes ton fichier???
peut être suffisant ???

 

[apdf1]

Re : Soutraire textbox

Bonjour Laetitia

Je te remercie pour tous et te souhaite un bon Dimanche

Max

 

[laetitia90]

Re : Soutraire textbox

re,
monsieur zip pas travaille le dimanche ??? fatigue comme moi il est temps d'aller se coucher🙁🙁
autremement essai comme cela pour automatiser

code user

Dim txt(4) As New Classe1, y As Byte, t As Variant
Private Sub UserForm_Initialize()
Set txt(1).txt = T20: Set txt(2).txt = T21: Set txt(3).txt = T23: Set txt(4).txt = T25
t = Feuil2.Range("a2:ac" & Feuil2.Cells(Rows.Count, 1).End(xlUp).Row): c1.List = t
End Sub
Private Sub c1_Click()
For y = 1 To 29: Controls("T" & y) = c1.List(c1.ListIndex, y - 1): Next y
End Sub
Private Sub btnmodifier_Click()
With Sheets("Feuil2")
For y = 1 To 29: .Cells(c1.ListIndex + 2, y) = Controls("T" & y).Value: Next y: Beep
.Hyperlinks.Add .Cells(c1.ListIndex + 2, 17), Address:="mailto:" & "T17"
End With
Unload Me: User.Show
End Sub
Private Sub btncreer_Click()
With Sheets("Feuil2")
t = .Cells(Rows.Count, 1).End(xlUp)(2).Row
For y = 1 To 29: .Cells(t, y) = Controls("T" & y).Value: Next y: Beep
.Hyperlinks.Add .Cells(t, 17), Address:="mailto:" & "T17"
End With
Unload Me: User.Show
End Sub
Private Sub btnsupprimer_Click()
Feuil2.Rows(c1.ListIndex + 2).Delete: Beep: Unload Me: User.Show
End Sub
Private Sub CdQuitter_Click()
Unload Me
End Sub
Private Sub c1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single)
c1.SetFocus: c1.DropDown
End Sub

on touche pas a la class

Public WithEvents txt As MSForms.TextBox, X, t As Variant
Private Sub txt_Change()
On Error Resume Next
With User
X = 0
For Each t In Array(.T21, .T23, .T25)
X = X + t
Next t: .T27 = Replace(Format(.T20 - X, "0.00 €"), ".", ",")
End With
End Sub
Private Sub txt_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 And txt <> "" Then txt = Replace(Format(txt, "0.00 €"), ".", ",")
End Sub
Private Sub txt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("0123456789.,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

si ca marche pas peut être te permettre d'envoyer un message privée a ma cigogne preferée JNP je viens de voir sur un autre post il maitrise bien ces "bêtes" la

 

[apdf1]

Re : Soutraire textbox

Re

Sa marche super bien je te remercie infiniment

Bon dimanche et bonne nuit

Max