Enregistrer le format d'une valeur textbox en monétaire

[gbstyle]

Bonjour, voila je souhaiterai lors de l'enregistrement sur mon tableau que le format nombre soit monétaire
ci joint mon bout de code
Private Sub BtnAenregistrer_Click()
Ref = Me.TxtARefArticles
With Sheets("Base_Articles")
Set trouvé = .Range("TblBaseArticles").Columns(1).Find(Ref, lookat:=xlWhole, LookIn:=xlValues)
If trouvé Is Nothing Then 'il s'agit d'un nouvelle articles
derlig = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'on se positionne sur la dernière ligne
Else 'existe déjà
derlig = trouvé.Row
If MsgBox("Souhaitez vous modifier l'article ?", vbYesNo) = vbNo Then Exit Sub
End If

.Range("A" & derlig) = TxtARefArticles
.Range("B" & derlig) = CboAFamille
.Range("C" & derlig) = CboASousfamille
.Range("D" & derlig) = TxtADesignation
.Range("E" & derlig) = CboAFournisseur
.Range("F" & derlig) = TxtALongueurcolisage
.Range("G" & derlig) = TxtALargeurcolisage
.Range("H" & derlig) = TxtAHauteurcolisage
.Range("I" & derlig) = TxtACréele
.Range("J" & derlig) = TxtANotes
.Range("K" & derlig) = TxtADelaislivraison
.Range("L" & derlig) = TxtAFraistransport
.Range("M" & derlig) = TxtAFacturation
.Range("N" & derlig) = CboAModedegestion
.Range("O" & derlig) = TxtAminicommande
.Range("P" & derlig) = TxtAPrixUnitHT ' => données à afficher en format Euros lors de la saisie dans le text box et lors de l'enregistrement que sont format se mette en monétaire dans le tableau source
J'ai essaye un code avec .NumberFormat = "#,##0.00 $" mais je n'y arrive pas, il me manque une déclaration de variable je pense

End With

End Sub

D'avance merci

 

[Dranreb]

Oui, ça devrait être possible, même si la fonction Gigogne est plus commode pour sortir tout que seulement une partie.

 

[gbstyle]

Salut Dranreb, comment vas tu ? J'espère que tout vas bien depuis le temps
Je viens de te donner quelque news de ce superbe projet qui à pu se concrétiser grace à ton aide.
Dans l'ensemble je suis très satisfait de la base, et après une grosse période d'utilisation j'ai quelque axe d'amélioration à peauffiner.
Je serais ravis de pouvoir échanger de nouveau avec toi quand tu auras un peu de temp

 

[Dranreb]

Bonjour.
Ça du temps j'en ai, vu que je suis à la retraite. Mais je dois avouer que l'orientation du mistérieux axe d'amélioration me fait un tout petit peu peur …

 

[gbstyle]

Salut Dranreb comment vas tu?
Je te fais parvenir un code qui nous permetter de sauvegarder un fichier pdf
En revance à l'ouverture de fichier je souhaiterai qu'il s'insère dans un email compléter avec les renseignement du fournisseur penses tu que ce sois faisable. l'adresse mail est accessible dans le fichier fournisseur client :/
Après plsuieur essais je suis obligé de revenir vers toi :/
D'avance merci

Private Sub CommandButton1_Click()
Dim TDon(), TR(), Ldon As Long, LR As Long, C As Long
TDon = CLsC.PlgTablo.Value 'résultat de la plage suivi commande
ReDim TR(1 To WshBCVierge.[CorpsFacture].Rows.Count, 1 To 3)
'ReDim TLBx(1 To UBound(TLC), 1 To 5)
For LR = 1 To UBound(TLC)
    Ldon = TLC(LR)
  For C = 1 To 3: TR(LR, C) = TDon(Ldon, Choose(C, 8, 9, 10)): Next C, LR ' 26/10 apparition BC sans PUHT
WshBCVierge.[CorpsFacture].Value = TR
WshBCVierge.[RéfBC].Value = TDon(Ldon, 1)
WshBCVierge.[Fournisseur].Value = TDon(Ldon, 4)
WshBCVierge.[DateCommande].Value = TDon(Ldon, 2)
WshBCVierge.[Port].Value = TDon(Ldon, 6)
WshBCVierge.[Delailivraison].Value = TDon(Ldon, 5)

WshBCVierge.[AdresseFournisseur].Value = TVLF(1, 4)
WshBCVierge.[CP].Value = TVLF(1, 5)
WshBCVierge.[Ville].Value = TVLF(1, 6)
WshBCVierge.[ConditionPaiement].Value = TVLF(1, 19)

'WshBCVierge.Activate 'afficher la feuille en fin de procédure

Application.ScreenUpdating = False

        WshBCVierge.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "F:\Exportation\BC\ BC " & Range("I3") & Range("G7") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        
End Sub

 

[Dranreb]

Bonjour.
D'habitude ce genre de chose s'effectue avec Outlook, or je n'ai pas ce produit installé chez moi, alors je ne peux pas d'aider.
Pour une programmation un tant soit peu guidée d'après les objets et leurs méthodes et propriétés suggérées à la frappe d'un point derrière, qu'elle fournira sans doute, cherche une référence à cocher parlant d'Outlook.
Si tu ne t'en sort pas en étudiant ça et la doc qu'on peut trouver sur internet à ce sujet, ouvre peut être une autre discussion, à laquelle quelqu'un d'autre, équipé pour, saura répondre.

 

[gbstyle]

Bonjour Dranreb, je reviens vers toi en effet j'ai pris en charge le suivis des commande de mon association de football j'ai donc mis en place à nouveaux notre outil qui correspond toujours et au top
mais après quelque modif que j'ai effectué car j'ai eu besoin d'option supplémentaire lors de la création d'une commande j'ai un petit soucis je m'explique.
Dans ma base article j'ai une Référence articles qui est identique pour plusieur taille.
Ex : Un sweat avec une XXX, cette référence est identique à toute les tailles allant de XS à XXXL
j'ai donc réussis à faire les modif et ajouter lors de la création de la commande un Txtbox ou précise en fonction de la quantité la taille

Jusque la tout vas bien j'ai modifié la création du bon de commande ce qui me permet d'avoir un résultat de ce type

Aprés sur le userform mouvement, j'ai bien réussis à intégrer mes info de rappel commande

Mon soucis c'est lors des entrées articles, il me fait systématiquement une modification de la même références, hors je souhaiterais pouvoir effectuer mon entrée en fonction des lignes de la commande avec les tailles, je n'arrives donc pas intégrer cette données.

Je ne souhaite pas avoir autant de ligne articles avec même références que de tailles associé dans la base articles car ca deviendra très vite compliqué, as tu par hasard une solution à me proposer car la je cale :/
je te remercie par avance pour ton aide toujours précieuse même si je ne comprend pas toujours ton dialogue un peu trop technique

 

[gbstyle]

Bon je crois que après reflexion pour que cela fonctionne il va falloir que je créer une réf par taille, et y ajouter la taille comme un critère unique dans la base article ce qui me permettra peut etre a terme de pouvoir filtrer par taille :/ qu'en penses tu ?

 

[Dranreb]

Bonjour.
Oui, ou mettre une ComboBox supplémentaire pour la taille, mais je ne sais plus si ça pourra marcher coté liaisons entre les tableaux.

 

[gbstyle]

Oui je suis partis sur cela en faite j'ai pris la décision de différencier toute les référence et d'ajouter un champ taille
Par contre je viens de me rendre compte qu'il faut que j'arrive à éviter de saisie de date j'ai donc ajouter un calendrier que j'ai récupérer sur le site pour faire une saisie
j'ouvre le formulaire avec un bouton

je souhaiterais en cliquant sur une case compléter mon champ date. As tu une astuce à me proposer
En faite si j'avais pu ouvrir le userform en cliquant directement dans la Txtbox Date ca aurait était superbe car je souhaiterai utiliser le même userform calendrier pour tout mes champ date
Je te joint le code récupérer du calendrier sur le site :/

Si tu as une solution simple je suis preneur je sais qu'il y avait l'objet calendar mais je n'arrive pas à l'activer dans mes contrôles supplémentaire :/

DefInt A-Z ' fm_CalendrierCellule avec ModClas_Calendrier
Dim BoutonJourCalendrier(1 To 42) As New ModClas_Calendrier
Private CalendrierJrsFeriesAnnee() As String
Private CalendrierDateSELECT As Date, CalAnneDEBUT, CalAnneFIN

Private Sub ButtonOk_Click()
ActiveCell = CalendrierDateSELECT: Unload Me
End Sub

Private Sub UserForm_Initialize() 'place userf au environ de la cellule
PosTop = ActiveCell.Top + (Application.Height - Application.UsableHeight) - 25
PosLeft = ActiveCell.Offset(0, 1).Left + 25
PosTopMaxi = Application.Height - Me.Height - 25
PosLeftMaxi = Application.Width - Me.Width - 25
If PosTop > PosTopMaxi Then PosTop = PosTopMaxi
If PosLeft > PosLeftMaxi Then PosLeft = PosLeftMaxi
Me.Top = PosTop: Me.Left = PosLeft
End Sub

Private Sub UserForm_Activate() 'Activate pour capter me.tag
CalAnneDEBUT = 1901: CalAnneFIN = 2199
' date d'appel sinon celle d'aujourd'hui
If IsDate(Me.Tag) Then CalendrierDateSELECT = Me.Tag Else CalendrierDateSELECT = Date
' test limite année
CalJourMIN = Day(D): CalMoisMIN = Month(D): CalAnneMIN = Year(D)
If Year(CalendrierDateSELECT) < CalAnneDEBUT Or Year(CalendrierDateSELECT) > CalAnneFIN Then
   MsgBox "La Date placée dans Calendrier.Tag est invalide !?", vbCritical, "Erreur"
   Unload Me: Exit Sub
End If
' init liste annee/mois
CbAnnee.Clear: For I = CalAnneDEBUT To CalAnneFIN: CbAnnee.AddItem I: Next
CbMois.Clear: For I = 1 To 12: CbMois.AddItem Choose(I, "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"): Next
' init date aujourd'hui
C$ = Format(Date, "dddd dd/mm/yyyy")
Mid(C$, 1, 1) = UCase(Mid(C$, 1, 1)): I = InStr(C$, " ")
LbAujourdhui.Caption = Left(C$, I - 1) & vbLf & Mid(C$, I + 1)
' Init Calendrier
CalendrierMiseAjour CalendrierDateSELECT
' Init groupe des LabelJours
Dim Ctrl As Control
For Each Ctrl In Me.CadreJours.Controls
  Set BoutonJourCalendrier(Ctrl.Tag).GroupBoutonJourCalendrier = Ctrl
Next
Set Ctrl = Nothing
End Sub

'                                          Dates
Private Sub LbAujourdhui_Click()
CalendrierMiseAjour Date
End Sub

Private Sub CbMois_Change() '  Mois   .
If CbMois.Enabled = False Then Exit Sub
J = 1: M = CbMois.ListIndex + 1: If M < 1 Then M = 1
If CbAnnee.Value = CalAnneDEBUT And M <= 1 Then M = 1: J = 1: CbMois.ListIndex = M - 1
CalendrierMiseAjour J & "/" & M & "/" & CbAnnee.Value
End Sub
Private Sub CursMois_SpinDown() '<
If CbAnnee.Value = CalAnneMIN Then
   If CbMois.ListIndex + 1 > CalMoisMIN Then CbMois.ListIndex = CbMois.ListIndex - 1
Else
   If CbMois.ListIndex > CalMoisMIN Then
      CbMois.ListIndex = CbMois.ListIndex - 1
   Else
      If CbAnnee.Value > CalAnneDEBUT Then
         CbAnnee.Enabled = False: CbAnnee.Value = CbAnnee.Value - 1
         CalendrierMiseAjour "31/12/" & CbAnnee.Value: CbAnnee.Enabled = True
      End If
   End If
End If
End Sub
Private Sub CursMois_SpinUp() '>
If CbMois.ListIndex < 11 Then
   CbMois.ListIndex = CbMois.ListIndex + 1
Else
   If CbAnnee.Value < CalAnneFIN Then
      CbAnnee.Enabled = False: CbAnnee.Value = CbAnnee.Value + 1
      CalendrierMiseAjour "01/01/" & CbAnnee.Value: CbAnnee.Enabled = True
   End If
End If
End Sub

Private Sub CbAnnee_Change() '  Annee  .
If CbAnnee.Enabled = False Then Exit Sub
J = 1: M = CbMois.ListIndex + 1: If M < 1 Then M = 1
If CbAnnee.Value = CalAnneDEBUT And M <= 1 Then M = 1: J = 1
CalendrierMiseAjour J & "/" & M & "/" & CbAnnee.Value
End Sub
Private Sub CursAnnee_SpinDown() '<
If CbAnnee.Value > CalAnneDEBUT Then CbAnnee.Value = CbAnnee.Value - 1
End Sub
Private Sub CursAnnee_SpinUp() '>
If CbAnnee.Value < CalAnneFIN Then CbAnnee.Value = CbAnnee.Value + 1
End Sub

'                                     init calendrier

Public Sub CalendrierMiseAjour(D As Date)
Dim CaseJR As Control, DateJR As Date, DateJ1 As Date
CalendrierDateSELECT = D
MoisSelect = Month(CalendrierDateSELECT)
AnneSelect = Year(CalendrierDateSELECT)
DateJ1 = "01/" & MoisSelect & "/" & AnneSelect '1'du mois pour boucle CaseJR
J1 = Weekday(DateJ1, vbMonday) 'no du jour de semaine
If J1 = 1 Then J1 = 8 'si = lundi sauter la 1'ligne dans CadreDesJours
DateJ1 = DateJ1 - J1 'départ avant le 1'NoJour du mois(1'case jours mois précédent)
CalendrierJrsFeriesAnneeInit AnneSelect 'init jours fériés

' init listes Annee - Mois (False pour éviter répétition événement)
CbAnnee.Enabled = False: CbAnnee = AnneSelect: CbAnnee.Enabled = True
CbMois.Enabled = False: CbMois.ListIndex = MoisSelect - 1: CbMois.Enabled = True
LbNoSem1 = "": LbNoSem2 = "": LbNoSem3 = "": LbNoSem4 = "": LbNoSem5 = "": LbNoSem6 = ""
LbFerie = ""
' boucle sur les cases jours(CadreDesJours)
For Each CaseJR In CadreJours.Controls
  DateJR = DateJ1 + Val(CaseJR.Tag)
  NoJour = Day(DateJR): CaseJR.Caption = NoJour
  NoSemISO = FCalendrierNoDeSemISO(DateJR)
  Select Case Val(CaseJR.Tag)
    Case 1 To 7: If LbNoSem1 = "" Then LbNoSem1 = NoSemISO
    Case 8 To 14: If LbNoSem2 = "" Then LbNoSem2 = NoSemISO
    Case 15 To 21: If LbNoSem3 = "" Then LbNoSem3 = NoSemISO
    Case 22 To 28: If LbNoSem4 = "" Then LbNoSem4 = NoSemISO
    Case 29 To 35: If LbNoSem5 = "" Then LbNoSem5 = NoSemISO
    Case 36 To 42: If LbNoSem6 = "" Then LbNoSem6 = NoSemISO
  End Select
  'accès case jours ok si jour du mois select ok
  If Month(DateJR) = MoisSelect And (AnneSelect > CalAnneDEBUT Or (AnneSelect = CalAnneDEBUT And Month(DateJR) > 1 Or Month(DateJR) = 1 And NoJour >= 1)) Then
     CaseJR.SpecialEffect = fmSpecialEffectRaised: CaseJR.Enabled = True
  Else
     CaseJR.SpecialEffect = fmSpecialEffectEtched: CaseJR.Enabled = False
  End If
  If DateJR = CalendrierDateSELECT Then
     CaseJR.SpecialEffect = fmSpecialEffectSunken
     CaseJR.BackColor = &HFF0000 'fond bleu
     CaseJR.ForeColor = &HFFFFFF 'font blanc
     CaseJR.Font.Bold = True
     LbFerie = CalendrierJrsFeriesAnnee(NoJour, MoisSelect)
  Else
     CaseJR.BackColor = &H8000000F 'fond GrisClair
     CaseJR.ForeColor = &H800000   'font bleu
     CaseJR.Font.Bold = False
     If CaseJR.Enabled = True And CalendrierJrsFeriesAnnee(NoJour, MoisSelect) > "" Then CaseJR.BackColor = &H8080FF
  End If
Next
Set CaseJR = Nothing
End Sub

'                           routines NoSem/Feries

Private Function FCalendrierNoDeSemISO(D As Date) 'norme ISO(Sem 4 Jrs mini)(de Renauder XLD)
T& = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
FCalendrierNoDeSemISO = ((D - T& - 3 + (Weekday(T&) + 1) Mod 7)) \ 7 + 1
End Function

Private Sub CalendrierJrsFeriesAnneeInit(AnneeDuCal) 'Tableau Jours Fériés(Init pour une année)
ReDim CalendrierJrsFeriesAnnee(1 To 31, 1 To 12)
'calcul dimanche de Pâques (fonction anglophone 1900-9999)
Dim DatePaque As Date, DateAscension As Date, DatePentecote As Date
'de Jean Meeus résultat idem
'A% = AnneeDuCal Mod 19: B% = AnneeDuCal \ 100: C% = AnneeDuCal Mod 100
'D% = (19 * A% + B% - (B% \ 4) - ((B% - ((B% + 8) \ 25) + 1) \ 3) + 15) Mod 30
'E% = (32 + 2 * ((B% Mod 4) + (C% \ 4)) - D% - (C% Mod 4)) Mod 7
'F% = (D% + E% - 7 * ((A% + 11 * D% + 22 * E%) \ 451) + 114)
'DatePaques = DateSerial(AnneeDuCal, F% \ 31, (F% Mod 31) + 1)
Golden% = (AnneeDuCal Mod 19) + 1: Century% = AnneeDuCal \ 100 + 1
LeapDayCorrection% = 3 * Century% \ 4 - 12
SynchWithMoon% = (8 * Century% + 5) \ 25 - 5
Sunday% = 5 * CLng(AnneeDuCal) \ 4 - LeapDayCorrection% - 10
Epact% = (11 * Golden% + 20 + SynchWithMoon% - LeapDayCorrection%) Mod 30
If Epact% < 0 Then Epact% = Epact% + 30
If Epact% = 24 Or (Epact% = 25 And Golden% > 11) Then Epact% = Epact% + 1
Jpaq% = 44 - Epact%: If Jpaq% < 21 Then Jpaq% = Jpaq% + 30
Jpaq% = Jpaq% + 7 - ((Sunday% + Jpaq%) Mod 7)
'ou remplace les 2lignes ci-dessous > DatePAQUES = DateSerial(AnneeDuCal, 3, Jpaq%)
If Jpaq% > 31 Then MPaq% = 4: Jpaq% = Jpaq% - 31 Else MPaq% = 3
DatePaque = Jpaq% & " " & MPaq% & " " & AnneeDuCal
'Date Pâques / Ascension / Pentecôte
DateAscension = DatePaque + 39: DatePentecote = DatePaque + 49
'init jours pour tableau CalendrierJrsFeriesAnnee(,)
Jasc% = Day(DateAscension): Masc% = Month(DateAscension)
Jpent% = Day(DatePentecote): Mpent% = Month(DatePentecote)
JLpaq% = Day(DatePaque + 1): MLpaq% = Month(DatePaque + 1)
JLpent% = Day(DatePentecote + 1): MLpent% = Month(DatePentecote + 1)
CalendrierJrsFeriesAnnee(1, 1) = "Nouvel AN"
CalendrierJrsFeriesAnnee(1, 5) = "Fête du Travail"
CalendrierJrsFeriesAnnee(8, 5) = "Victoire 1945"
CalendrierJrsFeriesAnnee(14, 7) = "Fête Nationale"
CalendrierJrsFeriesAnnee(15, 8) = "Assomption"
CalendrierJrsFeriesAnnee(1, 11) = "Toussaint"
CalendrierJrsFeriesAnnee(11, 11) = "Armistice 1918"
CalendrierJrsFeriesAnnee(25, 12) = "Nôel"
'deux jours fériés peuvent tomber le même jour Exp "1 Mai 2008" "Fête du Travail et Ascension"
CalendrierJrsFeriesAnnee(Jpaq%, MPaq%) = CalendrierJrsFeriesAnnee(Jpaq%, MPaq%) & " Pâque"
CalendrierJrsFeriesAnnee(JLpaq%, MLpaq%) = CalendrierJrsFeriesAnnee(JLpaq%, MLpaq%) & " Lund.Pâque"
CalendrierJrsFeriesAnnee(Jasc%, Masc%) = CalendrierJrsFeriesAnnee(Jasc%, Masc%) & " Ascension"
CalendrierJrsFeriesAnnee(Jpent%, Mpent%) = CalendrierJrsFeriesAnnee(Jpent%, Mpent%) & " Pentecôte"
CalendrierJrsFeriesAnnee(JLpent%, MLpent%) = CalendrierJrsFeriesAnnee(JLpent%, MLpent%) & " Lund.Pentecôte"
End Sub

 

[gbstyle]

Ci joint code d'un module de classe lié aux Frm calendrier

Public WithEvents GroupBoutonJourCalendrier As MSForms.Label
Private Sub GroupBoutonJourCalendrier_Click()
If GroupBoutonJourCalendrier.Enabled = False Then Exit Sub
With fm_CalendrierCellule 'passage données au format date !
 .CalendrierMiseAjour GroupBoutonJourCalendrier.Caption & "/" & .CbMois.ListIndex + 1 & "/" & .CbAnnee.Value
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [PlageDates]) Is Nothing Then
            Load fm_CalendrierCellule
            If IsDate(Target) Then fm_CalendrierCellule.Tag = Target Else fm_CalendrierCellule.Tag = Date
            fm_CalendrierCellule.Show: Cancel = True
    End If
End Sub

 

[gbstyle]

Mince d'après ce que j'ai pu lire sur internet je ne peux pas installer le contrôle calendar sur une version 64bits avec office 365 :/
Donc je vais devoir travailler sur la programmation du calendar évoqué ci dessus :/ c'est la loose

 

[Dranreb]

J'ai mon propre calendrier muni d'une méthode Coupler.
Exemple de code :

Private Sub TBxCmdDate_Enter()
   UFmCalenS.Coupler "Commande du :", TBxCmdDate
   End Sub

 

[gbstyle]

merci Dranreb c'est génial,
Je suis preneur c'est vraiment du superbe boulot, je reste toujour admiratif
j'ai ajouter la procédure également sur la date de livraison estimé
par contre peux tu m'expliquer cette procédure si tu t'en rappel

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Static Temps As Date
If Temps <> 0 Then
   Application.DisplayFullScreen = Not Application.DisplayFullScreen
Else
   Temps = Now + TimeSerial(0, 0, 1)
   Do: DoEvents: Loop Until Now > Temps
   End If
Temps = 0
End Sub

 

[Dranreb]

Ça ne me paraît pas être de moi ça.
Apparemment c'est une procédure qui bascule l'affichage de l'application en plein écran si elle n'y est pas déjà, auquel cas elle la remet en affichage normal. Mais il semblerait que des problèmes de mise au point aient poussé le programmeur à mettre une temporisation dont le rôle m'apparaît assez nébuleux.

 

[gbstyle]

ok merci Dranreb je supprime donc.
Je viens de terminer la mise à jour avec la création Cbx lié en taille dans les fiche articles et tout le reste oufff ca fonctionne